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

Diff of /FigWebServices/index.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6, Sun Dec 28 17:11:29 2003 UTC revision 1.7, Sat Jan 3 06:03:43 2004 UTC
# Line 7  Line 7 
7  use CGI;  use CGI;
8  my $cgi = new CGI;  my $cgi = new CGI;
9    
10  my($map,@orgs,$user,$map,$org);  my($map,@orgs,$user,$map,$org,$made_by);
11    
12  if (0)  if (0)
13  {  {
# Line 106  Line 106 
106          &run_dna_scan_for_matches($fig,$cgi,$html,$orgs[0],$seq_pat);          &run_dna_scan_for_matches($fig,$cgi,$html,$orgs[0],$seq_pat);
107      }      }
108  }  }
109    elsif (($made_by = $cgi->param('made_by')) && $cgi->param('Extract Assignments'))
110    {
111        &export_assignments($fig,$cgi,$html,$made_by);
112    }
113  else  else
114  {  {
115      &show_initial($fig,$cgi,$html);      &show_initial($fig,$cgi,$html);
# Line 165  Line 169 
169                  $cgi->popup_menu(-name => 'Tool', -values => ['blastp','blastx','blastn','tblastn','Protein scan_for_matches','DNA scan_for_matches'], -default => 'blastp'),                  $cgi->popup_menu(-name => 'Tool', -values => ['blastp','blastx','blastn','tblastn','Protein scan_for_matches','DNA scan_for_matches'], -default => 'blastp'),
170                  $cgi->submit('Search for Matches'),                  $cgi->submit('Search for Matches'),
171                  $cgi->hr,                  $cgi->hr,
172                    $cgi->h1('Exporting Assignments'),
173                    "Extract assignments made by ",
174                    $cgi->textfield(-name => "made_by", -size => 50),
175                    $cgi->br,
176                    $cgi->checkbox(-label => 'tab-delimited Spreadsheet', -name => 'tabs', -value => 1),
177                    $cgi->br,
178                    $cgi->submit('Extract Assignments'),
179                    $cgi->hr,
180                  $cgi->h1('Searching for Interesting Genes'),                  $cgi->h1('Searching for Interesting Genes'),
181                  $cgi->submit('Search for Genes Matching an Occurrence Profile'),                  $cgi->submit('Search for Genes Matching an Occurrence Profile'),
182                  $cgi->end_form,                  $cgi->end_form,
# Line 455  Line 467 
467          }          }
468      }      }
469  }  }
470    
471    sub export_assignments {
472        my($fig,$cgi,$html,$who) = @_;
473        my($genome,$x);
474    
475        my @genomes = map { $_ =~ /\((\d+\.\d+)\)/; $1 } $cgi->param('korgs');
476    
477        if (@genomes == 0)
478        {
479            @genomes = $fig->genomes;
480        }
481    
482        my @assignments = &assignments_made($fig,\@genomes,$who,$cgi->param('date'));
483        if (@assignments == 0)
484        {
485            push(@$html,$cgi->h1("Sorry, no assignments where made by $who"));
486        }
487        else
488        {
489            my $col_hdrs = ["FIG id", "External ID", "Genus/Species","Assignment"];
490            my $tab = [];
491            my($x,$peg,$func);
492            foreach $x (@assignments)
493            {
494                ($peg,$func) = @$x;
495                push(@$tab,[$peg,&ext_id($fig,$peg),$fig->genus_species($fig->genome_of($peg)),$func]);
496            }
497            if ($cgi->param('tabs'))
498            {
499                print $cgi->header;
500                print "<pre>\n";
501                print join("",map { join("\t",@$_) . "\n" } @$tab);
502                print "</pre>\n";
503                exit;
504            }
505            else
506            {
507                push(@$html,&HTML::make_table($col_hdrs,$tab,"Assignments Made by $who"));
508            }
509        }
510    }
511    
512    sub ext_id {
513        my($fig,$peg) = @_;
514    
515        my @mapped = grep { $_ !~ /^fig/ } map { $_->[0] } $fig->mapped_prot_ids($peg);
516        if (@mapped == 0)
517        {
518            return $peg;
519        }
520    
521        my @tmp = ();
522        if ((@tmp = grep { $_ =~ /^sp/ }   @mapped) && (@tmp > 0))  { return $tmp[0] }
523        if ((@tmp = grep { $_ =~ /^pir/ }  @mapped) && (@tmp > 0))  { return $tmp[0] }
524        if ((@tmp = grep { $_ =~ /^gi/ }   @mapped) && (@tmp > 0))  { return $tmp[0] }
525        if ((@tmp = grep { $_ =~ /^tr/ }   @mapped) && (@tmp > 0))  { return $tmp[0] }
526        if ((@tmp = grep { $_ =~ /^tn/ }   @mapped) && (@tmp > 0))  { return $tmp[0] }
527        if ((@tmp = grep { $_ =~ /^kegg/ } @mapped) && (@tmp > 0))  { return $tmp[0] }
528    
529        return $peg;
530    }
531    
532    sub assignments_made {
533        my($fig,$genomes,$who,$date) = @_;
534        my($relational_db_response,$entry,$fid,$fileno,$seek,$len,$ann);
535    
536        my %genomes = map { $_ => 1 } @$genomes;
537        $date = defined($date) ? $date-1 : 0;
538        my @assignments = ();
539        my $rdbH = $fig->db_handle;
540        if (($relational_db_response = $rdbH->SQL("SELECT fid, fileno, seek, len  FROM annotation_seeks WHERE (( who = \'$who\' ) AND (dateof > $date))")) &&
541            (@$relational_db_response > 0))
542        {
543            foreach $entry (@$relational_db_response)
544            {
545                ($fid,$fileno,$seek,$len) = @$entry;
546                if (($fid =~ /^fig\|(\d+\.\d+)/) && $genomes{$1})
547                {
548                    $ann = $fig->read_annotation($fileno,$seek,$len);
549    
550                    if (($ann =~ /^(fig\|\d+\.\d+\.peg\.\d+)\n(\d+)\n(\S+)\nSet ([^\n]*)function[^\n]*\n(\S[^\n]+\S)/s) &&
551                        (($who eq $3) || (($4 eq "master ") && ($who eq "master"))) &&
552                        ($2 >= $date))
553                    {
554                        push(@assignments,[$1,$5]);
555                    }
556                }
557            }
558        }
559        return @assignments;
560    }

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3