[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.65, Tue Oct 11 17:14:48 2005 UTC revision 1.81, Tue Jan 24 23:51:22 2006 UTC
# Line 1  Line 1 
1    #
2    # Copyright (c) 2003-2006 University of Chicago and Fellowship
3    # for Interpretations of Genomes. All Rights Reserved.
4    #
5    # This file is part of the SEED Toolkit.
6    #
7    # The SEED Toolkit is free software. You can redistribute
8    # it and/or modify it under the terms of the SEED Toolkit
9    # Public License.
10    #
11    # You should have received a copy of the SEED Toolkit Public License
12    # along with this program; if not write to the University of Chicago
13    # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14    # Genomes at veronika@thefig.info or download a copy from
15    # http://www.theseed.org/LICENSE.TXT.
16    #
17    
18  package HTML;  package HTML;
19    
20  use Tracer;  use Tracer;
# Line 12  Line 29 
29  use POSIX;  use POSIX;
30    
31    
32    my $top_link_cache;
33    
34    
35  sub new  sub new
36  {  {
37      my($class) = @_;      my($class) = @_;
# Line 21  Line 41 
41      return bless $self, $class;      return bless $self, $class;
42  }  }
43    
44    sub top_link
45    {
46    
47        #
48        # Determine if this is a toplevel cgi or one in one of the subdirs (currently
49        # just /p2p).
50        #
51    
52        return $top_link_cache if ($top_link_cache);
53    
54        my @parts = split(/\//, $ENV{SCRIPT_NAME});
55        my $top;
56        if ($parts[-2] eq 'FIG')
57        {
58            $top = '.';
59    #       warn "toplevel @parts\n";
60        }
61        elsif ($parts[-3] eq 'FIG')
62        {
63            $top = '..';
64    #       warn "subdir @parts\n";
65        }
66        else
67        {
68            $top = $FIG_Config::cgi_base;
69    #       warn "other @parts\n";
70        }
71    
72        $top_link_cache = $top;
73        return $top;
74    }
75    
76  sub compute_html_header  sub compute_html_header
77  {  {
78      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
# Line 36  Line 88 
88      }      }
89      my @html_hdr = &FIG::file_read($html_hdr_file);      my @html_hdr = &FIG::file_read($html_hdr_file);
90    
91      $options{no_fig_search} or push( @html_hdr, "<br><a href=\"index.cgi?user=$user\">FIG search</a>\n" );      # for my $k (sort keys %ENV) { warn "$k = $ENV{$k}\n"; }
92    
93        #
94        # Determine if this is a toplevel cgi or one in one of the subdirs (currently
95        # just /p2p).
96        #
97    
98        my @parts = split(/\//, $ENV{SCRIPT_NAME});
99        my $top;
100        if ($parts[-2] eq 'FIG')
101        {
102            $top = '.';
103    #       warn "toplevel @parts\n";
104        }
105        elsif ($parts[-3] eq 'FIG')
106        {
107            $top = '..';
108    #       warn "subdir @parts\n";
109        }
110        else
111        {
112            $top = $FIG_Config::cgi_base;
113    #       warn "other @parts\n";
114        }
115    
116        $options{no_fig_search} or push( @html_hdr, "<br><a href=\"$top/index.cgi?user=$user\">FIG search</a>\n" );
117    
118      if (@html_hdr)      if (@html_hdr)
119      {      {
# Line 64  Line 141 
141    
142          for $_ (@html_hdr)          for $_ (@html_hdr)
143          {          {
144              s,(href|img\s+src)="/FIG/,\1="$FIG_Config::cgi_base,g;              s,(href|img\s+src)="/FIG/,$1="$top/,g;
145              s,(\?user\=)\",$1$user",;              s,(\?user\=)\",$1$user",;
146              if ($_ eq "<!-- HEADER_INSERT -->\n")              if ($_ eq "<!-- HEADER_INSERT -->\n")
147              {              {
# Line 82  Line 159 
159      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie) = @_;      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie) = @_;
160      my $i;      my $i;
161    
162        my $top = top_link();
163    
164      # ARGUMENTS:      # ARGUMENTS:
165      #     $cgi is the CGI method      #     $cgi is the CGI method
166      #     $html is an array with all the html in it. It is just joined by "\n" (and not <br> or <p>      #     $html is an array with all the html in it. It is just joined by "\n" (and not <br> or <p>
# Line 90  Line 169 
169      #     $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
170      #               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
171      #               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
172      #     $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")
173      #     $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
174      #      #
175      # Find the HTML header      # Find the HTML header
# Line 181  Line 260 
260          if ( $html->[$i] =~ /\<body[^0-9a-z]/i )          if ( $html->[$i] =~ /\<body[^0-9a-z]/i )
261          {          {
262              $body_line = $i;              $body_line = $i;
263              $last;              last;
264          }          }
265    
266          #  Now the general case.          #  Now the general case.
# Line 280  Line 359 
359    
360      if (!$css || !$css->{'Default'})      if (!$css || !$css->{'Default'})
361      {      {
362         $css->{'Default'} = &FIG::cgi_url() . "/Html/css/default.css";         $css->{'Default'} = "Html/css/default.css";
363      }      }
364      if (!$css->{"Sans Serif"})      if (!$css->{"Sans Serif"})
365      {      {
366         $css->{'Sans Serif'} = &FIG::cgi_url() . "/Html/css/sanserif.css";         $css->{'Sans Serif'} = "Html/css/sanserif.css";
367      }      }
368    
369      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 296  Line 375 
375         $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";
376      }      }
377    
378      $csstext   .= "<link rel='alternate'  title='SEED RSS feeds' href='".&FIG::cgi_url()."/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";
379    
380      # RAE: also added support for external javascripts here.      # RAE: also added support for external javascripts here.
381      # 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 306  Line 385 
385      # it will reduce our overhead.      # it will reduce our overhead.
386    
387      # $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
388      push @$javasrc, &FIG::cgi_url() . "/Html/css/FIG.js";      push @$javasrc, "Html/css/FIG.js";
389      foreach my $script (@$javasrc) {      foreach my $script (@$javasrc) {
390          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";
391      }      }
# Line 442  Line 521 
521    
522      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";
523      my $width = defined $options{width} ? "width=\"$options{width}\"" : undef;      my $width = defined $options{width} ? "width=\"$options{width}\"" : undef;
524      push( @tab, "\n<table $border $width>\n",      my $class = defined $options{class} ? "class=\"$options{class}\"" : undef;
525        push( @tab, "\n<table $border $width $class>\n",
526                  "\t<caption><b>$title</b></caption>\n",                  "\t<caption><b>$title</b></caption>\n",
527                  "\t<tr>\n\t\t"                  "\t<tr>\n\t\t"
528                . join( "\n", map { &expand($_, "th") } @$col_hdrs )                . join( "\n", map { &expand($_, "th") } @$col_hdrs )
# Line 462  Line 542 
542      return join("",@tab);      return join("",@tab);
543  }  }
544    
545    sub abstract_coupling_table {
546        my($cgi,$prot,$coupling) = @_;
547        my %fc;
548    
549        my $col_hdrs = ["coupled to","Score","Type of Coupling", "Type-specific Data"];
550        my $tab = [];
551        my %by_peg;
552        foreach my $x (@$coupling)
553        {
554            my($peg2,$psc,$type,$extra) = @$x;
555            if (($type !~ /^[ID]FC$/) || (! $fc{$peg2}))
556            {
557                if ($type =~  /^[ID]FC$/)
558                {
559                    $fc{$peg2} = 1;
560                }
561    
562                $by_peg{$peg2} += $psc;
563            }
564        }
565    
566        foreach my $x (sort { ($by_peg{$b->[0]} <=> $by_peg{$a->[0]})
567                              or ($a->[0] cmp $b->[0])
568                              or ($b->[1] <=> $a->[1])
569                              or ($a->[2] cmp $b->[2]) } @$coupling)
570        {
571            my($peg2,$psc,$type,$extra) = @$x;
572            push(@$tab,[&fid_link($cgi,$peg2,1),$psc,$type,&set_prot_links($cgi,join(", ",@$extra))]);
573        }
574    
575    
576         my $help = "<a href=\"Html/abstract_coupling.html\" target=\"SEED_or_SPROUT_help\">for help</a>";
577    #    my @html = &make_table($col_hdrs,$tab,"Abstract Coupling Data for $prot");
578    #    push(@html,"<hr>\n",$cgi->h3($help),"<br>");
579    #    return @html;
580    
581        return &make_table($col_hdrs,$tab,"Abstract Coupling Data for $prot [$help]");
582    }
583    
584  sub expand {  sub expand {
585      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
586      my( $x, $tag ) = @_;      my( $x, $tag ) = @_;
# Line 670  Line 789 
789      my($cgi,$fid,$local,$just_url) = @_;      my($cgi,$fid,$local,$just_url) = @_;
790      my($n);      my($n);
791    
792        my $top = top_link();
793    
794      if ($fid =~ /^fig\|\d+\.\d+\.([a-z]+)\.(\d+)/)      if ($fid =~ /^fig\|\d+\.\d+\.([a-z]+)\.(\d+)/)
795      {      {
796          if ($local)          if ($local)
# Line 695  Line 816 
816             my $user = $cgi->param('user');             my $user = $cgi->param('user');
817             if (! $user) { $user = "" }             if (! $user) { $user = "" }
818             my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";             my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";
819             $link = &FIG::cgi_url . "/feature.cgi?feature=$fid&user=$user$trans$sprout";             $link = "$top/feature.cgi?feature=$fid&user=$user$trans$sprout";
820             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;
821          }          }
822          else          else
# Line 715  Line 836 
836    
837              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }
838              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";
839              $link = "protein.cgi?prot=$fid&user=$user$trans$sprout";              $link = "$top/protein.cgi?prot=$fid&user=$user$trans$sprout";
840              $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;              $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;
             #  
             # Elimin the p2p part if we're in that subdir. Ugh.  
             #  
             $link =~ s,p2p/protein.cgi,protein.cgi,;  
841          }          }
842          if ($just_url)          if ($just_url)
843          {          {
# Line 857  Line 974 
974          $after = $3;          $after = $3;
975          return &set_prot_links($cgi,$before) . &HTML::fid_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::fid_link($cgi,$match) . &set_prot_links($cgi,$after);
976      }      }
977      elsif ($x =~ /^(.*)\b([NXYZA]P_[0-9\.]+)\b(.*)/s)      elsif ($x =~ /^(.*)\b([NXYZA][PM]_[0-9\.]+)\b(.*)/s)
978      {      {
979          $before = $1;          $before = $1;
980          $match = $2;          $match = $2;
# Line 878  Line 995 
995          $after = $3;          $after = $3;
996          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);
997      }      }
998        elsif ($x =~ /^(.*)\beric\|\w+\b(.*)/s)
999        {
1000            $before = $1;
1001            $match = $2;
1002            $after = $3;
1003            return &set_prot_links($cgi,$before) . &HTML::eric_link($cgi,$match) . &set_prot_links($cgi,$after);
1004        }
1005    
1006        elsif ($x =~ /^(.*)\bbhb\|.*?\b(.*)/s)
1007        {
1008            $before = $1;
1009            $match = $2;
1010            $after = $3;
1011            return &set_prot_links($cgi,$before) . &HTML::bhb_link($cgi,$match) . &set_prot_links($cgi,$after);
1012        }
1013    
1014        elsif ($x =~ /^(.*)\bapidb\|.*?\..*\b(.*)/s)
1015        {
1016            $before = $1;
1017            $match = $2;
1018            $after = $3;
1019            return &set_prot_links($cgi,$before) . &HTML::apidb_link($cgi,$match) . &set_prot_links($cgi,$after);
1020        }
1021    
1022        elsif ($x =~ /^(.*)\bpatric\|.*?\b(.*)/s)
1023        {
1024            $before = $1;
1025            $match = $2;
1026            $after = $3;
1027            return &set_prot_links($cgi,$before) . &HTML::patric_link($cgi,$match) . &set_prot_links($cgi,$after);
1028        }
1029    
1030        elsif ($x =~ /^(.*)\bvbrc\|.*?\b(.*)/s)
1031        {
1032            $before = $1;
1033            $match = $2;
1034            $after = $3;
1035            return &set_prot_links($cgi,$before) . &HTML::vbrc_link($cgi,$match) . &set_prot_links($cgi,$after);
1036        }
1037    
1038        elsif ($x =~ /^(.*)\bvectorbase\|.*?\b(.*)/s)
1039        {
1040            $before = $1;
1041            $match = $2;
1042            $after = $3;
1043            return &set_prot_links($cgi,$before) . &HTML::vectorbase_link($cgi,$match) . &set_prot_links($cgi,$after);
1044        }
1045      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)
1046      {      {
1047          $before = $1;          $before = $1;
# Line 906  Line 1070 
1070          $after = $3;          $after = $3;
1071          return &set_prot_links($cgi,$before) . &HTML::kegg_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::kegg_link($cgi,$match) . &set_prot_links($cgi,$after);
1072      }      }
1073        elsif ($x =~ /^(.*)(Ensembl[a-zA-Z]+:[a-zA-Z_0-9\.]+)(.*)/s)
1074        {
1075            $before = $1;
1076            $match = $2;
1077            $after = $3;
1078            return &set_prot_links($cgi,$before) . &HTML::ensembl_link($cgi,$match) . &set_prot_links($cgi,$after);
1079        }
1080        elsif ($x =~ /^(.*)(EntrezGene:[a-zA-Z_0-9\.]+)(.*)/s)
1081        {
1082            $before = $1;
1083            $match = $2;
1084            $after = $3;
1085            return &set_prot_links($cgi,$before) . &HTML::entrezgene_link($cgi,$match) . &set_prot_links($cgi,$after);
1086        }
1087        elsif ($x =~ /^(.*)(MIM:[a-zA-Z_0-9\.]+)(.*)/s)
1088        {
1089            $before = $1;
1090            $match = $2;
1091            $after = $3;
1092            return &set_prot_links($cgi,$before) . &HTML::mim_link($cgi,$match) . &set_prot_links($cgi,$after);
1093        }
1094        elsif ($x =~ /^(.*)(UniGene:[a-zA-Z_0-9\.]+)(.*)/s)
1095        {
1096            $before = $1;
1097            $match = $2;
1098            $after = $3;
1099            return &set_prot_links($cgi,$before) . &HTML::unigene_link($cgi,$match) . &set_prot_links($cgi,$after);
1100        }
1101        elsif ($x =~ /^(.*)(IPI:[a-zA-Z_0-9\.]+)(.*)/s)
1102        {
1103            $before = $1;
1104            $match = $2;
1105            $after = $3;
1106            return &set_prot_links($cgi,$before) . &HTML::ipi_link($cgi,$match) . &set_prot_links($cgi,$after);
1107        }
1108        elsif ($x =~ /^(.*)(WP:[a-zA-Z_0-9\.]+)(.*)/s)
1109        {
1110            #wormbase
1111    
1112            $before = $1;
1113            $match = $2;
1114            $after = $3;
1115            return &set_prot_links($cgi,$before) . &HTML::wp_link($cgi,$match) . &set_prot_links($cgi,$after);
1116        }
1117        elsif ($x =~ /^(.*)(FB:[a-zA-Z_0-9\.]+)(.*)/s)
1118        {
1119            #flybase
1120    
1121            $before = $1;
1122            $match = $2;
1123            $after = $3;
1124            return &set_prot_links($cgi,$before) . &HTML::fb_link($cgi,$match) . &set_prot_links($cgi,$after);
1125        }
1126        elsif ($x =~ /^(.*)(FlyBaseORFNames:[a-zA-Z_0-9\.]+)(.*)/s)
1127        {
1128            #flybase
1129    
1130            $before = $1;
1131            $match = $2;
1132            $after = $3;
1133            return &set_prot_links($cgi,$before) . &HTML::fborf_link($cgi,$match) . &set_prot_links($cgi,$after);
1134        }
1135        elsif ($x =~ /^(.*)(SGD_LOCUS:[a-zA-Z_0-9\.]+)(.*)/s)
1136        {
1137            #flybase
1138    
1139            $before = $1;
1140            $match = $2;
1141            $after = $3;
1142            return &set_prot_links($cgi,$before) . &HTML::sgd_link($cgi,$match) . &set_prot_links($cgi,$after);
1143        }
1144      return $x;      return $x;
1145  }  }
1146    
# Line 917  Line 1152 
1152      {      {
1153          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>$id</a>";
1154      }      }
1155        elsif ($id =~ /^[NXYZA]M_/)
1156        {
1157            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=nuccore&cmd=search&term=$id>$id</a>";
1158        }
1159  }  }
1160    
1161  sub gi_link {  sub gi_link {
# Line 934  Line 1173 
1173      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1174      my($cgi,$tigr) = @_;      my($cgi,$tigr) = @_;
1175    
1176      if ($tigr =~ /^tigr\|([0-9a-zA-Z]+)$/)      if ($tigr =~ /^tigr\|(NT|ntbp|ntbpA|BA|BMAA|BXB|GBA)([0-9a-zA-Z]+)$/)
1177        {
1178            my $id=$1.$2;
1179            return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\">$tigr</a> (Pathema)";
1180        }
1181        elsif ($tigr =~ /^tigr\|([0-9a-zA-Z]+)$/)
1182      {      {
1183          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\">$?tigr</a>";
1184      }      }
1185      return $tigr;      return $tigr;
1186  }  }
1187    
1188    sub eric_link {
1189        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1190        my($cgi,$eric) = @_;
1191    
1192        if ($eric =~ /^eric\|(\w+)$/)
1193        {
1194            return "<a href=\"https://asap.ahabs.wisc.edu/asap/feature_info.php?FeatureID=$1\">$eric</a>";
1195        }
1196        return $eric;
1197    }
1198    
1199    sub bhb_link {
1200        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1201        my($cgi,$bhb) = @_;
1202    
1203        return "<a href=\"http://www.biohealthbase.org\">$bhb</a>";
1204    }
1205    
1206    sub apidb_link {
1207        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1208        my($cgi,$api) = @_;
1209    
1210        if ($api =~ /apidb\|(.*?)\.(.*)$/)
1211        {
1212            return "<a href=\"http://www.apidb.org/cgi-bin/redirect.cgi?taxon_id=$1&source_id=$2\">$api</a>";
1213        }
1214        return $api;
1215    }
1216    
1217    sub patric_link {
1218        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1219        my($cgi,$patric) = @_;
1220    
1221        if ($patric =~ /patric\|(.*)/)
1222        {
1223            return "<a href=\"https://patric.vbi.vt.edu/software/curationTool/gep/pgiCuration.php?locus_name=$1\">$patric</a>";
1224        }
1225        return $patric;
1226    }
1227    
1228    sub vbrc_link {
1229        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1230        my($cgi,$vbrc) = @_;
1231    
1232        if ($vbrc =~ /vbrc\|(.*)/)
1233        {
1234            return "<a href=\"http://www.biovirus.org/gene_detail.asp?name=$1\">$vbrc</a>";
1235        }
1236        return $vbrc;
1237    }
1238    
1239    sub vectorbase_link {
1240        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1241        my($cgi,$vec) = @_;
1242        return "<a href=\"http://www.vectorbase.org\">$vec</a>";
1243    }
1244    
1245    
1246  sub uni_link {  sub uni_link {
1247      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1248      my($cgi,$uni) = @_;      my($cgi,$uni) = @_;
# Line 985  Line 1287 
1287      return $kegg;      return $kegg;
1288  }  }
1289    
1290    sub ensembl_link {
1291        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1292        my($cgi,$ensembl) = @_;
1293    
1294        if ($ensembl =~ /^(\S+):(\S+)$/)
1295        {
1296            my $what=$1;
1297            my $key=$2;
1298            my $idx="all";
1299            if ($what eq "EnsemblGene") { $idx = "Gene" }
1300            if ($what eq "EnsemblTranscript") { $idx = "all" }
1301            if ($what eq "EnsemblProtein") { $idx = "all" }
1302    
1303            #I really want to get right to the transcript and peptide pages, but
1304            #can't see how to do that without knowing the org name too, which
1305            #I don't know at this point. (ensembl org name, not real org name)
1306    
1307            return "<a href=http://www.ensembl.org/Homo_sapiens/textview?species=all&idx=$idx&q=$key>$ensembl</a>";
1308        }
1309        return $ensembl;
1310    }
1311    
1312    sub entrezgene_link {
1313        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1314        my($cgi,$entrezgene) = @_;
1315    
1316        if ($entrezgene =~ /^EntrezGene:(\S+)$/)
1317        {
1318            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=gene&cmd=Retrieve&dopt=full_report&list_uids=$1>$entrezgene</a>";
1319        }
1320        return $entrezgene;
1321    }
1322    
1323    sub mim_link {
1324        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1325        my($cgi,$mim) = @_;
1326    
1327        if ($mim =~ /^MIM:(\S+)$/)
1328        {
1329            return "<a href=http://www3.ncbi.nlm.nih.gov/entrez/dispomim.cgi?id=$1>$mim</a>";
1330        }
1331        return $mim;
1332    }
1333    
1334    sub unigene_link {
1335        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1336        my($cgi,$unigene) = @_;
1337    
1338        if ($unigene =~ /^UniGene:(\S+)$/)
1339        {
1340            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=unigene&cmd=search&term=$1>$unigene</a>";
1341        }
1342        return $unigene;
1343    }
1344    
1345    sub ipi_link {
1346        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1347        my($cgi,$ipi) = @_;
1348    
1349        if ($ipi =~ /^IPI:(\S+)$/)
1350        {
1351            return "<a href=http://srs.ebi.ac.uk/srsbin/cgi-bin/wgetz?-id+AEoS1R8Jnn+-e+[IPI:\'$1\']+-qnum+1+-enum+1>$ipi</a>";
1352        }
1353        return $ipi;
1354    }
1355    
1356    sub wp_link {
1357        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1358        my($cgi,$wp) = @_;
1359    
1360        #wormbase
1361    
1362        if ($wp =~ /^WP:(\S+)$/)
1363        {
1364            return "<a href=http://www.wormbase.org/db/searches/basic?class=Any&query=$1&Search=Search>$wp</a>";
1365        }
1366        return $wp;
1367    }
1368    
1369    sub fb_link {
1370        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1371        my($cgi,$fb) = @_;
1372    
1373        #flybase
1374    
1375        if ($fb =~ /^FB:(\S+)$/)
1376        {
1377            return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";
1378        }
1379        return $fb;
1380    }
1381    
1382    sub fborf_link {
1383        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1384        my($cgi,$fb) = @_;
1385    
1386        #flybase
1387    
1388        if ($fb =~ /^FlyBaseORFNames:(\S+)$/)
1389        {
1390            return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";
1391        }
1392        return $fb;
1393    }
1394    
1395    sub sgd_link {
1396        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1397        my($cgi,$sgd) = @_;
1398    
1399        #yeast
1400    
1401        if ($sgd =~ /^SGD_LOCUS:(\S+)$/)
1402        {
1403            return "<a href=http://db.yeastgenome.org/cgi-bin/locus.pl?locus=$1>$sgd</a>";
1404        }
1405        return $sgd;
1406    }
1407    
1408    
1409    
1410    
1411  sub set_map_links {  sub set_map_links {
1412      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1413      my($cgi,$x) = @_;      my($cgi,$x) = @_;
# Line 1002  Line 1425 
1425      return $x;      return $x;
1426  }  }
1427    
1428    
1429    
1430  sub map_link {  sub map_link {
1431      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1432      my($cgi,$map,$org) = @_;      my($cgi,$map,$org) = @_;
# Line 1041  Line 1466 
1466      if ($user)      if ($user)
1467      {      {
1468          my $esc_sub = uri_escape( $sub );          my $esc_sub = uri_escape( $sub );
1469            $sub =~ s/\_/ /g;
1470          $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>";
1471      }      }
1472      else      else
# Line 1133  Line 1559 
1559     {     {
1560          title           => "The SEED",          title           => "The SEED",
1561          description     => "Latest news from the SEED",          description     => "Latest news from the SEED",
1562          link            => &FIG::cgi_url()."/Html/rss/SEED.rss",          link            => "Html/rss/SEED.rss",
1563     },     },
1564    
1565    "SEEDsubsystems.rss" =>    "SEEDsubsystems.rss" =>
1566    {    {
1567          title           => "SEED Subsystems",          title           => "SEED Subsystems",
1568          description     => "Recently updated SEED subsystems",          description     => "Recently updated SEED subsystems",
1569          link            => &FIG::cgi_url()."/Html/rss/SEEDsubsystems.rss",          link            => "Html/rss/SEEDsubsystems.rss",
1570    },    },
1571    
1572    "SEEDsubsystems.rss" =>    "SEEDsubsystems.rss" =>

Legend:
Removed from v.1.65  
changed lines
  Added in v.1.81

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3