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

Diff of /FigWebServices/pir.cgi

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

revision 1.22, Sun Apr 3 02:15:15 2005 UTC revision 1.23, Sun Apr 3 19:11:11 2005 UTC
# Line 84  Line 84 
84  elsif ($cgi->param('pirsf') && !($cgi->param('submit') eq "Update view")) {  elsif ($cgi->param('pirsf') && !($cgi->param('submit') eq "Update view")) {
85   # we want to display one of the correspondences   # we want to display one of the correspondences
86   my $selfurl=$cgi->url;   my $selfurl=$cgi->url;
87   push @$html, $cgi->p, "<a href=\"/FIG/Html/pir.html#correspondence\" class=\"help\" target=\"_blank\">Help on this correspondence table</a>";   push @$html, $cgi->p, "<a href=\"/FIG/Html/pir.html#correspondence\" class=\"help\" target=\"pirhelp\">Help on this correspondence table</a>";
88   if ($cgi->param('ssonly')) {push @$html, "<a href=\"$selfurl?pirsf=" . $cgi->param("pirsf") . "&user=$user\">Show All Matches</a>\n"}   if ($cgi->param('ssonly')) {push @$html, "<a href=\"$selfurl?pirsf=" . $cgi->param("pirsf") . "&user=$user\">Show All Matches</a>\n"}
89   else {push @$html, "<a href=\"$selfurl?pirsf=" . $cgi->param("pirsf") . "&ssonly='1'&user=$user\">Show only matches with a subsystem</a>\n"}   else {push @$html, "<a href=\"$selfurl?pirsf=" . $cgi->param("pirsf") . "&ssonly='1'&user=$user\">Show only matches with a subsystem</a>\n"}
90    
# Line 92  Line 92 
92   my $tab = [];   my $tab = [];
93    
94   # figure out the colors   # figure out the colors
95     my %color;
96     {
97   my %function_cnt; my $max;   my %function_cnt; my $max;
98   foreach my $peg (@{$pegbypir->{$cgi->param('pirsf')}}) {   foreach my $peg (@{$pegbypir->{$cgi->param('pirsf')}}) {
99    my $fn=scalar $fig->function_of($peg);     $function_cnt{scalar $fig->function_of($peg)}++;
   $function_cnt{$fn}++;  
   if ($function_cnt{$fn} > $max) {$max=$function_cnt{$fn}}  
100   }   }
101    
102      my @all_functions=sort {$function_cnt{$b} <=> $function_cnt{$a}} keys %function_cnt;
103   my @color=&cool_colors();   my @color=&cool_colors();
104    
105      for (my $i=0; $i<=$#all_functions; $i++) {
106       if ($i > $#color) {$color{$all_functions[$i]}="#FFFFFF"}
107       else {$color{$all_functions[$i]}=$color[$i]}
108      }
109     }
110    
111   foreach my $peg (@{$pegbypir->{$cgi->param('pirsf')}}) {   foreach my $peg (@{$pegbypir->{$cgi->param('pirsf')}}) {
112    my @sslinks;    my @sslinks;
# Line 114  Line 120 
120    $pirlink =~ /^PIR(SF\d+)/;    $pirlink =~ /^PIR(SF\d+)/;
121    $pirlink="<a href='http://pir.georgetown.edu/sfcs-cgi/new/pirclassif.pl?id=$1'>PIR$1</a>" . $pirid->{$cgi->param('pirsf')};    $pirlink="<a href='http://pir.georgetown.edu/sfcs-cgi/new/pirclassif.pl?id=$1'>PIR$1</a>" . $pirid->{$cgi->param('pirsf')};
122    next if ($cgi->param("ssonly") && !(scalar @sslinks));    next if ($cgi->param("ssonly") && !(scalar @sslinks));
   my $colornumber=$max - $function_cnt{scalar $fig->function_of($peg)}; # the most abundant function gets the first color  
   my $color="#FFFFFF";  
   if ($colornumber <= $#color) {$color=$color[$colornumber]}  
123    push (@$tab,    push (@$tab,
124                  [$pirlink,                  [$pirlink,
125                  $fig->genus_species($fig->genome_of($peg)),                  $fig->genus_species($fig->genome_of($peg)),
126                  &HTML::uni_link($cgi,$fig->to_alias($peg,"uni")),                  &HTML::uni_link($cgi,$fig->to_alias($peg,"uni")),
127                  &HTML::fid_link($cgi, $peg, 1),                  &HTML::fid_link($cgi, $peg, 1),
128                  [scalar $fig->function_of($peg), "td style=\"background: $color\""],                  [scalar $fig->function_of($peg), "td style=\"background: $color{scalar $fig->function_of($peg)}\""],
129                  (join ", ", @sslinks)]                  (join ", ", @sslinks)]
130          );          );
131   }   }
# Line 175  Line 178 
178    if ($cgi->param('showsubsys')) {$display->{$sf}=$displayname . " [". scalar @{$pegbypir->{$sf}} . "/". (scalar keys %{$ss->{$sf}}) . "]"}    if ($cgi->param('showsubsys')) {$display->{$sf}=$displayname . " [". scalar @{$pegbypir->{$sf}} . "/". (scalar keys %{$ss->{$sf}}) . "]"}
179    else {$display->{$sf}=$displayname . " [". scalar @{$pegbypir->{$sf}} . "]"}    else {$display->{$sf}=$displayname . " [". scalar @{$pegbypir->{$sf}} . "]"}
180   }   }
  unshift @pirsf, ''; $display->{''}='';  
181    
182    
183   push (@$html, $cgi->start_form(-action => "pir.cgi"),   push (@$html, $cgi->start_form(-action => "pir.cgi"),
184    $cgi->h2("Please choose your super family"),    $cgi->h2("Please choose your super family"),
185    "\nFirst, please enter a username: ", $cgi->textfield(-name=>"user", -value=>$user), $cgi->p,    "\nFirst, please enter a username: ", $cgi->textfield(-name=>"user", -value=>$user), $cgi->p,
186    "\n<a href=\"/FIG/Html/pir.html\" class=\"help\" target=\"_blank\">Help on SEED/PIR Correspondence</a>",    "\n<a href=\"/FIG/Html/pir.html\" class=\"help\" target=\"pirhelp\">Help on SEED/PIR Correspondence</a>",
187    "\nThe list shows the PIR superfamilies. If only one number is shown (default) this is the number of PEGs that map to that superfamily. ",    "\nThe list shows the PIR superfamilies. If only one number is shown (default) this is the number of PEGs that map to that superfamily. ",
188    "\nIf you choose to show subsystem counts in this menu, you will get two numbers. The first of the two numbers in parenthesis is the number ",    "\nIf you choose to show subsystem counts in this menu, you will get two numbers. The first of the two numbers in parenthesis is the number ",
189    "\nof PEGs that map to that superfamily, and the second number in parenthesis is the number of <em>different</em> ",    "\nof PEGs that map to that superfamily, and the second number in parenthesis is the number of <em>different</em> ",
190    "\nsubsystems that those PEGs are in.\n", $cgi->p,"\n",    "\nsubsystems that those PEGs are in.\n", $cgi->p,"\n",
191    $cgi->scrolling_list(-name=>'pirsf', -values=>[keys %$display], -labels=>$display, -size=>10), $cgi->p,"\n",    $cgi->scrolling_list(-name=>'pirsf', -values=>[keys %$display], -labels=>$display, -size=>10), $cgi->p,"\n",
192    "\nNummber of superfamilies shown: ", scalar keys %$display, $cgi->p,"\n",    "\nNummber of superfamilies shown: ", scalar keys %$display, $cgi->p,"\n",
193    "\n<a href=\"/FIG/Html/pir.html#menu\" class=\"help\" target=\"_blank\">Help on the menu contents</a>","\n",    "\n<a href=\"/FIG/Html/pir.html#menu\" class=\"help\" target=\"pirhelp\">Help on the menu contents</a>","\n",
194    "\nMinimum number of pegs per PIR superfamily shown in list &nbsp; <input type='text' name='min' value='$min' size=3 />","\n",    "\nMinimum number of pegs per PIR superfamily shown in list &nbsp; <input type='text' name='min' value='$min' size=3 />","\n",
195    "\nor show all PIR superfamilies: ", $cgi->checkbox(-name=>"showall", -label=>""), $cgi->p,"\n",    "\nor show all PIR superfamilies: ", $cgi->checkbox(-name=>"showall", -label=>""), $cgi->p,"\n",
196    $cgi->checkbox(-name=>"showsubsys", -label=>"Show subsystem counts in list"), $cgi->p,"\n",    $cgi->checkbox(-name=>"showsubsys", -label=>"Show subsystem counts in list"), $cgi->p,"\n",
# Line 198  Line 200 
200    $cgi->reset,"\n",    $cgi->reset,"\n",
201    $cgi->p, $cgi->hr, $cgi->p,"\n",    $cgi->p, $cgi->hr, $cgi->p,"\n",
202    $cgi->p("<strong>Generate Data Tables</strong>"),    $cgi->p("<strong>Generate Data Tables</strong>"),
203    "<a href=\"/FIG/Html/pir.html#datatables\" class=\"help\" target=\"_blank\">Help on Generating Data Tables</a>",    "<a href=\"/FIG/Html/pir.html#datatables\" class=\"help\" target=\"pirhelp\">Help on Generating Data Tables</a>",
204    $cgi->p("The data tables are an alternative way to view the data in summary form. For the summary of the comparisons between PIR and SEED annotations, please check here:\n"),    $cgi->p("The data tables are an alternative way to view the data in summary form. For the summary of the comparisons between PIR and SEED annotations, please check here:\n"),
205    $cgi->checkbox(-name=>"onlyss", -label=>"Show only those PEGs that are in a subsystem and a superfamily", -checked=>"on"), $cgi->p,"\n",    $cgi->checkbox(-name=>"onlyss", -label=>"Show only those PEGs that are in a subsystem and a superfamily", -checked=>"on"), $cgi->p,"\n",
206    $cgi->checkbox(-name=>"totalsort", -label=>"Sort by the total number of different annotations"), $cgi->p,"\n",    $cgi->checkbox(-name=>"totalsort", -label=>"Sort by the total number of different annotations"), $cgi->p,"\n",
# Line 206  Line 208 
208    $cgi->reset,"\n",    $cgi->reset,"\n",
209    $cgi->p, $cgi->hr, "\n",    $cgi->p, $cgi->hr, "\n",
210    $cgi->p("<strong>Check for Updates</strong>"),"\n",    $cgi->p("<strong>Check for Updates</strong>"),"\n",
211    "<a href=\"/FIG/Html/pir.html#updates\" class=\"help\" target=\"_blank\">Help on updates</a>", "\n",    "<a href=\"/FIG/Html/pir.html#updates\" class=\"help\" target=\"pirhelp\">Help on updates</a>", "\n",
212    $cgi->p("Please click the button to check the PIR site and see whether there is a new version of the PIR superfamily data you should use"),"\n",    $cgi->p("Please click the button to check the PIR site and see whether there is a new version of the PIR superfamily data you should use"),"\n",
213    $cgi->submit('submit', 'Check for updates'),"\n",    $cgi->submit('submit', 'Check for updates'),"\n",
214    $cgi->end_form,    $cgi->end_form,
# Line 228  Line 230 
230  =cut  =cut
231    
232  sub read_pir_file {  sub read_pir_file {
  my ($caller)=@_;  
  # make sure that we have the files, and if not use the update mechanism to get them. This is a little recursive  
  # since the update method calls this method, so we have a check for this  
233   unless (-e $pir_file_from_pir) {   unless (-e $pir_file_from_pir) {
234    if ($caller eq "update_data") {    # background the job here
235     die "read_pir_file was called from the update method, but there is no file to read, and so we were going to enter an endless loop";    &update_data($html);
236    }    }
   
   # because this is receursive, update_data will call this method and use the output from that. I think this could be a horrible nightmare,  
   # but we'll see what happens. Fun, eh?  
   my ($pegbypir, $pirid);  
   ($html, $pegbypir, $pirid)=update_data($html);  
   return ($pegbypir, $pirid);  
  }  
   
   
237   # just read the file, convert it to an HTML table and return it   # just read the file, convert it to an HTML table and return it
238   unless (-e $pir_correspondence_file) {   unless (-e $pir_correspondence_file) {
239    #print STDERR "Can't find the correspondence file pirsfcorrespondence.txt so we are going to make it\n";    #print STDERR "Can't find the correspondence file pirsfcorrespondence.txt so we are going to make it\n";
240    raelib->pirsfcorrespondence($pir_file_from_pir, $pir_correspondence_file);    raelib->pirsfcorrespondence($pir_file_from_pir, $pir_correspondence_file);
241      push @$html, "<h2 style=\"background: red\">The PIR correspondence file was rebuilt for you</h2>";
242   }   }
243   open (IN, $pir_correspondence_file) || die "Can't open $pir_correspondence_file";   open (IN, $pir_correspondence_file) || die "Can't open $pir_correspondence_file";
244   my $pir;   my $pir;
# Line 387  Line 378 
378   # to save the information for a while in case something happens. At somepoint we should probably move these to /tmp or delete them   # to save the information for a while in case something happens. At somepoint we should probably move these to /tmp or delete them
379   # or something.   # or something.
380   my $html=shift;   my $html=shift;
  my $count=1;  
  while (-e "$pir_file_from_pir.$count") {$count++}  
  rename($pir_file_from_pir, "$pir_file_from_pir.$count");  
  rename($pir_correspondence_file, "$pir_correspondence_file.$count");  
   
  # now use LWP to get the data  
  my $gotit=LWP::Simple::getstore($pir_source_file, $pir_file_from_pir);  
   
  unless ($gotit) {  
   push @$html, "<h1>WARNING: There was an error downloading the data from $pir_source_file to $pir_file_from_pir. The old data was retained</h1>";  
   rename("$pir_file_from_pir.$count", $pir_file_from_pir);  
   rename("$pir_correspondence_file.$count", $pir_correspondence_file);  
  }  
   
  # now we just need to instantiate the new data  
  # we can just delegate this to read_pir_file for us  
  ($pegbypir, $pirid) =&read_pir_file("update_data");  
381    
382   push @$html, "<h1 style=\"background: lightblue\">SUCCESS. The new data was installed and is shown in the table below</h1>";   # here we need to background downloading and installing the data.
383   return $html, $pegbypir, $pirid;   my $bkj=$fig->run_in_background(sub
384       {
385         print "Loading new PIR superfamily data\n";
386         system("load_pirsf");
387         print "Complete\n";
388       }
389     );
390    
391     push @$html, "<h2 style=\"background: red\">Downloading and installing new data has started in the background but will likely take some time.<br />\n",
392        "The job has an ID of $bkj, and you can check it out from the <A href=\"/FIG/seed_ctl.cgi\">SEED Control Panel</a></h2>\n";
393    
394     return $html;
395  }  }
396    
397    

Legend:
Removed from v.1.22  
changed lines
  Added in v.1.23

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3