[Bio] / FigWebServices / exclude_from_solid_rectangles.cgi Repository:
ViewVC logotype

View of /FigWebServices/exclude_from_solid_rectangles.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (download) (annotate)
Fri Mar 1 15:51:12 2013 UTC (6 years, 8 months ago) by overbeek
Branch: MAIN
CVS Tags: rast_rel_2014_0729, rast_rel_2014_0912, HEAD
support excluding pegs from SR machinery

#!/usr/bin/env /vol/ross/FIGdisk/bin/run_perl

BEGIN {
    unshift @INC, qw(
              /vol/ross/FIGdisk/dist/releases/dev/FigKernelPackages
              /vol/ross/FIGdisk/dist/releases/dev/common/lib
              /vol/ross/FIGdisk/dist/releases/dev/common/lib/FigKernelPackages
              /vol/ross/FIGdisk/dist/releases/dev/common/lib/WebApplication
              /vol/ross/FIGdisk/dist/releases/dev/common/lib/FortyEight
              /vol/ross/FIGdisk/dist/releases/dev/common/lib/PPO
              /vol/ross/FIGdisk/dist/releases/dev/common/lib/RAST
              /vol/ross/FIGdisk/dist/releases/dev/common/lib/MGRAST
              /vol/ross/FIGdisk/dist/releases/dev/common/lib/SeedViewer
              /vol/ross/FIGdisk/dist/releases/dev/common/lib/ModelSEED
              /vol/ross/FIGdisk/dist/anon/common/lib
              /vol/ross/FIGdisk/dist/anon/common/lib/FigKernelPackages
              /vol/ross/FIGdisk/config
 
);
}
use Data::Dumper;
use Carp;
use FIG_Config;
$ENV{'BLASTMAT'} = "/vol/ross/FIGdisk/BLASTMAT";
$ENV{'FIG_HOME'} = "/vol/ross/FIGdisk";
# end of tool_hdr
########################################################################
use CGI;


if (-f "$FIG_Config::data/Global/why_down")
{
    local $/;
    open my $fh, "<$FIG_Config::data/Global/why_down";
    my $down_msg = <$fh>;
    
    print CGI::header();
    print CGI::head(CGI::title("SEED Server down"));
    print CGI::start_body();
    print CGI::h1("SEED Server down");
    print CGI::p("The seed server is not currently running:");
    print CGI::pre($down_msg);
    print CGI::end_body();
    exit;
}

if ($FIG_Config::readonly)
{
    CGI::param("user", undef);
}
# -*- perl -*-
#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
# 
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License. 
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#


use FIG;
my $fig = new FIG;

use HTML;
use strict;

use CGI;
my $cgi = new CGI;

my $user = $cgi->param('user'); 
$fig->set_user($user);

if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/ff_check_parms`));
    $cgi = $VAR1;
#   print STDERR &Dumper($cgi);
}

if (0)
{
    print $cgi->header;
    my @params = $cgi->param;
    print "<pre>\n";
    foreach $_ (@params)
    {
	print "$_\t:",join(",",$cgi->param($_)),":\n";
    }

    if (0)
    {
	if (open(TMP,">/tmp/ff_check_parms"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}

my $html = [];
unshift @$html, "<TITLE>exclude_from_solid_rectangles.cgi: remove PEG from solid rectangles</TITLE>\n";

my($request);
my $peg;	
if (! ($peg = $cgi->param('peg')))
{
    push(@$html,$cgi->h1('You need to give a peg as input'));
}
else
{
    $peg =~ /^fig\|(\d+\.\d+)\.peg\.(\d+)/;
    my $g = $1;
    my $pegN = $2;
    my %to_del;
    if (-s "$FIG_Config::global/SolidRectangles")
    {
	my $backup = "$FIG_Config::global/SolidRectangles~";
	if (-s $backup)
	{
	    unlink($backup) || die "could not unlink $backup";
	}
	rename("$FIG_Config::global/SolidRectangles",$backup) 
	    || die "could not rename $FIG_Config::global/SolidRectangles";
	open(BACKUP,"<$backup") || die "could not open $backup";
	open(UPDATED,">$FIG_Config::global/SolidRectangles") 
	    || die "could not open $FIG_Config::global/SolidRectangles";
	$/ = "\n//\n";
	while (defined($_ = <BACKUP>))
	{
	    if ($_ !~ /\bfig\|$g\.peg\.$pegN\b/s)
	    {
		print UPDATED $_;
	    }
	    else
	    {
		foreach my $p ($_ =~ /(fig\|\d+\.\d+\.peg\.\d+)/g)
		{
		    $to_del{$p} = 1;
		}
	    }
	}
	close(BACKUP);
	close(UPDATED);
	$/ = "\n";
    }

    my %md5_to_del = map { ($fig->md5_of_peg($_) => 1 ) } keys(%to_del);

    if (-s "$FIG_Config::global/SolidRectangles.sets")
    {
	my $backup = "$FIG_Config::global/SolidRectangles.sets~";
	if (-s $backup)
	{
	    unlink($backup) || die "could not unlink $backup";
	}
	rename("$FIG_Config::global/SolidRectangles.sets",$backup) 
	    || die "could not rename $FIG_Config::global/SolidRectangles.sets";
	open(BACKUP,"<$backup") || die "could not open $backup";
	open(UPDATED,">$FIG_Config::global/SolidRectangles.sets") 
	    || die "could not open $FIG_Config::global/SolidRectangles.sets";
	while (defined($_ = <BACKUP>))
	{
	    if (($_ =~ /^(\S+)\t(\S+)/) && (! $md5_to_del{$2}))
	    {
		print UPDATED $_;
	    }
	}
	close(BACKUP);
	close(UPDATED);
    }

    my %exclude;
    if (-s "$FIG_Config::global/SolidRectangles.exclude")
    {
	%exclude = map { chomp; ($_ => 1) } `cat $FIG_Config::global/SolidRectangles.exclude`;
    }
    foreach $_ (keys(%to_del)) { $exclude{$_} = 1 }
    open(EXCLUDE,">>$FIG_Config::global/SolidRectangles.exclude")
	|| die "could not open $FIG_Config::global/SolidRectangles.exclude";
    foreach $_ (sort { &SeedUtils::by_fig_id($a,$b) } keys(%to_del))
    {
	print EXCLUDE "$_\n";
    }
    close(EXCLUDE);

    push(@$html,$cgi->h1("Removed $peg from Solid Rectangles"));
}
system "chmod 777 $FIG_Config::global/Solid*";

&HTML::show_page($cgi,$html);



MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3