[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.21, Sat Mar 26 13:30:57 2005 UTC revision 1.22, Sun Apr 3 02:15:15 2005 UTC
# Line 14  Line 14 
14  use raelib;  use raelib;
15  use CGI;  use CGI;
16  my $cgi=new CGI;  my $cgi=new CGI;
17    use LWP::Simple qw(!head); # see the caveat in perldoc LWP about importing two head methods.
18    
19  my $fig;  my $fig;
20  eval {  eval {
# Line 44  Line 44 
44    
45  $ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};  $ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};
46    
47    
48    # these should probably be in FIG::Config. Oh well.
49    my $pir_file_from_pir="$FIG_Config::data/Global/pirsfinfo.dat";
50    my $pir_correspondence_file="$FIG_Config::data/Global/pirsfcorrespondence.txt";
51    my $pir_source_file="ftp://ftp.pir.georgetown.edu/pir_databases/pirsf/data/pirsfinfo.dat";
52    
53    # ha ha ha ha ha
54    # I am an idiot, and can't spell. so we need to correct that and make sure we always use an e
55    if (-e "$FIG_Config::data/Global/pirsfcorrespondance.txt") {rename("$FIG_Config::data/Global/pirsfcorrespondance.txt", $pir_correspondence_file)}
56    
57    
58    
59  my $html = [];  my $html = [];
60  my $user = $cgi->param('user');  my $user = $cgi->param('user');
61    
62  unshift(@$html, "<TITLE>The SEED - PIR/SEED comparisons </TITLE>\n");  unshift(@$html, "<TITLE>The SEED - PIR/SEED comparisons </TITLE>\n");
63  # make sure that we read the file at the beginning  # make sure that we read the file at the beginning
64  my ($pegbypir, $pirid) =&read_pir_file();  my ($pegbypir, $pirid) =&read_pir_file("initial");
65    
66    # if we are going to update the data, we do that and then we present the blank form with the new data
67    # this will also reset $pegbypir and $pirid
68    if ($cgi->param('submit') =~ m/^Update/) {
69     # this should catch Update Data and Updata Anyway
70     ($html, $pegbypir, $pirid)=&update_data($html);
71    }
72    
73    
74    
75    
76  if ($cgi->param('submit') eq "Tabulate summary") {  if ($cgi->param('submit') eq "Tabulate summary") {
77   $html=&table_annotations($html, $pegbypir, $pirid);   $html=&table_annotations($html, $pegbypir, $pirid);
78   push @$html, $cgi->p({class=>"diagnostic"}, ("<small>Generating this table took approximately " . (time-$^T) . " seconds\n</small>"));   push @$html, $cgi->p({class=>"diagnostic"}, ("\n<small>Generating this table took approximately " . (time-$^T) . " seconds\n</small>"));
79    }
80    elsif ($cgi->param('submit') eq "Check for updates") {
81     $html=&check_updates($html);
82     push @$html, $cgi->p({class=>"diagnostic"}, ("\n<small>Checking for updates took approximately " . (time-$^T) . " seconds\n</small>"));
83  }  }
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;   push @$html, $cgi->p, "<a href=\"/FIG/Html/pir.html#correspondence\" class=\"help\" target=\"_blank\">Help on this correspondence table</a>";
88   if ($cgi->param('ssonly')) {push @$html, "<a href=\"$selfurl?pirsf=" . $cgi->param("pirsf") . "&user=" . $cgi->param('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=" . $cgi->param('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    
91   my $col_hdrs = ["PIR Superfamily<br><small>Link goes to PIR<small>", "Genome", "UniProt","PEG", "FIG Function", "FIG Subsystem"];   my $col_hdrs = ["PIR Superfamily<br><small>Link goes to PIR<small>", "Genome", "UniProt","PEG", "FIG Function", "FIG Subsystem"];
92   my $tab = [];   my $tab = [];
93    
94     # figure out the colors
95     my %function_cnt; my $max;
96     foreach my $peg (@{$pegbypir->{$cgi->param('pirsf')}}) {
97      my $fn=scalar $fig->function_of($peg);
98      $function_cnt{$fn}++;
99      if ($function_cnt{$fn} > $max) {$max=$function_cnt{$fn}}
100     }
101    
102     my @color=&cool_colors();
103    
104    
105   foreach my $peg (@{$pegbypir->{$cgi->param('pirsf')}}) {   foreach my $peg (@{$pegbypir->{$cgi->param('pirsf')}}) {
106    my @sslinks;    my @sslinks;
107    foreach my $subsys ($fig->subsystems_for_peg($peg)) {    foreach my $subsys ($fig->subsystems_for_peg($peg)) {
108     push @sslinks, $cgi->a({href => "subsys.cgi?&user=$user&ssa_name=" . $$subsys[0] . "&request=show_ssa"}, $$subsys[0]);     my $spaced=$$subsys[0];
109       $spaced =~ s/_/ /g;
110       push @sslinks, $cgi->a({href => "subsys.cgi?&user=$user&ssa_name=" . $$subsys[0] . "&request=show_ssa"}, $spaced);
111    }    }
112    
113    my $pirlink=$cgi->param('pirsf');    my $pirlink=$cgi->param('pirsf');
114    $pirlink =~ /^PIR(SF\d+)/;    $pirlink =~ /^PIR(SF\d+)/;
115    $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')};
116    next if ($cgi->param("ssonly") && !(scalar @sslinks));    next if ($cgi->param("ssonly") && !(scalar @sslinks));
117    push (@$tab, [$pirlink, $fig->genus_species($fig->genome_of($peg)), &HTML::uni_link($cgi,$fig->to_alias($peg,"uni")),&HTML::fid_link($cgi, $peg, 1), (scalar $fig->function_of($peg)), (join ", ", @sslinks)]);    my $colornumber=$max - $function_cnt{scalar $fig->function_of($peg)}; # the most abundant function gets the first color
118      my $color="#FFFFFF";
119      if ($colornumber <= $#color) {$color=$color[$colornumber]}
120      push (@$tab,
121                    [$pirlink,
122                    $fig->genus_species($fig->genome_of($peg)),
123                    &HTML::uni_link($cgi,$fig->to_alias($peg,"uni")),
124                    &HTML::fid_link($cgi, $peg, 1),
125                    [scalar $fig->function_of($peg), "td style=\"background: $color\""],
126                    (join ", ", @sslinks)]
127            );
128   }   }
129   push(@$html,&HTML::make_table($col_hdrs,$tab,"Correspondence between SEED and PIR"));   push(@$html,&HTML::make_table($col_hdrs,$tab,"\nCorrespondence between SEED and PIR"));
130  }  }
131  else {  else {
132   unshift @$html, "<TITLE>The SEED - PIR comparison page</TITLE>\n";   unshift @$html, "<TITLE>The SEED - PIR comparison page</TITLE>\n";
# Line 130  Line 177 
177   }   }
178   unshift @pirsf, ''; $display->{''}='';   unshift @pirsf, ''; $display->{''}='';
179    
180    
181   push (@$html, $cgi->start_form(-action => "pir.cgi"),   push (@$html, $cgi->start_form(-action => "pir.cgi"),
182    $cgi->h2("Please choose your super family"),    $cgi->h2("Please choose your super family"),
183    "First, please enter a username: ", $cgi->textfield(-name=>"user"), $cgi->p,    "\nFirst, please enter a username: ", $cgi->textfield(-name=>"user", -value=>$user), $cgi->p,
184    "The pull down list shows the PIR superfamilies. If only one number is shown (default) this is the number of PEGs that map to that superfamily. ",    "\n<a href=\"/FIG/Html/pir.html\" class=\"help\" target=\"_blank\">Help on SEED/PIR Correspondence</a>",
185    "If 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 ",    "\nThe list shows the PIR superfamilies. If only one number is shown (default) this is the number of PEGs that map to that superfamily. ",
186    "of PEGs that map to that superfamily, and the second number in parenthesis is the number of <em>different</em> ",    "\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 ",
187    "subsystems that those PEGs are in.\n", $cgi->p,    "\nof PEGs that map to that superfamily, and the second number in parenthesis is the number of <em>different</em> ",
188    $cgi->scrolling_list(-name=>'pirsf', -values=>[keys %$display], -labels=>$display, -size=>10), $cgi->p,    "\nsubsystems that those PEGs are in.\n", $cgi->p,"\n",
189    "\nMinimum number of pegs per PIR superfamily shown in list &nbsp; <input type='text' name='min' value='$min' size=3 />",    $cgi->scrolling_list(-name=>'pirsf', -values=>[keys %$display], -labels=>$display, -size=>10), $cgi->p,"\n",
190    "or show all PIR superfamilies: ", $cgi->checkbox(-name=>"showall", -label=>""), $cgi->p,    "\nNummber of superfamilies shown: ", scalar keys %$display, $cgi->p,"\n",
191    $cgi->checkbox(-name=>"showsubsys", -label=>"Show subsystem counts in pull down menu (this will slow things down!)"), $cgi->p,    "\n<a href=\"/FIG/Html/pir.html#menu\" class=\"help\" target=\"_blank\">Help on the menu contents</a>","\n",
192    $cgi->checkbox(-name=>"preliminary", -label=>"Show only preliminary PIR superfamilies"), $cgi->p,    "\nMinimum number of pegs per PIR superfamily shown in list &nbsp; <input type='text' name='min' value='$min' size=3 />","\n",
193    $cgi->submit('submit', 'Update view'),    "\nor show all PIR superfamilies: ", $cgi->checkbox(-name=>"showall", -label=>""), $cgi->p,"\n",
194    $cgi->submit('submit', 'Show Correspondence'),    $cgi->checkbox(-name=>"showsubsys", -label=>"Show subsystem counts in list"), $cgi->p,"\n",
195    $cgi->reset,    $cgi->checkbox(-name=>"preliminary", -label=>"Show only preliminary PIR superfamilies"), $cgi->p,"\n",
196    $cgi->p, $cgi->hr, $cgi->p,    $cgi->submit('submit', 'Update view'),"\n",
197    "To view a summary of the comparisons between PIR and SEED annotations, please check here:", $cgi->p,    $cgi->submit('submit', 'Show Correspondence'),"\n",
198    $cgi->checkbox(-name=>"onlyss", -label=>"Show only those PEGs that are in a subsystem and a superfamily", -checked=>"on"), $cgi->p,    $cgi->reset,"\n",
199    $cgi->checkbox(-name=>"totalsort", -label=>"Sort by the total number of different annotations"), $cgi->p,    $cgi->p, $cgi->hr, $cgi->p,"\n",
200    $cgi->submit('submit', 'Tabulate summary'),    $cgi->p("<strong>Generate Data Tables</strong>"),
201    $cgi->reset,    "<a href=\"/FIG/Html/pir.html#datatables\" class=\"help\" target=\"_blank\">Help on Generating Data Tables</a>",
202      $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"),
203      $cgi->checkbox(-name=>"onlyss", -label=>"Show only those PEGs that are in a subsystem and a superfamily", -checked=>"on"), $cgi->p,"\n",
204      $cgi->checkbox(-name=>"totalsort", -label=>"Sort by the total number of different annotations"), $cgi->p,"\n",
205      $cgi->submit('submit', 'Tabulate summary'),"\n",
206      $cgi->reset,"\n",
207      $cgi->p, $cgi->hr, "\n",
208      $cgi->p("<strong>Check for Updates</strong>"),"\n",
209      "<a href=\"/FIG/Html/pir.html#updates\" class=\"help\" target=\"_blank\">Help on updates</a>", "\n",
210      $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",
211      $cgi->submit('submit', 'Check for updates'),"\n",
212    $cgi->end_form,    $cgi->end_form,
213   );   );
214    
# Line 172  Line 228 
228  =cut  =cut
229    
230  sub read_pir_file {  sub read_pir_file {
231     my ($caller)=@_;
232     # make sure that we have the files, and if not use the update mechanism to get them. This is a little recursive
233     # since the update method calls this method, so we have a check for this
234     unless (-e $pir_file_from_pir) {
235      if ($caller eq "update_data") {
236       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";
237      }
238    
239      # because this is receursive, update_data will call this method and use the output from that. I think this could be a horrible nightmare,
240      # but we'll see what happens. Fun, eh?
241      my ($pegbypir, $pirid);
242      ($html, $pegbypir, $pirid)=update_data($html);
243      return ($pegbypir, $pirid);
244     }
245    
246    
247  # 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
248   unless (-e "$FIG_Config::data/Global/pirsfcorrespondance.txt") {   unless (-e $pir_correspondence_file) {
249    print STDERR "Can't find the correspondence file pirsfcorrespondance.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";
250    raelib->pirsfcorrespondance("$FIG_Config::data/Global/pirsfinfo.dat", "$FIG_Config::data/Global/pirsfcorrespondance.txt");    raelib->pirsfcorrespondence($pir_file_from_pir, $pir_correspondence_file);
251   }   }
252   open (IN, "$FIG_Config::data/Global/pirsfcorrespondance.txt") || die "Can't open $FIG_Config::data/Global/pirsfcorrespondance.txt";   open (IN, $pir_correspondence_file) || die "Can't open $pir_correspondence_file";
253   my $pir;   my $pir;
254   my $functions;   my $functions;
255   my $id;   my $id;
# Line 248  Line 319 
319     }     }
320    }    }
321    push @$tab, [    push @$tab, [
322     $countinss->{$sf},     "\n".$countinss->{$sf},
323     $count->{$sf},     $count->{$sf},
324     "<a href=\"http://seed-linux-2.uchicago.edu/FIG/pir.cgi?pirsf=$sf&ssonly='1'&user=''\">$sf</a>",     "<a href=\"/FIG/pir.cgi?pirsf=$sf&ssonly='1'&user='$user'\">$sf</a>",
325     $pirid->{$sf},     $pirid->{$sf},
326     $subsystems->{$sf},     $subsystems->{$sf},
327    ];    ];
# Line 258  Line 329 
329   push(@$html,&HTML::make_table($col_hdrs,$tab,""));   push(@$html,&HTML::make_table($col_hdrs,$tab,""));
330   return $html;   return $html;
331  }  }
332    
333    
334    =pod
335    
336    =head2 check_updates()
337    
338    Check the PIR remote site and see whether there are updates that we need to get
339    
340    =cut
341    
342    sub check_updates {
343     my $html=shift;
344    
345     # first lets see if we can get the times of the updates to see if we have a newer file
346     # using LWP::Simple. this is straight from the perldoc
347     my ($content_type, $document_length, $remotemtime, $expires, $server)=LWP::Simple::head($pir_source_file);
348     my $localmtime=0;
349     # if we don't have the file yet, we don't want to panic!
350     if (-e $pir_file_from_pir) {
351      my @stat=stat($pir_file_from_pir);
352      $localmtime=$stat[8];
353     }
354     # now we are going to translate the difference in times into some English for the website
355     if (!$remotemtime) {
356       push @$html, $cgi->p({class=>"error"}, "Could not connect to PIR to check the status of the PIR file. Please check the location of $pir_source_file");
357     }
358     elsif ($remotemtime > $localmtime) {
359      # the remote version is newer
360      push @$html, $cgi->p("\nThe remote file $pir_source_file is newer than your current file. You should proceed with the update."),
361            $cgi->p("\nThe remote file was modified on ". scalar(localtime($remotemtime))),
362            $cgi->p("\nThe local file was modified on ". scalar(localtime($localmtime))),
363            $cgi->start_form(), $cgi->hidden(-name=>"user", -value=>$user), $cgi->submit('submit', 'Update Data'), $cgi->end_form();
364     }
365     else {
366      # the local version is as new as the remote one.
367      push @$html, $cgi->p("\nThe local file is up to date and there is no need to update your source PIR superfamilies."),
368            $cgi->p("\nThe remote file was modified on ". scalar(localtime($remotemtime))),
369            $cgi->p("\nThe local file was modified on ". scalar(localtime($localmtime))),
370            $cgi->start_form(), $cgi->hidden(-name=>"user", -value=>$user), $cgi->submit('submit', 'Update Anyway'), $cgi->end_form();
371     }
372    
373     return $html;
374    }
375    
376    
377    =pod
378    
379    =head2 update_data()
380    
381    Download the new data file from pir, and generate the correspondence
382    
383    =cut
384    
385    sub update_data {
386     # rename the old correspondence file. We are going to add a number to the old file so that we keep it, but this should allow us
387     # to save the information for a while in case something happens. At somepoint we should probably move these to /tmp or delete them
388     # or something.
389     my $html=shift;
390     my $count=1;
391     while (-e "$pir_file_from_pir.$count") {$count++}
392     rename($pir_file_from_pir, "$pir_file_from_pir.$count");
393     rename($pir_correspondence_file, "$pir_correspondence_file.$count");
394    
395     # now use LWP to get the data
396     my $gotit=LWP::Simple::getstore($pir_source_file, $pir_file_from_pir);
397    
398     unless ($gotit) {
399      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>";
400      rename("$pir_file_from_pir.$count", $pir_file_from_pir);
401      rename("$pir_correspondence_file.$count", $pir_correspondence_file);
402     }
403    
404     # now we just need to instantiate the new data
405     # we can just delegate this to read_pir_file for us
406     ($pegbypir, $pirid) =&read_pir_file("update_data");
407    
408     push @$html, "<h1 style=\"background: lightblue\">SUCCESS. The new data was installed and is shown in the table below</h1>";
409     return $html, $pegbypir, $pirid;
410    }
411    
412    
413    
414    
415    
416    
417    sub cool_colors {
418     # just an array of "websafe" colors or whatever colors we want to use. Feel free to remove bad colors (hence the lines not being equal length!)
419     return (
420     '#C0C0C0', '#FF40C0', '#FF8040', '#FF0080', '#FFC040', '#40C0FF', '#40FFC0', '#C08080', '#C0FF00', '#00FF80', '#00C040',
421     "#6B8E23", "#483D8B", "#2E8B57", "#008000", "#006400", "#800000", "#00FF00", "#7FFFD4",
422     "#87CEEB", "#A9A9A9", "#90EE90", "#D2B48C", "#8DBC8F", "#D2691E", "#87CEFA", "#E9967A", "#FFE4C4", "#FFB6C1",
423     "#E0FFFF", "#FFA07A", "#DB7093", "#9370DB", "#008B8B", "#FFDEAD", "#DA70D6", "#DCDCDC", "#FF00FF", "#6A5ACD",
424     "#00FA9A", "#228B22", "#1E90FF", "#FA8072", "#CD853F", "#DC143C", "#FF6347", "#98FB98", "#4682B4",
425     "#D3D3D3", "#7B68EE", "#FF7F50", "#FF69B4", "#BC8F8F", "#A0522D", "#DEB887", "#00DED1",
426     "#6495ED", "#800080", "#FFD700", "#F5DEB3", "#66CDAA", "#FF4500", "#4B0082", "#CD5C5C",
427     "#EE82EE", "#7CFC00", "#FFFF00", "#191970", "#FFFFE0", "#DDA0DD", "#00BFFF", "#DAA520",
428     "#00FF7F", "#9400D3", "#BA55D3", "#D8BFD8", "#8B4513", "#3CB371", "#5F9EA0", "#4169E1", "#20B2AA", "#8A2BE2", "#ADFF2F",
429     "#F0FFFF", "#B0E0E6", "#FF1493", "#B8860B", "#FF0000", "#F08080", "#7FFF00", "#8B0000",
430     "#40E0D0", "#0000CD", "#48D1CC", "#8B008B", "#696969", "#AFEEEE", "#FF8C00", "#EEE8AA", "#A52A2A",
431     "#FFE4B5", "#B0C4DE", "#FAF0E6", "#9ACD32", "#B22222", "#FAFAD2", "#808080", "#0000FF",
432     "#000080", "#32CD32", "#FFFACD", "#9932CC", "#FFA500", "#F0E68C", "#E6E6FA", "#F4A460", "#C71585",
433     "#BDB76B", "#00FFFF", "#FFDAB9", "#ADD8E6", "#778899",
434     );
435    }
436    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3