[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.77, Wed Dec 28 04:00:26 2005 UTC revision 1.100, Sun Sep 24 15:22:58 2006 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 28  Line 29 
29  use HTTP::Request::Common;  use HTTP::Request::Common;
30  use POSIX;  use POSIX;
31    
32    #use raelib; # now used for the excel function, that should eventually end up in here. Way too experimental!
33    my $raelib;
34    
35    
36  my $top_link_cache;  my $top_link_cache;
37    
# Line 78  Line 82 
82      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
83      my($additional_insert, $user, %options ) = @_;      my($additional_insert, $user, %options ) = @_;
84    
85        local $/ = "\n";
86    
87      my $header_name = $options{header_name} ? $options{header_name} : "html.hdr";      my $header_name = $options{header_name} ? $options{header_name} : "html.hdr";
88      my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";      my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";
89    
# Line 156  Line 162 
162  sub show_page {  sub show_page {
163      #warn "SHOWPAGE: cgi=", Dumper(@_);      #warn "SHOWPAGE: cgi=", Dumper(@_);
164      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
165      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie) = @_;      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie, $options) = @_;
166      my $i;      my $i;
167    
168      my $top = top_link();      my $top = top_link();
# Line 169  Line 175 
175      #     $css is a reference to a hash. The key is the name of the CSS sheet and the value is the URL of that sheet. Note the usual rules about relative css urls      #     $css is a reference to a hash. The key is the name of the CSS sheet and the value is the URL of that sheet. Note the usual rules about relative css urls
176      #               the sheet named "Default" is considered to be the default style sheet, and if this is not set it points at $FIG_Config::HTML/css/default.css      #               the sheet named "Default" is considered to be the default style sheet, and if this is not set it points at $FIG_Config::HTML/css/default.css
177      #               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
178      #     $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")
179      #     $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
180        #     $options is a reference to a hash of options that you can pass around the pages
181      #      #
182      # Find the HTML header      # Find the HTML header
183      #      #
184    
185      my $html_tail_file = "./Html/$tail_name";      ### TRS ### "tail_name" has no value here.
186      if (! -f $html_tail_file)      my $html_tail_file = ""; # "./Html/$tail_name";
187      {  #    if (! -f $html_tail_file)
188          $html_tail_file = "$FIG_Config::fig/CGI/Html/$tail_name";  #    {
189      }  #        $html_tail_file = "$FIG_Config::fig/CGI/Html/$tail_name";
190    #    }
191    
192      my $user = $cgi->param('user') || "";      my $user = $cgi->param('user') || "";
193      my @html_hdr;      my @html_hdr;
# Line 189  Line 197 
197      }      }
198      else      else
199      {      {
200          @html_hdr = compute_html_header(undef,$user);          @html_hdr = compute_html_header(undef,$user,%$options);
201      }      }
202    
203      # 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 359  Line 367 
367    
368      if (!$css || !$css->{'Default'})      if (!$css || !$css->{'Default'})
369      {      {
370         $css->{'Default'} = "$top/Html/css/default.css";         $css->{'Default'} = "Html/css/default.css";
371      }      }
372      if (!$css->{"Sans Serif"})      if (!$css->{"Sans Serif"})
373      {      {
374         $css->{'Sans Serif'} = "$top/Html/css/sanserif.css";         $css->{'Sans Serif'} = "Html/css/sanserif.css";
375      }      }
376    
377      my $csstext = "<link rel='stylesheet' title='default' href='".$css->{'Default'}."' type='text/css'>\n";      my $csstext = "<link rel='stylesheet' title='default' href='".$css->{'Default'}."' type='text/css'>\n";
# Line 375  Line 383 
383         $csstext .= "<link rel='alternate stylesheet' title='$k' href='".$css->{$k}."' type='text/css'>\n";         $csstext .= "<link rel='alternate stylesheet' title='$k' href='".$css->{$k}."' type='text/css'>\n";
384      }      }
385    
386      $csstext   .= "<link rel='alternate'  title='SEED RSS feeds' href='$top/Html/rss/SEED.rss' type='application/rss+xml'>\n";      $csstext   .= "<link rel='alternate'  title='SEED RSS feeds' href='Html/rss/SEED.rss' type='application/rss+xml'>\n";
387    
388      # RAE: also added support for external javascripts here.      # RAE: also added support for external javascripts here.
389      # we are cluttering the HTML code with all the javascripts when they could easily be in external files      # we are cluttering the HTML code with all the javascripts when they could easily be in external files
# Line 385  Line 393 
393      # it will reduce our overhead.      # it will reduce our overhead.
394    
395      # $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
396      push @$javasrc, "$top/Html/css/FIG.js";      push @$javasrc, "Html/css/FIG.js";
397      foreach my $script (@$javasrc) {      foreach my $script (@$javasrc) {
398          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";
399      }      }
# Line 409  Line 417 
417          # BASE href needs to be absolute. RDO.          # BASE href needs to be absolute. RDO.
418          #          #
419          #          #
420          $base_url = &FIG::cgi_url;  #        $base_url = &FIG::cgi_url;
421  #       my $base_url = $FIG_Config::cgi_base;  #       my $base_url = $FIG_Config::cgi_base;
422  #       if ( ! $base_url )                      # if cgi_base was not defined  #       if ( ! $base_url )                      # if cgi_base was not defined
423  #       {  #       {
# Line 515  Line 523 
523    
524  }  }
525    
526    
527    =head1 make_table
528    
529    The main method to convert an array into a table.
530    
531    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.
532    
533    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.
534    
535    =cut
536    
537  sub make_table {  sub make_table {
538      my($col_hdrs,$tab,$title, %options ) = @_;      my($col_hdrs,$tab,$title, %options ) = @_;
539      my(@tab);      my(@tab);
# Line 539  Line 558 
558              );              );
559      }      }
560      push(@tab,"</table>\n");      push(@tab,"</table>\n");
561    
562        # excelfile should be appropriate for a filename (no spaces/special characters)
563        if (defined $options{"excelfile"}) {
564            if (! defined($raelib)) {
565                require raelib;
566                $raelib = new raelib;
567            }
568            push @tab, $raelib->tab2excel($col_hdrs,$tab,$title,\%options,$options{"excelfile"})}
569    
570      return join("",@tab);      return join("",@tab);
571  }  }
572    
# Line 552  Line 580 
580      foreach my $x (@$coupling)      foreach my $x (@$coupling)
581      {      {
582          my($peg2,$psc,$type,$extra) = @$x;          my($peg2,$psc,$type,$extra) = @$x;
583            if (($type !~ /^[ID]FC$/) || (! $fc{$peg2}))
584            {
585                if ($type =~  /^[ID]FC$/)
586                {
587                    $fc{$peg2} = 1;
588                }
589    
590          $by_peg{$peg2} += $psc;          $by_peg{$peg2} += $psc;
591      }      }
592        }
593    
594      foreach my $x (sort { ($by_peg{$b->[0]} <=> $by_peg{$a->[0]})      foreach my $x (sort { ($by_peg{$b->[0]} <=> $by_peg{$a->[0]})
595                            or ($a->[0] cmp $b->[0])                            or ($a->[0] cmp $b->[0])
# Line 561  Line 597 
597                            or ($a->[2] cmp $b->[2]) } @$coupling)                            or ($a->[2] cmp $b->[2]) } @$coupling)
598      {      {
599          my($peg2,$psc,$type,$extra) = @$x;          my($peg2,$psc,$type,$extra) = @$x;
         if (($type !~ /^[ID]FC$/) || (! $fc{$peg2}))  
         {  
             if ($type =~  /^[ID]FC$/)  
             {  
                 $fc{$peg2} = 1;  
             }  
600              push(@$tab,[&fid_link($cgi,$peg2,1),$psc,$type,&set_prot_links($cgi,join(", ",@$extra))]);              push(@$tab,[&fid_link($cgi,$peg2,1),$psc,$type,&set_prot_links($cgi,join(", ",@$extra))]);
601          }          }
     }  
