[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.83, Wed Jan 25 02:20:42 2006 UTC revision 1.112, Thu Mar 1 12:49:13 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!
34    my $raelib;
35    
36    
37  my $top_link_cache;  my $top_link_cache;
# Line 53  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 78  Line 83 
83      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
84      my($additional_insert, $user, %options ) = @_;      my($additional_insert, $user, %options ) = @_;
85    
86        local $/ = "\n";
87    
88      my $header_name = $options{header_name} ? $options{header_name} : "html.hdr";      my $header_name = $options{header_name} ? $options{header_name} : "html.hdr";
89      my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";      my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";
90    
# Line 156  Line 163 
163  sub show_page {  sub show_page {
164      #warn "SHOWPAGE: cgi=", Dumper(@_);      #warn "SHOWPAGE: cgi=", Dumper(@_);
165      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
166      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie) = @_;      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 171  Line 178 
178      #               the sheet named "Sans Serif" is considered to the the first alternate, and if this is not set it points at $FIG_Config::HTML/css/sanserif.css      #               the sheet named "Sans Serif" is considered to the the first alternate, and if this is not set it points at $FIG_Config::HTML/css/sanserif.css
179      #     $javasrc is a reference to an array of URLs to javascripts to be included (e.g. "FIG/Html/css/styleswitcher.js")      #     $javasrc is a reference to an array of URLs to javascripts to be included (e.g. "FIG/Html/css/styleswitcher.js")
180      #     $cookie is the name and value of the cookie to set. Note that you should probably use raelib->cookie to get/set your cookies      #     $cookie is the name and value of the cookie to set. Note that you should probably use raelib->cookie to get/set your cookies
181        #     $options is a reference to a hash of options that you can pass around the pages
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 189  Line 198 
198      }      }
199      else      else
200      {      {
201          @html_hdr = compute_html_header(undef,$user);          @html_hdr = compute_html_header(undef,$user,%$options);
202      }      }
203    
204      # RAE: I am offloading the handling of cookies to CGI.pm since I don't know how they are set up.      # RAE: I am offloading the handling of cookies to CGI.pm since I don't know how they are set up.
# Line 197  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 245  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 291  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 321  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 334  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 344  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 353  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 383  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 409  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 432  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 442  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 459  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 473  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 492  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 507  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  }  }
534    
535    
536    =head1 make_table
537    
538    The main method to convert an array into a table.
539    
540    The col_hdrs are set to the <th> headers, the $tab is an array of arrays. The first is the rows, and the second is the columns. The title is the title of the table.
541    
542    The options define the settings for the table such as border, width, and class for css formatting. If the option "excelfile" is set to a filename that will be created in FIG_Config::temp, and the link included that allows the user to download the file as an excel file.
543    
544    =cut
545    
546  sub make_table {  sub make_table {
547      my($col_hdrs,$tab,$title, %options ) = @_;      my($col_hdrs,$tab,$title, %options ) = @_;
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 539  Line 567 
567              );              );
568      }      }
569      push(@tab,"</table>\n");      push(@tab,"</table>\n");
570    
571        # excelfile should be appropriate for a filename (no spaces/special characters)
572        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  }  }
581    
# Line 780  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-z]+)\.(\d+)/)
847      {      {
# Line 810  Line 862 
862          }          }
863    
864          my $link;          my $link;
865            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          if ($1 ne "peg")          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)
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             my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";             $link = "$top/feature.cgi?feature=$fid&user=$user$sprout$virt";
            $link = "$top/feature.cgi?feature=$fid&user=$user$trans$sprout";  
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 836  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";              $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 845  Line 902 
902          }          }
903          else          else
904          {          {
905              return "<a href=$link>$n</a>";              return "<a href='$link'>$n</a>";
906          }          }
907      }      }
908      return $fid;      return $fid;
# Line 858  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 877  Line 958 
958          my $response = $ua->request($request);          my $response = $ua->request($request);
959          $out = $response->content;          $out = $response->content;
960      }      }
961      else  
962        if ($type =~/get/i)
963      {      {
964          @args = ();          @args = ();
965          foreach $x (@$kv_pairs)          foreach $x (@$kv_pairs)
# Line 889  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 907  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 927  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 956  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 988  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 =~ /^(.*)(tigr\|[0-9a-zA-Z]+)(.*)/s)      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)
1085      {      {
1086          $before = $1;          $before = $1;
1087          $match = $2;          $match = $2;
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 =~ /^(.*)\beric\|\w+\b(.*)/s)      elsif ($x =~ /^(.*)\b(eric\|\S+)\b(.*)/s)
1092      {      {
1093          $before = $1;          $before = $1;
1094          $match = $2;          $match = $2;
# Line 1003  Line 1096 
1096          return &set_prot_links($cgi,$before) . &HTML::eric_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::eric_link($cgi,$match) . &set_prot_links($cgi,$after);
1097      }      }
1098    
1099      elsif ($x =~ /^(.*)\bbhb\|.*?\b(.*)/s)      elsif ($x =~ /^(.*)\b(bhb\|.*?)\b(.*)/s)
1100      {      {
1101          $before = $1;          $before = $1;
1102          $match = $2;          $match = $2;
# Line 1011  Line 1104 
1104          return &set_prot_links($cgi,$before) . &HTML::bhb_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::bhb_link($cgi,$match) . &set_prot_links($cgi,$after);
1105      }      }
1106    
1107      elsif ($x =~ /^(.*)\bapidb\|.*?\..*\b(.*)/s)      elsif ($x =~ /^(.*)\b(apidb\|[0-9\.a-z_]+)\b(.*)/s)
1108      {      {
1109          $before = $1;          $before = $1;
1110          $match = $2;          $match = $2;
# Line 1019  Line 1112 
1112          return &set_prot_links($cgi,$before) . &HTML::apidb_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::apidb_link($cgi,$match) . &set_prot_links($cgi,$after);
1113      }      }
1114    
1115      elsif ($x =~ /^(.*)\bpatric\|.*?\b(.*)/s)      elsif ($x =~ /^(.*)\b(patric\|.*?)\b(.*)/s)
1116      {      {
1117          $before = $1;          $before = $1;
1118          $match = $2;          $match = $2;
# Line 1027  Line 1120 
1120          return &set_prot_links($cgi,$before) . &HTML::patric_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::patric_link($cgi,$match) . &set_prot_links($cgi,$after);
1121      }      }
1122    
1123      elsif ($x =~ /^(.*)\bvbrc\|.*?\b(.*)/s)      elsif ($x =~ /^(.*)\b(vbrc\|.*?)\b(.*)/s)
1124      {      {
1125          $before = $1;          $before = $1;
1126          $match = $2;          $match = $2;
# Line 1035  Line 1128 
1128          return &set_prot_links($cgi,$before) . &HTML::vbrc_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::vbrc_link($cgi,$match) . &set_prot_links($cgi,$after);
1129      }      }
1130    
1131      elsif ($x =~ /^(.*)\bvectorbase\|.*?\b(.*)/s)      elsif ($x =~ /^(.*)\b(vectorbase\|.*?)\b(.*)/s)
1132      {      {
1133          $before = $1;          $before = $1;
1134          $match = $2;          $match = $2;
# Line 1091  Line 1184 
1184          $after = $3;          $after = $3;
1185          return &set_prot_links($cgi,$before) . &HTML::mim_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::mim_link($cgi,$match) . &set_prot_links($cgi,$after);
1186      }      }
1187      elsif ($x =~ /^(.*)(UniGene:[a-zA-Z_0-9\.]+)(.*)/s)      elsif ($x =~ /^(.*)(HGNC:[a-zA-Z_0-9\.]+)(.*)/s)
1188      {      {
1189          $before = $1;          $before = $1;
1190          $match = $2;          $match = $2;
1191          $after = $3;          $after = $3;
1192          return &set_prot_links($cgi,$before) . &HTML::unigene_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::hgnc_link($cgi,$match) . &set_prot_links($cgi,$after);
1193      }      }
1194      elsif ($x =~ /^(.*)(IPI:[a-zA-Z_0-9\.]+)(.*)/s)      elsif ($x =~ /^(.*)(UniGene:[a-zA-Z_0-9\.]+)(.*)/s)
1195      {      {
1196          $before = $1;          $before = $1;
1197          $match = $2;          $match = $2;
1198          $after = $3;          $after = $3;
1199          return &set_prot_links($cgi,$before) . &HTML::ipi_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::unigene_link($cgi,$match) . &set_prot_links($cgi,$after);
1200      }      }
1201    # IPI stopped working. turn off for now.
1202    #    elsif ($x =~ /^(.*)(IPI:[a-zA-Z_0-9\.]+)(.*)/s)
1203    #    {
1204    #        $before = $1;
1205    #        $match = $2;
1206    #        $after = $3;
1207    #        return &set_prot_links($cgi,$before) . &HTML::ipi_link($cgi,$match) . &set_prot_links($cgi,$after);
1208    #    }
1209      elsif ($x =~ /^(.*)(WP:[a-zA-Z_0-9\.]+)(.*)/s)      elsif ($x =~ /^(.*)(WP:[a-zA-Z_0-9\.]+)(.*)/s)
1210      {      {
1211          #wormbase          #wormbase
# Line 1141  Line 1242 
1242          $after = $3;          $after = $3;
1243          return &set_prot_links($cgi,$before) . &HTML::sgd_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::sgd_link($cgi,$match) . &set_prot_links($cgi,$after);
1244      }      }
1245        elsif ($x =~ /^(.*)(tr\|[a-zA-Z0-9]+)(.*)/s)
1246        {
1247    
1248          $before = $1;
1249          $match = $2;
1250          $after = $3;
1251    
1252          return &set_prot_links($cgi,$before) .  &HTML::trembl_link($cgi,$match) . &set_prot_links($cgi,$after);
1253        }
1254      return $x;      return $x;
1255  }  }
1256    
1257    sub trembl_link {
1258        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1259        my($cgi,$id) = @_;
1260    
1261        if ($id =~ /^tr\|(.*)/) {
1262          return "<a href='http://ca.expasy.org/uniprot/$1' target=_blank>$id</a>";
1263        } else {
1264          return "invalid call to trembl link";
1265        }
1266    }
1267    
1268  sub refseq_link {  sub refseq_link {
1269      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1270      my($cgi,$id) = @_;      my($cgi,$id) = @_;
1271    
1272      if ($id =~ /^[NXYZA]P_/)      if ($id =~ /^[NXYZA]P_/)
1273      {      {
1274          return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=protein&cmd=search&term=$id>$id</a>";          return "<a href='http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=protein&cmd=search&term=$id' target=_blank>$id</a>";
1275      }      }
1276      elsif ($id =~ /^[NXYZA]M_/)      elsif ($id =~ /^[NXYZA]M_/)
1277      {      {
1278          return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=nuccore&cmd=search&term=$id>$id</a>";          return "<a href='http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=nuccore&cmd=search&term=$id' target=_blank>$id</a>";
1279      }      }
1280  }  }
1281    
# Line 1164  Line 1285 
1285    
1286      if ($gi =~ /^gi\|(\d+)$/)      if ($gi =~ /^gi\|(\d+)$/)
1287      {      {
1288          return "<a href=http://www.ncbi.nlm.nih.gov:80/entrez/query.fcgi?cmd=Retrieve&db=Protein&list_uids=$1&dopt=GenPept>$gi</a>";          return "<a href='http://www.ncbi.nlm.nih.gov:80/entrez/query.fcgi?cmd=Retrieve&db=Protein&list_uids=$1&dopt=GenPept' target=_blank>$gi</a>";
1289      }      }
1290      return $gi;      return $gi;
1291  }  }
# Line 1176  Line 1297 
1297      if ($tigr =~ /^tigr\|(NT|ntbp|ntbpA|BA|BMAA|BXB|GBA)(\w+)$/)      if ($tigr =~ /^tigr\|(NT|ntbp|ntbpA|BA|BMAA|BXB|GBA)(\w+)$/)
1298      {      {
1299          my $id=$1.$2;          my $id=$1.$2;
1300          return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\">$tigr</a> (Pathema)";          return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\" target=_blank>$tigr</a> (Pathema)";
1301      }      }
1302      elsif ($tigr =~ /^tigr\|(\S+)$/)      elsif ($tigr =~ /^tigr\|(\S+)$/)
1303      {      {
1304          return "<a href=\"http://www.tigr.org/tigr-scripts/CMR2/GenePage.spl?locus=$1\">$tigr</a>";          return "<a href=\"http://www.tigr.org/tigr-scripts/CMR2/GenePage.spl?locus=$1\" target=_blank>$tigr</a>";
1305      }      }
1306      return $tigr;      return $tigr;
1307  }  }
# Line 1191  Line 1312 
1312    
1313      if ($eric =~ /^eric\|(\S+)/)      if ($eric =~ /^eric\|(\S+)/)
1314      {      {
1315          return "<a href=\"https://asap.ahabs.wisc.edu/asap/feature_info.php?FeatureID=$1\">$eric</a>";          return "<a href=\"https://asap.ahabs.wisc.edu/asap/feature_info.php?FeatureID=$1\" target=_blank>$eric</a>";
1316      }      }
1317      return $eric;      return $eric;
1318  }  }
# Line 1200  Line 1321 
1321      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1322      my($cgi,$bhb) = @_;      my($cgi,$bhb) = @_;
1323    
1324      return "<a href=\"http://www.biohealthbase.org\">$bhb</a>";      return "<a href=\"http://www.biohealthbase.org\" target=_blank>$bhb</a>";
1325  }  }
1326    
1327  sub apidb_link {  sub apidb_link {
# Line 1209  Line 1330 
1330    
1331      if ($api =~ /apidb\|(.*?)\.(.*)$/)      if ($api =~ /apidb\|(.*?)\.(.*)$/)
1332      {      {
1333          return "<a href=\"http://www.apidb.org/cgi-bin/redirect.cgi?taxon_id=$1&source_id=$2\">$api</a>";          return "<a href=\"http://www.apidb.org/cgi-bin/redirect.cgi?taxon_id=$1&source_id=$2\" target=_blank>$api</a>";
1334      }      }
1335      return $api;      return $api;
1336  }  }
# Line 1220  Line 1341 
1341    
1342      if ($patric =~ /patric\|(.*)/)      if ($patric =~ /patric\|(.*)/)
1343      {      {
1344          return "<a href=\"https://patric.vbi.vt.edu/software/curationTool/gep/pgiCuration.php?locus_name=$1\">$patric</a>";          return "<a href=\"https://patric.vbi.vt.edu/software/curationTool/gep/pgiCuration.php?locus_name=$1\" target=_blank>$patric</a>";
1345      }      }
1346      return $patric;      return $patric;
1347  }  }
# Line 1231  Line 1352 
1352    
1353      if ($vbrc =~ /vbrc\|(.*)/)      if ($vbrc =~ /vbrc\|(.*)/)
1354      {      {
1355          return "<a href=\"http://www.biovirus.org/gene_detail.asp?name=$1\">$vbrc</a>";          return "<a href=\"http://www.biovirus.org/gene_detail.asp?name=$1\" target=_blank>$vbrc</a>";
1356      }      }
1357      return $vbrc;      return $vbrc;
1358  }  }
# Line 1239  Line 1360 
1360  sub vectorbase_link {  sub vectorbase_link {
1361      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1362      my($cgi,$vec) = @_;      my($cgi,$vec) = @_;
1363      return "<a href=\"http://www.vectorbase.org\">$vec</a>";      return "<a href=\"http://www.vectorbase.org\" target=_blank>$vec</a>";
1364  }  }
1365    
1366    
# Line 1249  Line 1370 
1370    
1371      if ($uni =~ /^uni\|(\S+)$/)      if ($uni =~ /^uni\|(\S+)$/)
1372      {      {
1373          return "<a href=http://www.pir.uniprot.org/cgi-bin/upEntry?id=$1>$uni</a>";          #return "<a href=http://www.pir.uniprot.org/cgi-bin/upEntry?id=$1>$uni</a>";
1374            return "<a href='http://www.ebi.uniprot.org/uniprot-srv/uniProtView.do?proteinAc=$1' target=_blank>$uni</a>";
1375      }      }
1376      return $uni;      return $uni;
1377  }  }
# Line 1260  Line 1382 
1382    
1383      if ($sp =~ /^sp\|(\S+)$/)      if ($sp =~ /^sp\|(\S+)$/)
1384      {      {
1385          return "<a href=http://us.expasy.org/cgi-bin/get-sprot-entry?$1>$sp</a>";          return "<a href='http://us.expasy.org/cgi-bin/get-sprot-entry?$1' target=_blank>$sp</a>";
1386      }      }
1387      return $sp;      return $sp;
1388  }  }
# Line 1271  Line 1393 
1393    
1394      if ($pir =~ /^pirnr\|(NF\d+)$/)      if ($pir =~ /^pirnr\|(NF\d+)$/)
1395      {      {
1396          return "<a href=http://pir.georgetown.edu/cgi-bin/nfEntry.pl?id=$1>$pir</a>";          return "<a href='http://pir.georgetown.edu/cgi-bin/nfEntry.pl?id=$1' target=_blank>$pir</a>";
1397      }      }
1398      return $pir;      return $pir;
1399  }  }
# Line 1282  Line 1404 
1404    
1405      if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)      if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)
1406      {      {
1407          return "<a href=http://www.genome.ad.jp/dbget-bin/www_bget?$1+$2>$kegg</a>";          return "<a href='http://www.genome.ad.jp/dbget-bin/www_bget?$1+$2' target=_blank>$kegg</a>";
1408      }      }
1409      return $kegg;      return $kegg;
1410  }  }
1411    
1412    sub img_link {
1413        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1414        my($cgi,$img) = @_;
1415    
1416        if ($img =~ /^img\|(\S+)$/)
1417        {
1418            return "<a href='http://img.jgi.doe.gov/cgi-bin/pub/main.cgi?page=geneDetail&gene_oid=$1' target=_blank>$img</a>";
1419        }
1420        return $img;
1421    }
1422    
1423  sub ensembl_link {  sub ensembl_link {
1424      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1425      my($cgi,$ensembl) = @_;      my($cgi,$ensembl) = @_;
# Line 1295  Line 1428 
1428      {      {
1429          my $what=$1;          my $what=$1;
1430          my $key=$2;          my $key=$2;
1431          my $idx="all";          my $idx="All";
1432          if ($what eq "EnsemblGene") { $idx = "Gene" }          if ($what eq "EnsemblGene") { $idx = "Gene" }
1433          if ($what eq "EnsemblTranscript") { $idx = "all" }          if ($what eq "EnsemblTranscript") { $idx = "All" }
1434          if ($what eq "EnsemblProtein") { $idx = "all" }          if ($what eq "EnsemblProtein") { $idx = "All" }
1435    
1436          #I really want to get right to the transcript and peptide pages, but          #I really want to get right to the transcript and peptide pages, but
1437          #can't see how to do that without knowing the org name too, which          #can't see how to do that without knowing the org name too, which
1438          #I don't know at this point. (ensembl org name, not real org name)          #I don't know at this point. (ensembl org name, not real org name)
1439    
1440          return "<a href=http://www.ensembl.org/Homo_sapiens/textview?species=all&idx=$idx&q=$key>$ensembl</a>";          return "<a href='http://www.ensembl.org/Homo_sapiens/searchview?species=all&idx=$idx&q=$key' target=_blank>$ensembl</a>";
1441      }      }
1442      return $ensembl;      return $ensembl;
1443  }  }
# Line 1315  Line 1448 
1448    
1449      if ($entrezgene =~ /^EntrezGene:(\S+)$/)      if ($entrezgene =~ /^EntrezGene:(\S+)$/)
1450      {      {
1451          return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=gene&cmd=Retrieve&dopt=full_report&list_uids=$1>$entrezgene</a>";          return "<a href='http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=gene&cmd=Retrieve&dopt=full_report&list_uids=$1' target=_blank>$entrezgene</a>";
1452      }      }
1453      return $entrezgene;      return $entrezgene;
1454  }  }
# Line 1326  Line 1459 
1459    
1460      if ($mim =~ /^MIM:(\S+)$/)      if ($mim =~ /^MIM:(\S+)$/)
1461      {      {
1462          return "<a href=http://www3.ncbi.nlm.nih.gov/entrez/dispomim.cgi?id=$1>$mim</a>";          return "<a href='http://www3.ncbi.nlm.nih.gov/entrez/dispomim.cgi?id=$1' target=_blank>$mim</a>";
1463      }      }
1464      return $mim;      return $mim;
1465  }  }
1466    
1467    sub hgnc_link {
1468        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1469        my($cgi,$hgnc) = @_;
1470    
1471        if ($hgnc =~ /^HGNC:(\S+)$/)
1472        {
1473            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>";
1474        }
1475    
1476        return $hgnc;
1477    }
1478    
1479  sub unigene_link {  sub unigene_link {
1480      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1481      my($cgi,$unigene) = @_;      my($cgi,$unigene) = @_;
1482    
1483      if ($unigene =~ /^UniGene:(\S+)$/)      if ($unigene =~ /^UniGene:(\S+)$/)
1484      {      {
1485          return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=unigene&cmd=search&term=$1>$unigene</a>";          return "<a href='http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=unigene&cmd=search&term=$1' target=_blank>$unigene</a>";
1486      }      }
1487      return $unigene;      return $unigene;
1488  }  }
# Line 1348  Line 1493 
1493    
1494      if ($ipi =~ /^IPI:(\S+)$/)      if ($ipi =~ /^IPI:(\S+)$/)
1495      {      {
1496          return "<a href=http://srs.ebi.ac.uk/srsbin/cgi-bin/wgetz?-id+AEoS1R8Jnn+-e+[IPI:\'$1\']+-qnum+1+-enum+1>$ipi</a>";          return "<a href='http://srs.ebi.ac.uk/srsbin/cgi-bin/wgetz?-id+AEoS1R8Jnn+-e+[IPI:\'$1\']+-qnum+1+-enum+1' target=_blank>$ipi</a>";
1497      }      }
1498      return $ipi;      return $ipi;
1499  }  }
# Line 1361  Line 1506 
1506    
1507      if ($wp =~ /^WP:(\S+)$/)      if ($wp =~ /^WP:(\S+)$/)
1508      {      {
1509          return "<a href=http://www.wormbase.org/db/searches/basic?class=Any&query=$1&Search=Search>$wp</a>";          return "<a href='http://www.wormbase.org/db/searches/basic?class=Any&query=$1&Search=Search' target=_blank>$wp</a>";
1510      }      }
1511      return $wp;      return $wp;
1512  }  }
# Line 1374  Line 1519 
1519    
1520      if ($fb =~ /^FB:(\S+)$/)      if ($fb =~ /^FB:(\S+)$/)
1521      {      {
1522          return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";          return "<a href='http://flybase.bio.indiana.edu/.bin/fbidq.html?$1' target=_blank>$fb</a>";
1523      }      }
1524      return $fb;      return $fb;
1525  }  }
# Line 1387  Line 1532 
1532    
1533      if ($fb =~ /^FlyBaseORFNames:(\S+)$/)      if ($fb =~ /^FlyBaseORFNames:(\S+)$/)
1534      {      {
1535          return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";          return "<a href='http://flybase.bio.indiana.edu/.bin/fbidq.html?$1' target=_blank>$fb</a>";
1536      }      }
1537      return $fb;      return $fb;
1538  }  }
# Line 1400  Line 1545 
1545    
1546      if ($sgd =~ /^SGD_LOCUS:(\S+)$/)      if ($sgd =~ /^SGD_LOCUS:(\S+)$/)
1547      {      {
1548          return "<a href=http://db.yeastgenome.org/cgi-bin/locus.pl?locus=$1>$sgd</a>";          return "<a href='http://db.yeastgenome.org/cgi-bin/locus.pl?locus=$1' target=_blank>$sgd</a>";
1549      }      }
1550      return $sgd;      return $sgd;
1551  }  }
# Line 1431  Line 1576 
1576      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1577      my($cgi,$map,$org) = @_;      my($cgi,$map,$org) = @_;
1578    
1579      $user = $cgi->param('user');      my $user = $cgi->param('user');
1580      $user = $user ? $user : "";      $user = $user ? $user : "";
1581      $org = $org ? $org : "";      $org = $org ? $org : "";
1582    
# Line 1449  Line 1594 
1594    # -name => field and the checkbox name    # -name => field and the checkbox name
1595    my ($form, $button)=@_;    my ($form, $button)=@_;
1596    
1597    $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";
1598    $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";
1599    $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";
1600    $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 1457  Line 1602 
1602    return $java_script;    return $java_script;
1603  }  }
1604    
1605    =head3 sub_link
1606    
1607    C<< my $htmlText = HTML::sub_link($cgi, $sub); >>
1608    
1609    Create a subsystem link. The link will be to the display page if there is no
1610    user or we are in SPROUT mode; otherwise it will be to the edit page.
1611    
1612    =over 4
1613    
1614    =item cgi
1615    
1616    CGI query object for the current web session. The parameters of special interest
1617    are C<SPROUT> and C<user>. If the user is non-blank and SPROUT mode is 0, then
1618    the subsystem's edit page will be shown rather than its display page.
1619    
1620    =item sub
1621    
1622    Name of the desired subsystem. It will be cleaned of underscores before the
1623    hyperlink is applied.
1624    
1625    =back
1626    
1627    =cut
1628    
1629  sub sub_link {  sub sub_link {
1630        # Allow call as an instance in addition to the authorized method.
1631      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1632        # Get the parameters.
1633      my($cgi,$sub) = @_;      my($cgi,$sub) = @_;
1634      my($sub_link);      # Declare the return variable.
1635        my $retVal;
1636      my $user = $cgi->param('user');      # Clean the subsystem name for display purposes. This is a very
1637      if ($user)      # different thing from URL-escaping.
1638      {      my $cleaned = CGI::escapeHTML($sub);
1639          my $esc_sub = uri_escape( $sub );      $cleaned =~ s/_/ /g;
1640          $sub =~ s/\_/ /g;      # URL-escape the subsystem name for use in the link.
1641          $sub_link = "<a href=./subsys.cgi?ssa_name=$esc_sub&request=show_ssa&user=$user>$sub</a>";      my $linkable = uri_escape($sub);
1642      }      # Determine the mode. Note we use the little OR trick to insure that
1643      else      # we have the correct value for plugging into the output link.
1644      {      my $user = $cgi->param('user') || "";
1645          $sub_link = $sub;      my $sproutMode = $cgi->param('SPROUT') || 0;
1646        if ($user && ! $sproutMode) {
1647            # A SEED user is calling, so we go to the edit page.
1648            $retVal = "<a href=\"subsys.cgi?ssa_name=$linkable&request=show_ssa&user=$user\">$cleaned</a>";
1649        } else {
1650            # A visitor or SPROUT user is calling, so we go to the display page.
1651            $retVal = "<a href=\"display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;SPROUT=$sproutMode\">$cleaned</a>";
1652      }      }
1653      return $sub_link;      # Return the result.
1654        return $retVal;
1655  }  }
1656    
1657    
1658  sub reaction_link {  sub reaction_link {
1659      my($reaction) = @_;      my($reaction) = @_;
1660        if ($reaction =~ /^(\*)?(R\d+)/)
     if ($reaction =~ /^R\d+/)  
1661      {      {
1662          return "<a href=\"http://www.genome.ad.jp/dbget-bin/www_bget?rn+$reaction\" target=reaction$$>$reaction</a>";          return "<a href=\"http://www.genome.ad.jp/dbget-bin/www_bget?rn+$2\" target=reaction$$>$reaction</a>";
1663      }      }
1664      return $reaction;      return $reaction;
1665  }  }
1666    
1667    
1668  sub html_for_assignments {  sub html_for_assignments {
1669      my($fig,$user,$peg_sets) = @_;      my($fig,$user,$peg_sets) = @_;
1670      my $i;      my $i;
1671    
1672      my @vals = ();      my @vals = ();
1673      my $set = 1;      my $set = 1;
1674      foreach $peg_set (@$peg_sets)      foreach my $peg_set (@$peg_sets)
1675      {      {
1676          for ($i=0; ($i < @$peg_set); $i++)          for ($i=0; ($i < @$peg_set); $i++)
1677          {          {
1678              $peg = $peg_set->[$i];              my $peg = $peg_set->[$i];
1679              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)),"")));
1680          }          }
1681          $set++;          $set++;
# Line 1607  Line 1786 
1786    
1787    
1788   my @files=("SEED.rss");   my @files=("SEED.rss");
1789   if ($args->{"type"}) {push @files, "SEED.$type.rss"}   if ($args->{"type"}) {
1790        my $type = $args->{type};
1791        push @files, "SEED.$type.rss"
1792    }
1793    
1794   foreach my $file ("SEED.rss", @$files)   foreach my $file ("SEED.rss", @$files)
1795   {   {

Legend:
Removed from v.1.83  
changed lines
  Added in v.1.112

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3