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

View of /FigWebServices/check_sets.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (download) (annotate)
Wed Nov 21 22:31:51 2012 UTC (6 years, 11 months ago) by overbeek
Branch: MAIN
CVS Tags: rast_rel_2014_0729, rast_rel_2014_0912, HEAD
Changes since 1.2: +1 -1 lines
check for real fids

# -*- 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;
use DBKernel;

my $fig = new FIG;
use HTML;
use strict;
use URI::Escape;

use CGI;
my $cgi = new CGI;

if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/check_err_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/check_err_parms"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}

my $html = [];
unshift @$html, "<TITLE>Check Errors in Solid Rectangle Assignments</TITLE>\n";

my $user       = $cgi->param('user');
my $otu        = $cgi->param('otu');
my $set        = $cgi->param('set');

if (! $user)
{
    push(@$html,$cgi->h1('you need to specify a user'));
}
elsif ($set)
{
    my $picked = $cgi->param('picked');
    if ($picked =~ /^\d+\s*:\s+fig\|\d+\.\d+\.peg\.\d+\s+(\S.*\S)/)
    {
	$picked = $1;
	push(@$html,$cgi->h3("setting $set to $picked"));
	my @pegs = grep { $fig->is_real_feature($_) } 
	           map { (($_ =~ /^(\d+)\t(\S+)/)  && ($1 == $set)) ? $fig->pegs_with_md5($2) : () } `cat $FIG_Config::global/SolidRectangles.sets`;
#	push(@{$html},$cgi->h3("setting " .join(",",@pegs) . " to $picked"));
	$fig->assign_function($fig,\@pegs,$user,$picked,{expand_solid_rectangle => 1, 
							 annotation => "Annotator reconciliation" });
	$cgi->delete('set'),
	&display_otu($fig,$cgi,$html,$user,$otu);
    }
    else
    {
	push(@$html,$cgi->h3("picked: $picked is BAD"));
    }
}
elsif ($otu)
{
    &display_otu($fig,$cgi,$html,$user,$otu);
}
else
{
    push(@$html,$cgi->h3("OTUs with Solid Rectangles"),"<br>");
    &show_otus($fig,$cgi,$html,$user);
}
&HTML::show_page($cgi,$html, 1, undef, undef, undef, undef, { no_fig_search => 1 });

sub display_otu {
    my($fig,$cgi,$html,$user,$otu) = @_;

    if (open(INCON,"<$FIG_Config::global/SolidRectangles/$otu/inconsistent.sets"))
    {
	my %poss_bad = map { chop; $_ } <INCON>;
	&show_bad($fig,$cgi,$html,$user,\%poss_bad,$otu);
	close(INCON);
    }
    else
    {
	push(@$html,$cgi->m3("cannot open $FIG_Config::global/SolidRectangles/$otu/inconsistent.sets"));
    }
}

sub show_bad {
    my($fig,$cgi,$html,$user,$poss_bad,$otu) = @_;

    my $max = 20;
    if (open(SETS,"<$FIG_Config::global/SolidRectangles.sets"))
    {
	my $last = <SETS>;
	while ($last && ($last =~ /^(\d+)/))
	{
	    my $set  = $1;
	    my $md5s = [];
	    while ($last && ($last =~ /^(\d+)\t(\S+)/) && ($1 == $set))
	    {
		push(@$md5s,$2);
		$last = <SETS>;
	    }
	    if ($poss_bad->{$set} && $max)
	    {
		&process_set($fig,$cgi,$html,$user,$set,$md5s,\$max,$otu);
	    }
	}
	close(SETS);
    }
    else
    {
	push(@$html,$cgi->h3("$FIG_Config::global/SolidRectangles.sets is missing"));
    }
}

sub process_set {
    my($fig,$cgi,$html,$user,$set,$md5s,$maxP,$otu) = @_;

    my @pegs = grep { $fig->is_real_feature($_) } map { $fig->pegs_with_md5($_) } @$md5s;
    my %funcs;
    foreach my $peg (@pegs)
    {
	my $func = $fig->function_of($peg);
	push(@{$funcs{$func}},$peg);
    }
    if (keys(%funcs) > 1)
    {
	my @choices = map { [$_,scalar @{$funcs{$_}}] } sort { @{$funcs{$b}} <=> @{$funcs{$a}} } keys(%funcs);
	my $target = "window$$";
	push(@$html, $cgi->h3($set),
	     $cgi->start_form(-action => "check_sets.cgi",
			      -target => $target,
			      -method => 'post'),
	     $cgi->hidden(-name => 'user', -value => $user, -override => 1),
	     $cgi->hidden(-name => 'otu', -value => $otu, -override => 1),
	     $cgi->hidden(-name => 'set', -value => $set, -override => 1));

	my %exemplar = map { $_ => $funcs{$_}->[0] } keys(%funcs);

	my @values = ();
	my @added;
	foreach my $func (sort { @{$funcs{$b}} <=> @{$funcs{$a}} } keys(%funcs))
	{
	    my $v = scalar @{$funcs{$func}} . ": " . "  " . $exemplar{$func} . "  " . $func;
	    push(@values,$v);
	    my $peg_link = &HTML::fid_link($cgi,$exemplar{$func});
	    push(@added,"$peg_link:  $v");
	}
		 
	my %labels;   ### go with no "labels"
	for (my $i=0; ($i < @values); $i++)
	{
	    $labels{$values[$i]} = '';
	}
	my @buttons = $cgi->radio_group( -name => "picked", -values => \@values, -labels => \%labels);
	for (my $i=0; ($i < @values); $i++)
	{
	    push(@$html,$buttons[$i],$added[$i],"<br>");
	}
	push(@$html, 
	            "<br>",$cgi->submit("pick a function"),
                    $cgi->end_form);
	push(@$html,"<hr>");
	$$maxP--;
    }
}



sub func_of {
    my($fig,$peg) = @_;

    my $f = $fig->function_of($peg);
    if (! $f) { $f = "hypothetical protein" }
    $f =~ s/\s+\#.*//;
    return $f;
}

	

sub show_otus {
    my($fig,$cgi,$html,$user) = @_;

    if (opendir(SOLID,"$FIG_Config::global/SolidRectangles"))
    {
	my @otus = grep { $_ =~ /^\d+$/ } readdir(SOLID);
	closedir(SOLID);
	my %existing_otus_with_sr = map { $_ => 1 } @otus;
	my %otus;
	open(OTUS,"<$FIG_Config::global/genome.sets") || die "could not open $FIG_Config::global/genome.sets";
	while (defined($_ = <OTUS>))
	{
	    if (($_ =~ /^(\d+)\t(\S+)\t(\S.*\S)/) && $existing_otus_with_sr{$1} && (! $otus{$1}))
	    {
		my $otu    = $1;
		my $genome = $2;
		my $name   = $3;
		if (! $otus{$otu})
		{
		    $otus{$otu} = [$genome,$name];
		    my $url = "./check_sets.cgi?user=$user&otu=$otu";
		    push(@$html,"<a href=$url>$otu</a>: $name, $genome<br>\n");
		}
	    }
	}
    }
    else
    {
	push(@$html,$cgi->m2("Solid Rectangles are Not Installed"));
    }
}
	

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3