602    
603    
604       my $help = "<a href=\"Html/abstract_coupling.html\" target=\"SEED_or_SPROUT_help\">for help</a>";       my $help = "<a href=\"Html/abstract_coupling.html\" target=\"SEED_or_SPROUT_help\">for help</a>";
# Line 809  Line 838 
838          }          }
839    
840          my $link;          my $link;
841            my $new_framework = $cgi->param('new_framework') ? 1 : 0;
842          #added to format prophage and path island links to feature.cgi          #added to format prophage and path island links to feature.cgi
843          if ($1 ne "peg")          my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";
844            if ($1 ne "peg" && ! $sprout)
845          {          {
846             my $user = $cgi->param('user');             my $user = $cgi->param('user');
847             if (! $user) { $user = "" }             if (! $user) { $user = "" }
848             my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";             $link = "$top/feature.cgi?feature=$fid&user=$user$sprout";
            $link = "$top/feature.cgi?feature=$fid&user=$user$trans$sprout";  
849             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;
850          }          }
851          else          else
# Line 835  Line 865 
865    
866              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }
867              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";
868              $link = "$top/protein.cgi?prot=$fid&user=$user$trans$sprout";              $link = "$top/protein.cgi?prot=$fid&user=$user$trans$sprout\&new_framework=$new_framework";
869              $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;              $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;
870          }          }
871          if ($just_url)          if ($just_url)
# Line 844  Line 874 
874          }          }
875          else          else
876          {          {
877              return "<a href=$link>$n</a>";              return "<a href='$link'>$n</a>";
878          }          }
879      }      }
880      return $fid;      return $fid;
# Line 876  Line 906 
906          my $response = $ua->request($request);          my $response = $ua->request($request);
907          $out = $response->content;          $out = $response->content;
908      }      }
909      else  
910        if ($type =~/get/i)
911      {      {
912          @args = ();          @args = ();
913          foreach $x (@$kv_pairs)          foreach $x (@$kv_pairs)
# Line 888  Line 919 
919          {          {
920              $url .= "?" . join("&",@args);              $url .= "?" . join("&",@args);
921          }          }
922          $request = new HTTP::Request('GET', $url);          my $request = new HTTP::Request('GET', $url);
923          my $response = $ua->request($request);          my $response = $ua->request($request);
924    
925          if ($response->is_success)          if ($response->is_success)
# Line 906  Line 937 
937    
938  #   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
939  #   properly.  Remove the header.  #   properly.  Remove the header.
940        my $i;
941      for ($i=0; ($i < @output) && ($output[$i] !~ /^\s*\</); $i++) {}      for ($i=0; ($i < @output) && ($output[$i] !~ /^\s*\</); $i++) {}
942      if ($i < @output)      if ($i < @output) {
     {  
   
943          splice(@output,0,$i);          splice(@output,0,$i);
944      }      }
945    
# Line 926  Line 955 
955  sub trim_output {  sub trim_output {
956      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
957      my($out) = @_;      my($out) = @_;
958      my $i;      my ($i, $j);
959    
960      for ($i=0; ($i < @$out) && ($out->[$i] !~ /^\</); $i++) {}      for ($i=0; ($i < @$out) && ($out->[$i] !~ /^\</); $i++) {}
961      splice(@$out,0,$i);      splice(@$out,0,$i);
# Line 955  Line 984 
984      for ($j=$i-1; ($j > 0) && ($out->[$j] !~ /FIG search/); $j--) {}      for ($j=$i-1; ($j > 0) && ($out->[$j] !~ /FIG search/); $j--) {}
985      if ($j > 0)      if ($j > 0)
986      {      {
987          my @tmp = `cat $html_tail_file`;           ### TRS ###
988          my $n = @tmp;  #        my @tmp = `cat $html_tail_file`;
989          splice(@$out,$j-$n,$n+1);  #        my $n = @tmp;
990    #        splice(@$out,$j-$n,$n+1);
991      }      }
992  }  }
993    
# Line 987  Line 1017 
1017          $after = $3;          $after = $3;
1018          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);
1019      }      }
1020      elsif ($x =~ /^(.*)(tigr\|[0-9a-zA-Z]+)(.*)/s)      elsif ($x =~ /^(.*)(tigr\|\w+)(.*)/s)
1021      {      {
1022          $before = $1;          $before = $1;
1023          $match = $2;          $match = $2;
1024          $after = $3;          $after = $3;
1025          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);
1026      }      }
1027        elsif ($x =~ /^(.*)\b(eric\|\S+)\b(.*)/s)
1028        {
1029            $before = $1;
1030            $match = $2;
1031            $after = $3;
1032            return &set_prot_links($cgi,$before) . &HTML::eric_link($cgi,$match) . &set_prot_links($cgi,$after);
1033        }
1034    
1035        elsif ($x =~ /^(.*)\b(bhb\|.*?)\b(.*)/s)
1036        {
1037            $before = $1;
1038            $match = $2;
1039            $after = $3;
1040            return &set_prot_links($cgi,$before) . &HTML::bhb_link($cgi,$match) . &set_prot_links($cgi,$after);
1041        }
1042    
1043        elsif ($x =~ /^(.*)\b(apidb\|[0-9\.a-z_]+)\b(.*)/s)
1044        {
1045            $before = $1;
1046            $match = $2;
1047            $after = $3;
1048            return &set_prot_links($cgi,$before) . &HTML::apidb_link($cgi,$match) . &set_prot_links($cgi,$after);
1049        }
1050    
1051        elsif ($x =~ /^(.*)\b(patric\|.*?)\b(.*)/s)
1052        {
1053            $before = $1;
1054            $match = $2;
1055            $after = $3;
1056            return &set_prot_links($cgi,$before) . &HTML::patric_link($cgi,$match) . &set_prot_links($cgi,$after);
1057        }
1058    
1059        elsif ($x =~ /^(.*)\b(vbrc\|.*?)\b(.*)/s)
1060        {
1061            $before = $1;
1062            $match = $2;
1063            $after = $3;
1064            return &set_prot_links($cgi,$before) . &HTML::vbrc_link($cgi,$match) . &set_prot_links($cgi,$after);
1065        }
1066    
1067        elsif ($x =~ /^(.*)\b(vectorbase\|.*?)\b(.*)/s)
1068        {
1069            $before = $1;
1070            $match = $2;
1071            $after = $3;
1072            return &set_prot_links($cgi,$before) . &HTML::vectorbase_link($cgi,$match) . &set_prot_links($cgi,$after);
1073        }
1074      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)
1075      {      {
1076          $before = $1;          $before = $1;
# Line 1043  Line 1120 
1120          $after = $3;          $after = $3;
1121          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);
1122      }      }
1123      elsif ($x =~ /^(.*)(UniGene:[a-zA-Z_0-9\.]+)(.*)/s)      elsif ($x =~ /^(.*)(HGNC:[a-zA-Z_0-9\.]+)(.*)/s)
1124      {      {
1125          $before = $1;          $before = $1;
1126          $match = $2;          $match = $2;
1127          $after = $3;          $after = $3;
1128          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);
1129      }      }
1130      elsif ($x =~ /^(.*)(IPI:[a-zA-Z_0-9\.]+)(.*)/s)      elsif ($x =~ /^(.*)(UniGene:[a-zA-Z_0-9\.]+)(.*)/s)
1131      {      {
1132          $before = $1;          $before = $1;
1133          $match = $2;          $match = $2;
1134          $after = $3;          $after = $3;
1135          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);
1136      }      }
1137    # IPI stopped working. turn off for now.
1138    #    elsif ($x =~ /^(.*)(IPI:[a-zA-Z_0-9\.]+)(.*)/s)
1139    #    {
1140    #        $before = $1;
1141    #        $match = $2;
1142    #        $after = $3;
1143    #        return &set_prot_links($cgi,$before) . &HTML::ipi_link($cgi,$match) . &set_prot_links($cgi,$after);
1144    #    }
1145      elsif ($x =~ /^(.*)(WP:[a-zA-Z_0-9\.]+)(.*)/s)      elsif ($x =~ /^(.*)(WP:[a-zA-Z_0-9\.]+)(.*)/s)
1146      {      {
1147          #wormbase          #wormbase
# Line 1093  Line 1178 
1178          $after = $3;          $after = $3;
1179          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);
1180      }      }
1181        elsif ($x =~ /^(.*)(tr\|[a-zA-Z0-9]+)(.*)/s)
1182        {
1183    
1184          $before = $1;
1185          $match = $2;
1186          $after = $3;
1187    
1188          return &set_prot_links($cgi,$before) .  &HTML::trembl_link($cgi,$match) . &set_prot_links($cgi,$after);
1189        }
1190      return $x;      return $x;
1191  }  }
1192    
1193    sub trembl_link {
1194        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1195        my($cgi,$id) = @_;
1196    
1197        if ($id =~ /^tr\|(.*)/) {
1198          return "<a href='http://ca.expasy.org/uniprot/$1' target=_blank>$id</a>";
1199        } else {
1200          return "invalid call to trembl link";
1201        }
1202    }
1203    
1204  sub refseq_link {  sub refseq_link {
1205      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1206      my($cgi,$id) = @_;      my($cgi,$id) = @_;
1207    
1208      if ($id =~ /^[NXYZA]P_/)      if ($id =~ /^[NXYZA]P_/)
1209      {      {
1210          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>";
1211      }      }
1212      elsif ($id =~ /^[NXYZA]M_/)      elsif ($id =~ /^[NXYZA]M_/)
1213      {      {
1214          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>";
1215      }      }
1216  }  }
1217    
# Line 1116  Line 1221 
1221    
1222      if ($gi =~ /^gi\|(\d+)$/)      if ($gi =~ /^gi\|(\d+)$/)
1223      {      {
1224          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>";
1225      }      }
1226      return $gi;      return $gi;
1227  }  }
# Line 1125  Line 1230 
1230      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1231      my($cgi,$tigr) = @_;      my($cgi,$tigr) = @_;
1232    
1233      if ($tigr =~ /^tigr\|([0-9a-zA-Z]+)$/)      if ($tigr =~ /^tigr\|(NT|ntbp|ntbpA|BA|BMAA|BXB|GBA)(\w+)$/)
1234        {
1235            my $id=$1.$2;
1236            return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\" target=_blank>$tigr</a> (Pathema)";
1237        }
1238        elsif ($tigr =~ /^tigr\|(\S+)$/)
1239      {      {
1240          return "<a href=\"http://pathema.tigr.org/tigr-scripts/CMR/GenePage.cgi?locus=$1\">$tigr</a>";          return "<a href=\"http://www.tigr.org/tigr-scripts/CMR2/GenePage.spl?locus=$1\" target=_blank>$tigr</a>";
1241      }      }
1242      return $tigr;      return $tigr;
1243  }  }
1244    
1245    sub eric_link {
1246        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1247        my($cgi,$eric) = @_;
1248    
1249        if ($eric =~ /^eric\|(\S+)/)
1250        {
1251            return "<a href=\"https://asap.ahabs.wisc.edu/asap/feature_info.php?FeatureID=$1\" target=_blank>$eric</a>";
1252        }
1253        return $eric;
1254    }
1255    
1256    sub bhb_link {
1257        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1258        my($cgi,$bhb) = @_;
1259    
1260        return "<a href=\"http://www.biohealthbase.org\" target=_blank>$bhb</a>";
1261    }
1262    
1263    sub apidb_link {
1264        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1265        my($cgi,$api) = @_;
1266    
1267        if ($api =~ /apidb\|(.*?)\.(.*)$/)
1268        {
1269            return "<a href=\"http://www.apidb.org/cgi-bin/redirect.cgi?taxon_id=$1&source_id=$2\" target=_blank>$api</a>";
1270        }
1271        return $api;
1272    }
1273    
1274    sub patric_link {
1275        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1276        my($cgi,$patric) = @_;
1277    
1278        if ($patric =~ /patric\|(.*)/)
1279        {
1280            return "<a href=\"https://patric.vbi.vt.edu/software/curationTool/gep/pgiCuration.php?locus_name=$1\" target=_blank>$patric</a>";
1281        }
1282        return $patric;
1283    }
1284    
1285    sub vbrc_link {
1286        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1287        my($cgi,$vbrc) = @_;
1288    
1289        if ($vbrc =~ /vbrc\|(.*)/)
1290        {
1291            return "<a href=\"http://www.biovirus.org/gene_detail.asp?name=$1\" target=_blank>$vbrc</a>";
1292        }
1293        return $vbrc;
1294    }
1295    
1296    sub vectorbase_link {
1297        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1298        my($cgi,$vec) = @_;
1299        return "<a href=\"http://www.vectorbase.org\" target=_blank>$vec</a>";
1300    }
1301    
1302    
1303  sub uni_link {  sub uni_link {
1304      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1305      my($cgi,$uni) = @_;      my($cgi,$uni) = @_;
1306    
1307      if ($uni =~ /^uni\|(\S+)$/)      if ($uni =~ /^uni\|(\S+)$/)
1308      {      {
1309          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>";
1310            return "<a href='http://www.ebi.uniprot.org/uniprot-srv/uniProtView.do?proteinAc=$1' target=_blank>$uni</a>";
1311      }      }
1312      return $uni;      return $uni;
1313  }  }
# Line 1149  Line 1318 
1318    
1319      if ($sp =~ /^sp\|(\S+)$/)      if ($sp =~ /^sp\|(\S+)$/)
1320      {      {
1321          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>";
1322      }      }
1323      return $sp;      return $sp;
1324  }  }
# Line 1160  Line 1329 
1329    
1330      if ($pir =~ /^pirnr\|(NF\d+)$/)      if ($pir =~ /^pirnr\|(NF\d+)$/)
1331      {      {
1332          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>";
1333      }      }
1334      return $pir;      return $pir;
1335  }  }
# Line 1171  Line 1340 
1340    
1341      if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)      if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)
1342      {      {
1343          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>";
1344      }      }
1345      return $kegg;      return $kegg;
1346  }  }
# Line 1184  Line 1353 
1353      {      {
1354          my $what=$1;          my $what=$1;
1355          my $key=$2;          my $key=$2;
1356          my $idx="all";          my $idx="All";
1357          if ($what eq "EnsemblGene") { $idx = "Gene" }          if ($what eq "EnsemblGene") { $idx = "Gene" }
1358          if ($what eq "EnsemblTranscript") { $idx = "all" }          if ($what eq "EnsemblTranscript") { $idx = "All" }
1359          if ($what eq "EnsemblProtein") { $idx = "all" }          if ($what eq "EnsemblProtein") { $idx = "All" }
1360    
1361          #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
1362          #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
1363          #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)
1364    
1365          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>";
1366      }      }
1367      return $ensembl;      return $ensembl;
1368  }  }
# Line 1204  Line 1373 
1373    
1374      if ($entrezgene =~ /^EntrezGene:(\S+)$/)      if ($entrezgene =~ /^EntrezGene:(\S+)$/)
1375      {      {
1376          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>";
1377      }      }
1378      return $entrezgene;      return $entrezgene;
1379  }  }
# Line 1215  Line 1384 
1384    
1385      if ($mim =~ /^MIM:(\S+)$/)      if ($mim =~ /^MIM:(\S+)$/)
1386      {      {
1387          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>";
1388      }      }
1389      return $mim;      return $mim;
1390  }  }
1391    
1392    sub hgnc_link {
1393        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1394        my($cgi,$hgnc) = @_;
1395    
1396        if ($hgnc =~ /^HGNC:(\S+)$/)
1397        {
1398            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>";
1399        }
1400        ### TRS ###: was $mim, changed to $hgnc
1401        return $hgnc;
1402    }
1403    
1404  sub unigene_link {  sub unigene_link {
1405      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1406      my($cgi,$unigene) = @_;      my($cgi,$unigene) = @_;
1407    
1408      if ($unigene =~ /^UniGene:(\S+)$/)      if ($unigene =~ /^UniGene:(\S+)$/)
1409      {      {
1410          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>";
1411      }      }
1412      return $unigene;      return $unigene;
1413  }  }
# Line 1237  Line 1418 
1418    
1419      if ($ipi =~ /^IPI:(\S+)$/)      if ($ipi =~ /^IPI:(\S+)$/)
1420      {      {
1421          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>";
1422      }      }
1423      return $ipi;      return $ipi;
1424  }  }
# Line 1250  Line 1431 
1431    
1432      if ($wp =~ /^WP:(\S+)$/)      if ($wp =~ /^WP:(\S+)$/)
1433      {      {
1434          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>";
1435      }      }
1436      return $wp;      return $wp;
1437  }  }
# Line 1263  Line 1444 
1444    
1445      if ($fb =~ /^FB:(\S+)$/)      if ($fb =~ /^FB:(\S+)$/)
1446      {      {
1447          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>";
1448      }      }
1449      return $fb;      return $fb;
1450  }  }
# Line 1276  Line 1457 
1457    
1458      if ($fb =~ /^FlyBaseORFNames:(\S+)$/)      if ($fb =~ /^FlyBaseORFNames:(\S+)$/)
1459      {      {
1460          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>";
1461      }      }
1462      return $fb;      return $fb;
1463  }  }
# Line 1289  Line 1470 
1470    
1471      if ($sgd =~ /^SGD_LOCUS:(\S+)$/)      if ($sgd =~ /^SGD_LOCUS:(\S+)$/)
1472      {      {
1473          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>";
1474      }      }
1475      return $sgd;      return $sgd;
1476  }  }
# Line 1320  Line 1501 
1501      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1502      my($cgi,$map,$org) = @_;      my($cgi,$map,$org) = @_;
1503    
1504      $user = $cgi->param('user');      my $user = $cgi->param('user');
1505      $user = $user ? $user : "";      $user = $user ? $user : "";
1506      $org = $org ? $org : "";      $org = $org ? $org : "";
1507    
# Line 1338  Line 1519 
1519    # -name => field and the checkbox name    # -name => field and the checkbox name
1520    my ($form, $button)=@_;    my ($form, $button)=@_;
1521    
1522    $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";
1523    $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";
1524    $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";
1525    $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 1352  Line 1533 
1533      my($sub_link);      my($sub_link);
1534    
1535      my $user = $cgi->param('user');      my $user = $cgi->param('user');
1536        my $esc_sub = uri_escape( $sub );
1537        $sub =~ s/\_/ /g;
1538      if ($user)      if ($user)
1539      {      {
         my $esc_sub = uri_escape( $sub );  
1540          $sub_link = "<a href=./subsys.cgi?ssa_name=$esc_sub&request=show_ssa&user=$user>$sub</a>";          $sub_link = "<a href=./subsys.cgi?ssa_name=$esc_sub&request=show_ssa&user=$user>$sub</a>";
1541      }      }
1542      else      else
1543      {      {
1544          $sub_link = $sub;          $sub_link = "<a href=\"display_subsys.cgi?ssa_name=$esc_sub&request=show_ssa&sort=by_phylo\">$sub</a>";
1545      }      }
1546      return $sub_link;      return $sub_link;
1547  }  }
1548    
1549  sub reaction_link {  sub reaction_link {
1550      my($reaction) = @_;      my($reaction) = @_;
1551        if ($reaction =~ /^(\*)?(R\d+)/)
     if ($reaction =~ /^R\d+/)  
1552      {      {
1553          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>";
1554      }      }
1555      return $reaction;      return $reaction;
1556  }  }
1557    
1558    
1559  sub html_for_assignments {  sub html_for_assignments {
1560      my($fig,$user,$peg_sets) = @_;      my($fig,$user,$peg_sets) = @_;
1561      my $i;      my $i;
1562    
1563      my @vals = ();      my @vals = ();
1564      my $set = 1;      my $set = 1;
1565      foreach $peg_set (@$peg_sets)      foreach my $peg_set (@$peg_sets)
1566      {      {
1567          for ($i=0; ($i < @$peg_set); $i++)          for ($i=0; ($i < @$peg_set); $i++)
1568          {          {
1569              $peg = $peg_set->[$i];              my $peg = $peg_set->[$i];
1570              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)),"")));
1571          }          }
1572          $set++;          $set++;
# Line 1495  Line 1677 
1677    
1678    
1679   my @files=("SEED.rss");   my @files=("SEED.rss");
1680   if ($args->{"type"}) {push @files, "SEED.$type.rss"}   if ($args->{"type"}) {
1681        ### TRS ### "$type" had no value here, so guessed what it should be.
1682        my $type = $args->{type};
1683        push @files, "SEED.$type.rss"
1684    }
1685    
1686   foreach my $file ("SEED.rss", @$files)   foreach my $file ("SEED.rss", @$files)
1687   {   {

Legend:
Removed from v.1.77  
changed lines
  Added in v.1.100

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3