[Bio] / FigKernelPackages / HTML.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/HTML.pm

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

revision 1.99, Tue Sep 19 21:19:14 2006 UTC revision 1.118, Fri Nov 2 17:22:06 2007 UTC
# Line 17  Line 17 
17    
18  package HTML;  package HTML;
19    
20    use strict;
21  use Tracer;  use Tracer;
22  use FIG;  use FIG;
23  use Carp;  use Carp;
# Line 27  Line 28 
28  use URI::URL;  use URI::URL;
29  use HTTP::Request::Common;  use HTTP::Request::Common;
30  use POSIX;  use POSIX;
31    use CGI;
32    
33  use raelib; # now used for the excel function, that should eventually end up in here. Way too experimental!  #use raelib; # now used for the excel function, that should eventually end up in here. Way too experimental!
34  my $raelib=new raelib;  my $raelib;
35    
36    
37  my $top_link_cache;  my $top_link_cache;
# Line 56  Line 58 
58    
59      my @parts = split(/\//, $ENV{SCRIPT_NAME});      my @parts = split(/\//, $ENV{SCRIPT_NAME});
60      my $top;      my $top;
61      if ($parts[-2] eq 'FIG')      if (defined $parts[-2] && $parts[-2] eq 'FIG')
62      {      {
63          $top = '.';          $top = '.';
64  #       warn "toplevel @parts\n";  #       warn "toplevel @parts\n";
65      }      }
66      elsif ($parts[-3] eq 'FIG')      elsif (defined $parts[-3] && $parts[-3] eq 'FIG')
67      {      {
68          $top = '..';          $top = '..';
69  #       warn "subdir @parts\n";  #       warn "subdir @parts\n";
# Line 163  Line 165 
165      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
166      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie, $options) = @_;      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie, $options) = @_;
167      my $i;      my $i;
168        Trace("Setting top link.") if T(3);
169      my $top = top_link();      my $top = top_link();
170    
171      # ARGUMENTS:      # ARGUMENTS:
# Line 180  Line 182 
182      #      #
183      # Find the HTML header      # Find the HTML header
184      #      #
185        Trace("Reading tail.") if T(3);
186        my $tail_name = $options->{tail_name} ? $options->{tail_name} : "html.tail";
187      my $html_tail_file = "./Html/$tail_name";      my $html_tail_file = "./Html/$tail_name";
188      if (! -f $html_tail_file)      if (! -f $html_tail_file)
189      {      {
190          $html_tail_file = "$FIG_Config::fig/CGI/Html/$tail_name";          $html_tail_file = "$FIG_Config::fig/CGI/Html/$tail_name";
191      }      }
192        Trace("Extracting user name and header data.") if T(3);
193      my $user = $cgi->param('user') || "";      my $user = $cgi->param('user') || "";
194      my @html_hdr;      my @html_hdr;
195      if ($alt_header && ref($alt_header) eq "ARRAY")      if ($alt_header && ref($alt_header) eq "ARRAY")
# Line 203  Line 206 
206    
207      # Note: 3/10/05 commented this line out pending the discussion of adding cookies into the seed that we are waiting to see about      # Note: 3/10/05 commented this line out pending the discussion of adding cookies into the seed that we are waiting to see about
208      # to add cookies back in replace these two header lines with each other      # to add cookies back in replace these two header lines with each other
209        #my $hdr_thing = $cgi->header(-cookie=>$cookie);
210      #print $cgi->header(-cookie=>$cookie);      my $hdr_thing = $cgi->header();
211      print $cgi->header();      Trace("Printing HTML header: $hdr_thing.") if T(3);
212        print $hdr_thing;
213        Trace("Header printed.") if T(3);
214      #      #
215      #  The SEED header file goes immediately after <BODY>.  Figure out      #  The SEED header file goes immediately after <BODY>.  Figure out
216      #  what parts of the HTML document skeleton are there, and fill in      #  what parts of the HTML document skeleton are there, and fill in
# Line 251  Line 255 
255      my $body_line = -1;      my $body_line = -1;
256      my $last_head_line = -1;  #  If no head tags are found, text goes at top.      my $last_head_line = -1;  #  If no head tags are found, text goes at top.
257      my $done = 0;      my $done = 0;
258        Trace("Processing special cases.") if T(3);
259      for ( $i = 0; $i < @$html; $i++ )      for ( $i = 0; $i < @$html; $i++ )
260      {      {
261          #  Some special cases:          #  Some special cases:
# Line 297  Line 301 
301    
302      if ( 1 )      if ( 1 )
303      {      {
304            Trace("Sanity checks in progress.") if T(3);
305          if ( $html_line >= 0 )          if ( $html_line >= 0 )
306          {          {
307              if ( ( $head_line >= 0 ) && ( $html_line > $head_line ) )              if ( ( $head_line >= 0 ) && ( $html_line > $head_line ) )
308              {              {
309                  print STDERR "<HTML> tag follows <HEAD> tag\n";                  Trace("<HTML> tag follows <HEAD> tag.") if T(1);
310              }              }
311              if ( ( $head_end_line >= 0 ) && ( $html_line > $head_end_line ) )              if ( ( $head_end_line >= 0 ) && ( $html_line > $head_end_line ) )
312              {              {
313                  print STDERR "<HTML> tag follows </HEAD> tag\n";                  Trace("<HTML> tag follows </HEAD> tag.") if T(1);
314              }              }
315          }          }
316          if ( $head_line >= 0 )          if ( $head_line >= 0 )
317          {          {
318              if ( ( $head_end_line >= 0 ) && ( $head_line > $head_end_line ) )              if ( ( $head_end_line >= 0 ) && ( $head_line > $head_end_line ) )
319              {              {
320                  print STDERR "<HEAD> tag follows </HEAD> tag\n";                  Trace("<HEAD> tag follows </HEAD> tag.") if T(1);
321              }              }
322          }          }
323      }      }
324        Trace("Sanity checks complete.") if T(3);
325      #      #
326      #  Okay.  Let's put in the html header file, and missing tags:      #  Okay.  Let's put in the html header file, and missing tags:
327      #      #
# Line 327  Line 332 
332      #  Note if no buttons are added we still (at the moment) add the script,      #  Note if no buttons are added we still (at the moment) add the script,
333      #  but it only adds a little text (495 characters) to the html and noone will notice!      #  but it only adds a little text (495 characters) to the html and noone will notice!
334      #  RAE: This is now deprecated because everything is in an external file, FIG.js, included later      #  RAE: This is now deprecated because everything is in an external file, FIG.js, included later
   
335      if ( $body_line < 0 )      if ( $body_line < 0 )
336      {      {
337          $body_line = $last_head_line + 1;          $body_line = $last_head_line + 1;
338            Trace("Splicing body line at $body_line.") if T(3);
339          splice( @$html, $body_line, 0, "<BODY>\n" );          splice( @$html, $body_line, 0, "<BODY>\n" );
340      }      }
341    
# Line 340  Line 345 
345    
346      if (@html_hdr)      if (@html_hdr)
347      {      {
348            Trace("Splicing SEED page header after $body_line.") if T(3);
349          splice( @$html, $body_line + 1, 0, @html_hdr );          splice( @$html, $body_line + 1, 0, @html_hdr );
350      }      }
351    
# Line 350  Line 356 
356      if ( $head_end_line < 0 )      if ( $head_end_line < 0 )
357      {      {
358          $head_end_line = $body_line;          $head_end_line = $body_line;
359            Trace("Splicing header terminater at $body_line.") if T(3);
360          splice( @$html, $body_line, 0, "</HEAD>\n" );          splice( @$html, $body_line, 0, "</HEAD>\n" );
361      }      }
362    
# Line 359  Line 366 
366      # be moved out, but I want to try it and see what happens.  css has the format:      # be moved out, but I want to try it and see what happens.  css has the format:
367      #      #
368      # <link rel='stylesheet' title='default' href='/css/default.css' type='text/css'>      # <link rel='stylesheet' title='default' href='/css/default.css' type='text/css'>
369        Trace("Formatting CSS.") if T(3);
370      # convert the default key to the right case. and eliminate dups      # convert the default key to the right case. and eliminate dups
371      foreach my $k (keys %$css) {if (lc($k) eq "default") {$css->{'Default'}=$css->{$k}}}      foreach my $k (keys %$css) {if (lc($k) eq "default") {$css->{'Default'}=$css->{$k}}}
372    
# Line 389  Line 396 
396    
397      # the file FIG.js contains most of the java script we use routinely. Every browser will just cache this and so      # the file FIG.js contains most of the java script we use routinely. Every browser will just cache this and so
398      # it will reduce our overhead.      # it will reduce our overhead.
399        Trace("Formatting javascript.") if T(3);
400      # $javasrc must be a ref to an array with urls (absolute or relative) to the javascripts      # $javasrc must be a ref to an array with urls (absolute or relative) to the javascripts
401      push @$javasrc, "Html/css/FIG.js";      push @$javasrc, "Html/css/FIG.js";
402      foreach my $script (@$javasrc) {      foreach my $script (@$javasrc) {
403          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";
404      }      }
405    
406        Trace("Re-splicing the header terminator at $head_end_line.") if T(3);
   
407      splice( @$html, $head_end_line, 1, "$csstext</HEAD>\n" );  # note here I am replacing the </head> line. Could be bad...? But it doesn't increment everything else.      splice( @$html, $head_end_line, 1, "$csstext</HEAD>\n" );  # note here I am replacing the </head> line. Could be bad...? But it doesn't increment everything else.
408    
409      #      #
# Line 415  Line 421 
421          # BASE href needs to be absolute. RDO.          # BASE href needs to be absolute. RDO.
422          #          #
423          #          #
424          $base_url = &FIG::cgi_url;  #        $base_url = &FIG::cgi_url;
425  #       my $base_url = $FIG_Config::cgi_base;  #       my $base_url = $FIG_Config::cgi_base;
426  #       if ( ! $base_url )                      # if cgi_base was not defined  #       if ( ! $base_url )                      # if cgi_base was not defined
427  #       {  #       {
# Line 438  Line 444 
444      if ( $html_line < 0 )      if ( $html_line < 0 )
445      {      {
446          $html_line = 0;          $html_line = 0;
447            Trace("Splicing the HTML tag at $html_line.") if T(3);
448          splice( @$html, $html_line, 0, "<HTML>\n" );          splice( @$html, $html_line, 0, "<HTML>\n" );
449      }      }
450    
# Line 448  Line 455 
455      if ( $head_line < 0 )      if ( $head_line < 0 )
456      {      {
457          $head_line = $html_line + 1;          $head_line = $html_line + 1;
458            Trace("Splicing the HEAD tag at $head_line.") if T(3);
459          splice( @$html, $head_line, 0, "<HEAD>\n" );          splice( @$html, $head_line, 0, "<HEAD>\n" );
460      }      }
461    
462      #      #
463      #  Place FIG search link at bottom of page      #  Place FIG search link at bottom of page
464      #      #
465        Trace("Placing FIG search link.") if T(3);
466      my @tail = -f $html_tail_file ? `cat $html_tail_file` : ();      my @tail = -f $html_tail_file ? `cat $html_tail_file` : ();
467      if (! $no_home)      if (! $no_home)
468      {      {
# Line 465  Line 473 
473      #      #
474      # See if we have a site-specific tail (for disclaimers, etc).      # See if we have a site-specific tail (for disclaimers, etc).
475      #      #
476        Trace("Placing site tail.") if T(3);
477      my $site_tail = "$FIG_Config::fig_disk/config/site_tail.html";      my $site_tail = "$FIG_Config::fig_disk/config/site_tail.html";
478      my $site_fh;      my $site_fh;
479      if (open($site_fh, "<$site_tail"))      if (open($site_fh, "<$site_tail"))
# Line 479  Line 487 
487      #  or before </html>, or at end of page.      #  or before </html>, or at end of page.
488      #      #
489      my @tags = ();      my @tags = ();
490      # Check for a tracing queue.      Trace("Processing closing tags.") if T(3);
     my $traceString = QTrace("HTML");  
     if ($traceString) {  
         push @tags, $traceString;  
     }  
491      for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<\/body\>/i); $i++) {}      for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<\/body\>/i); $i++) {}
492      if ($i >= @$html)        # </body> not found; look for </html>      if ($i >= @$html)        # </body> not found; look for </html>
493      {      {
# Line 498  Line 502 
502    
503      if ( @tail )      if ( @tail )
504      {      {
505            Trace("Splicing tail.") if T(3);
506          splice( @$html, $i, 0, @tail, @tags );          splice( @$html, $i, 0, @tail, @tags );
507      }      }
508      elsif ( @tags )      elsif ( @tags )
509      {      {
510            Trace("Splicing tags.") if T(3);
511          splice( @$html, $i, 0, @tags );          splice( @$html, $i, 0, @tags );
512      }      }
513    
514        Trace("Printing the HTML array.") if T(3);
515      # RAE the chomp will return any new lines at the ends of elements in the array,      # RAE the chomp will return any new lines at the ends of elements in the array,
516      # and then we can join  with a "\n". This is because somethings put newlines in,      # and then we can join  with a "\n". This is because somethings put newlines in,
517      # and others don't. This should make nicer looking html      # and others don't. This should make nicer looking html
# Line 513  Line 520 
520      # print join "\n", @$html;      # print join "\n", @$html;
521      #      #
522      # Apparently the above still breaks things. This is the correct code:      # Apparently the above still breaks things. This is the correct code:
   
523      foreach $_ (@$html)      foreach $_ (@$html)
524      {      {
525          print $_;          my $line = $_;
526            if (T(4)) {
527                my $escapedLine = CGI::escapeHTML($line);
528                Trace("Printing:\n$escapedLine") if T(4);
529            }
530            print $line;
531      }      }
532    
533  }  }
# Line 537  Line 548 
548      my(@tab);      my(@tab);
549    
550      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";
551      my $width = defined $options{width} ? "width=\"$options{width}\"" : undef;      my $width = defined $options{width} ? "width=\"$options{width}\"" : "";
552      my $class = defined $options{class} ? "class=\"$options{class}\"" : undef;      my $class = defined $options{class} ? "class=\"$options{class}\"" : "";
553      push( @tab, "\n<table $border $width $class>\n",      push( @tab, "\n<table $border $width $class>\n",
554                  "\t<caption><b>$title</b></caption>\n",                  "\t<caption><b>$title</b></caption>\n",
555                  "\t<tr>\n\t\t"                  "\t<tr>\n\t\t"
# Line 558  Line 569 
569      push(@tab,"</table>\n");      push(@tab,"</table>\n");
570    
571      # excelfile should be appropriate for a filename (no spaces/special characters)      # excelfile should be appropriate for a filename (no spaces/special characters)
572      if (defined $options{"excelfile"}) {push @tab, $raelib->tab2excel($col_hdrs,$tab,$title,\%options,$options{"excelfile"})}      if (defined $options{"excelfile"}) {
573            if (! defined($raelib)) {
574                require raelib;
575                $raelib = new raelib;
576            }
577            push @tab, $raelib->tab2excel($col_hdrs,$tab,$title,\%options,$options{"excelfile"})}
578    
579      return join("",@tab);      return join("",@tab);
580  }  }
# Line 801  Line 817 
817      return "<a href=$link>$role</a>";      return "<a href=$link>$role</a>";
818  }  }
819    
820  #  =head2 fid_link
821  # Local means to eliminate the fig|org.peg from the  
822  # text of the link.  Get a link to a fid.
823  #  
824    use: my $html=&HTML::fid_link($cgi, $fid, Local, Just_URL, Full_Path);
825    
826    Local is a boolean means to eliminate the fig|org.peg from the text of the link.
827    
828    Just_URL will only return the URL and not the HTML code. The default is to return the full code.
829    
830    Full_Path is a boolean that will get the full path to the URL not just a relative path. This is required in pages where the base href changes (e.g. if an image is imported like on the metabolic pages).
831    
832    =cut
833    
834    
835  sub fid_link {  sub fid_link {
836      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
837      my($cgi,$fid,$local,$just_url) = @_;      my($cgi,$fid,$local,$just_url,$fullpath) = @_;
838        Trace("Creating link for feature $fid.") if T(4);
839        my $err=join(" ", $cgi,$fid,$local,$just_url,$fullpath);
840    
841      my($n);      my($n);
842    
843      my $top = top_link();      my $top = top_link();
844        if ($fullpath) {$top=$FIG_Config::cgi_url}
845    
846      if ($fid =~ /^fig\|\d+\.\d+\.([a-z]+)\.(\d+)/)      if ($fid =~ /^fig\|\d+\.\d+\.([a-zA-Z]+)\.(\d+)/)
847      {      {
848          if ($local)          if ($local)
849          {          {
# Line 834  Line 865 
865          my $new_framework = $cgi->param('new_framework') ? 1 : 0;          my $new_framework = $cgi->param('new_framework') ? 1 : 0;
866          #added to format prophage and path island links to feature.cgi          #added to format prophage and path island links to feature.cgi
867          my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";          my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";
868            my $virt = "&48hr_job=" . $cgi->param("48hr_job");
869            Trace("Sprout mode is \"$sprout\".") if T(4);
870          if ($1 ne "peg" && ! $sprout)          if ($1 ne "peg" && ! $sprout)
871          {          {
872               Trace("Creating feature link for $fid.") if T(4);
873             my $user = $cgi->param('user');             my $user = $cgi->param('user');
874             if (! $user) { $user = "" }             if (! $user) { $user = "" }
875             $link = "$top/feature.cgi?feature=$fid&user=$user$sprout";             $link = "$top/feature.cgi?feature=$fid&user=$user$sprout$virt";
876             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;
877          }          }
878          else          else
879          {          {
880                Trace("Creating protein link for $fid.") if T(4);
881              my $user = $cgi->param('user');              my $user = $cgi->param('user');
882              if (! $user) { $user = "" }              if (! $user) { $user = "" }
883              my $trans = $cgi->param('translate') ? "&translate=1" : "";              my $trans = $cgi->param('translate') ? "&translate=1" : "";
# Line 858  Line 893 
893    
894              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }
895              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";
896              $link = "$top/protein.cgi?prot=$fid&user=$user$trans$sprout\&new_framework=$new_framework";              $link = "$top/protein.cgi?prot=$fid&user=$user$trans$sprout$virt\&new_framework=$new_framework";
897              $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;              $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;
898          }          }
899          if ($just_url)          if ($just_url)
# Line 880  Line 915 
915      return $family;      return $family;
916  }  }
917    
918    =head2 evidence_codes_explain
919    
920    Given an evidence code, returns a string that explains this eveidence code.
921    
922    =cut
923    
924    sub evidence_codes_explain {
925     my($ec)=@_;
926     return unless ($ec);
927    
928     $ec=uc($ec);
929     return "IDA: Inferred from Direct Assay" if ($ec =~ /IDA/);
930     return "IGI: Inferred from Genetic Interaction" if ($ec =~ /IGI/);
931     return "TAS: Traceable Author Statement" if ($ec =~ /TAS/);
932     return "ISU: in subsystem unique" if ($ec =~ /ISU/);
933     return "$ec: in subsystem duplicates" if ($ec =~ /IDU/);
934     return "$ec: in cluster with" if ($ec =~ /ICW/);
935     return "FF: in FIGfam" if ($ec =~ /FF/);
936     return "CWN: clustered with nonhypothetical" if ($ec =~ /CWN/);
937     return "CWH: clustered, but only with hypotheticals" if ($ec =~ /CWH/);
938     return "DLIT: literature references to this gene exist" if ($ec =~ /DLIT/);
939     return "ILIT: no references to this gene exist, but they do to other genes with the same functional role" if ($ec =~ /ILIT/);
940     return "$ec: unknown!";
941    }
942    
943  sub get_html {  sub get_html {
944      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
# Line 912  Line 971 
971          {          {
972              $url .= "?" . join("&",@args);              $url .= "?" . join("&",@args);
973          }          }
974          $request = new HTTP::Request('GET', $url);          my $request = new HTTP::Request('GET', $url);
975          my $response = $ua->request($request);          my $response = $ua->request($request);
976    
977          if ($response->is_success)          if ($response->is_success)
# Line 930  Line 989 
989    
990  #   Now splice in a line of the form <base href=URL> to cause all relative links to work  #   Now splice in a line of the form <base href=URL> to cause all relative links to work
991  #   properly.  Remove the header.  #   properly.  Remove the header.
992        my $i;
993      for ($i=0; ($i < @output) && ($output[$i] !~ /^\s*\</); $i++) {}      for ($i=0; ($i < @output) && ($output[$i] !~ /^\s*\</); $i++) {}
994      if ($i < @output)      if ($i < @output) {
     {  
   
995          splice(@output,0,$i);          splice(@output,0,$i);
996      }      }
997    
# Line 950  Line 1007 
1007  sub trim_output {  sub trim_output {
1008      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1009      my($out) = @_;      my($out) = @_;
1010      my $i;      my ($i, $j);
1011    
1012      for ($i=0; ($i < @$out) && ($out->[$i] !~ /^\</); $i++) {}      for ($i=0; ($i < @$out) && ($out->[$i] !~ /^\</); $i++) {}
1013      splice(@$out,0,$i);      splice(@$out,0,$i);
# Line 979  Line 1036 
1036      for ($j=$i-1; ($j > 0) && ($out->[$j] !~ /FIG search/); $j--) {}      for ($j=$i-1; ($j > 0) && ($out->[$j] !~ /FIG search/); $j--) {}
1037      if ($j > 0)      if ($j > 0)
1038      {      {
1039            #
1040            # Hm. We would have tried using the options here:
1041            # my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";
1042            # but they're not passed in. So use the default html.tail.
1043            #
1044            my $html_tail_file = "./Html/html.tail";
1045          my @tmp = `cat $html_tail_file`;          my @tmp = `cat $html_tail_file`;
1046          my $n = @tmp;          my $n = @tmp;
1047          splice(@$out,$j-$n,$n+1);          splice(@$out,$j-$n,$n+1);
# Line 1011  Line 1074 
1074          $after = $3;          $after = $3;
1075          return &set_prot_links($cgi,$before) . &HTML::gi_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::gi_link($cgi,$match) . &set_prot_links($cgi,$after);
1076      }      }
1077        elsif ($x =~ /^(.*)(img\|\d+)(.*)/s)
1078        {
1079            $before = $1;
1080            $match = $2;
1081            $after = $3;
1082            return &set_prot_links($cgi,$before) . &HTML::img_link($cgi,$match) . &set_prot_links($cgi,$after);
1083        }
1084      elsif ($x =~ /^(.*)(tigr\|\w+)(.*)/s)      elsif ($x =~ /^(.*)(tigr\|\w+)(.*)/s)
1085      {      {
1086          $before = $1;          $before = $1;
# Line 1018  Line 1088 
1088          $after = $3;          $after = $3;
1089          return &set_prot_links($cgi,$before) . &HTML::tigr_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::tigr_link($cgi,$match) . &set_prot_links($cgi,$after);
1090      }      }
1091        elsif ($x =~ /^(.*)(tigrcmr\|\w+)(.*)/s)
1092        {
1093            $before = $1;
1094            $match = $2;
1095            $after = $3;
1096            return &set_prot_links($cgi,$before) . &HTML::tigr_link($cgi,$match) . &set_prot_links($cgi,$after);
1097        }
1098      elsif ($x =~ /^(.*)\b(eric\|\S+)\b(.*)/s)      elsif ($x =~ /^(.*)\b(eric\|\S+)\b(.*)/s)
1099      {      {
1100          $before = $1;          $before = $1;
# Line 1229  Line 1306 
1306          my $id=$1.$2;          my $id=$1.$2;
1307          return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\" target=_blank>$tigr</a> (Pathema)";          return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\" target=_blank>$tigr</a> (Pathema)";
1308      }      }
1309      elsif ($tigr =~ /^tigr\|(\S+)$/)      elsif ($tigr =~ /^tigr(cmr)?\|(\S+)$/)
1310      {      {
1311          return "<a href=\"http://www.tigr.org/tigr-scripts/CMR2/GenePage.spl?locus=$1\" target=_blank>$tigr</a>";          return "<a href=\"http://www.tigr.org/tigr-scripts/CMR2/GenePage.spl?locus=$2\" target=_blank>$tigr</a>";
1312      }      }
1313      return $tigr;      return $tigr;
1314  }  }
# Line 1339  Line 1416 
1416      return $kegg;      return $kegg;
1417  }  }
1418    
1419    sub img_link {
1420        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1421        my($cgi,$img) = @_;
1422    
1423        if ($img =~ /^img\|(\S+)$/)
1424        {
1425            return "<a href='http://img.jgi.doe.gov/cgi-bin/pub/main.cgi?page=geneDetail&gene_oid=$1' target=_blank>$img</a>";
1426        }
1427        return $img;
1428    }
1429    
1430  sub ensembl_link {  sub ensembl_link {
1431      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1432      my($cgi,$ensembl) = @_;      my($cgi,$ensembl) = @_;
# Line 1391  Line 1479 
1479      {      {
1480          return "<a href='http://www.gene.ucl.ac.uk/cgi-bin/nomenclature/searchgenes.pl?field=symbol&anchor=equals&match=$1&symbol_search=Search&number=50&format=html&sortby=symbol' target=_blank>$hgnc</a>";          return "<a href='http://www.gene.ucl.ac.uk/cgi-bin/nomenclature/searchgenes.pl?field=symbol&anchor=equals&match=$1&symbol_search=Search&number=50&format=html&sortby=symbol' target=_blank>$hgnc</a>";
1481      }      }
1482      return $mim;  
1483        return $hgnc;
1484  }  }
1485    
1486  sub unigene_link {  sub unigene_link {
# Line 1494  Line 1583 
1583      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1584      my($cgi,$map,$org) = @_;      my($cgi,$map,$org) = @_;
1585    
1586      $user = $cgi->param('user');      my $user = $cgi->param('user');
1587      $user = $user ? $user : "";      $user = $user ? $user : "";
1588      $org = $org ? $org : "";      $org = $org ? $org : "";
1589    
# Line 1512  Line 1601 
1601    # -name => field and the checkbox name    # -name => field and the checkbox name
1602    my ($form, $button)=@_;    my ($form, $button)=@_;
1603    
1604    $java_script="<input type=\"button\" name=\"CheckAll\" value=\"Check All\"\nonClick=\"checkAll(document.$form.$button)\">\n";    my $java_script="<input type=\"button\" name=\"CheckAll\" value=\"Check All\"\nonClick=\"checkAll(document.$form.$button)\">\n";
1605    $java_script.="<input type=\"button\" name=\"CheckFirst\" value=\"Check First Half\"\nonClick=\"checkFirst(document.$form.$button)\">\n";    $java_script.="<input type=\"button\" name=\"CheckFirst\" value=\"Check First Half\"\nonClick=\"checkFirst(document.$form.$button)\">\n";
1606    $java_script.="<input type=\"button\" name=\"CheckSecond\" value=\"Check Second Half\"\nonClick=\"checkSecond(document.$form.$button)\">\n";    $java_script.="<input type=\"button\" name=\"CheckSecond\" value=\"Check Second Half\"\nonClick=\"checkSecond(document.$form.$button)\">\n";
1607    $java_script.="<input type=\"button\" name=\"UnCheckAll\" value=\"Uncheck All\"\nonClick=\"uncheckAll(document.$form.$button)\">\n";    $java_script.="<input type=\"button\" name=\"UnCheckAll\" value=\"Uncheck All\"\nonClick=\"uncheckAll(document.$form.$button)\">\n";
# Line 1520  Line 1609 
1609    return $java_script;    return $java_script;
1610  }  }
1611    
1612    =head3 sub_link
1613    
1614    C<< my $htmlText = HTML::sub_link($cgi, $sub, gid); >>
1615    
1616    Create a subsystem link. The link will be to the display page if there is no
1617    user or we are in SPROUT mode; otherwise it will be to the edit page.
1618    
1619    =over 4
1620    
1621    =item cgi
1622    
1623    CGI query object for the current web session. The parameters of special interest
1624    are C<SPROUT> and C<user>. If the user is non-blank and SPROUT mode is 0, then
1625    the subsystem's edit page will be shown rather than its display page.
1626    
1627    =item sub
1628    
1629    Name of the desired subsystem. It will be cleaned of underscores before the
1630    hyperlink is applied.
1631    
1632    =item gid
1633    
1634    Genome ID to be specified as the focus.
1635    
1636    =back
1637    
1638    =cut
1639    
1640  sub sub_link {  sub sub_link {
1641        # Allow call as an instance in addition to the authorized method.
1642      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1643      my($cgi,$sub) = @_;      # Get the parameters.
1644      my($sub_link);      my ($cgi, $sub, $gid) = @_;
1645        # Declare the return variable.
1646        my $retVal;
1647        # Clean the subsystem name for display purposes. This is a very
1648        # different thing from URL-escaping.
1649        my $cleaned = CGI::escapeHTML($sub);
1650        $cleaned =~ s/_/ /g;
1651        # URL-escape the subsystem name for use in the link.
1652        my $linkable = uri_escape($sub);
1653        # Determine the mode. Note we use the little OR trick to insure that
1654        # we have the correct value for plugging into the output link.
1655        my $user = $cgi->param('user') || "";
1656        my $sproutMode = $cgi->param('SPROUT') || 0;
1657        if ($user && ! $sproutMode) {
1658            # A SEED user is calling, so we go to the edit page.
1659            $retVal = "<a href=\"subsys.cgi?ssa_name=$linkable&request=show_ssa&user=$user\">$cleaned</a>";
1660        } else {
1661            # A visitor or SPROUT user is calling, so we go to the display page.
1662            $retVal = "<a href=\"display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;focus=$gid;SPROUT=$sproutMode\">$cleaned</a>";
1663        }
1664        # Return the result.
1665        return $retVal;
1666    }
1667    
1668      my $user = $cgi->param('user');  sub reaction_map_link {
1669      my $esc_sub = uri_escape( $sub );      my($mapID, @reaction_list) = @_;
1670      $sub =~ s/\_/ /g;      if($mapID =~ /\d+/)
1671      if ($user)      {
1672            my $reactions = join "+", @reaction_list;
1673            if ($reactions ne "")
1674      {      {
1675          $sub_link = "<a href=./subsys.cgi?ssa_name=$esc_sub&request=show_ssa&user=$user>$sub</a>";              $reactions = "+".$reactions;
1676            }
1677    
1678            return "<a href=http://www.genome.jp/dbget-bin/show_pathway?rn$mapID$reactions>$mapID</a>";
1679      }      }
1680      else      else
1681      {      {
1682          $sub_link = "<a href=\"display_subsys.cgi?ssa_name=$esc_sub&request=show_ssa&sort=by_phylo\">$sub</a>";          return $mapID;
1683      }      }
     return $sub_link;  
1684  }  }
1685    
1686    sub compound_link {
1687        my($compound) = @_;
1688        if($compound =~ /^C\d+/)
1689        {
1690            return "<a href=\"javascript:void(0)\"onclick=\"window.open('http://www.genome.jp/dbget-bin/www_bget?compound+$compound','$&','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\">$compound</a>";
1691        }
1692        else
1693        {
1694            return $compound;
1695        }
1696    }
1697    
1698    
1699  sub reaction_link {  sub reaction_link {
1700      my($reaction) = @_;      my($reaction) = @_;
1701      if ($reaction =~ /^(\*)?(R\d+)/)      if ($reaction =~ /^(\*)?(R\d+)/)
1702      {      {
1703          return "<a href=\"http://www.genome.ad.jp/dbget-bin/www_bget?rn+$2\" target=reaction$$>$reaction</a>";          # return "<a href=\"http://www.genome.ad.jp/dbget-bin/www_bget?rn+$2\" target=reaction$$>$reaction</a>";
1704            return "<a href=\"javascript:void(0)\"onclick=\"window.open('http://www.genome.ad.jp/dbget-bin/www_bget?rn+$reaction','$&','height=640,width=800,scrollbars=yes,toolbar=yes,status=yes,resizable=yes')\">$reaction</a>";
1705      }      }
1706      return $reaction;      return $reaction;
1707  }  }
# Line 1555  Line 1713 
1713    
1714      my @vals = ();      my @vals = ();
1715      my $set = 1;      my $set = 1;
1716      foreach $peg_set (@$peg_sets)      foreach my $peg_set (@$peg_sets)
1717      {      {
1718          for ($i=0; ($i < @$peg_set); $i++)          for ($i=0; ($i < @$peg_set); $i++)
1719          {          {
1720              $peg = $peg_set->[$i];              my $peg = $peg_set->[$i];
1721              push(@vals,'show=' . join("@",($set,$i+1,$peg,&FIG::abbrev($fig->org_of($peg)),"")));              push(@vals,'show=' . join("@",($set,$i+1,$peg,&FIG::abbrev($fig->org_of($peg)),"")));
1722          }          }
1723          $set++;          $set++;
# Line 1670  Line 1828 
1828    
1829    
1830   my @files=("SEED.rss");   my @files=("SEED.rss");
1831   if ($args->{"type"}) {push @files, "SEED.$type.rss"}   if ($args->{"type"}) {
1832        my $type = $args->{type};
1833        push @files, "SEED.$type.rss"
1834    }
1835    
1836   foreach my $file ("SEED.rss", @$files)   foreach my $file ("SEED.rss", @$files)
1837   {   {

Legend:
Removed from v.1.99  
changed lines
  Added in v.1.118

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3