[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.64, Sat Oct 8 14:14:47 2005 UTC revision 1.87, Thu Feb 2 00:12:31 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 79  Line 156 
156  sub show_page {  sub show_page {
157      #warn "SHOWPAGE: cgi=", Dumper(@_);      #warn "SHOWPAGE: cgi=", Dumper(@_);
158      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
159      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie) = @_;      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie, $options) = @_;
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        #     $options is a reference to a hash of options that you can pass around the pages
175      #      #
176      # Find the HTML header      # Find the HTML header
177      #      #
# Line 110  Line 190 
190      }      }
191      else      else
192      {      {
193          @html_hdr = compute_html_header(undef,$user);          @html_hdr = compute_html_header(undef,$user,%$options);
194      }      }
195    
196      # 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 181  Line 261 
261          if ( $html->[$i] =~ /\<body[^0-9a-z]/i )          if ( $html->[$i] =~ /\<body[^0-9a-z]/i )
262          {          {
263              $body_line = $i;              $body_line = $i;
264              $last;              last;
265          }          }
266    
267          #  Now the general case.          #  Now the general case.
# Line 280  Line 360 
360    
361      if (!$css || !$css->{'Default'})      if (!$css || !$css->{'Default'})
362      {      {
363         $css->{'Default'} = &FIG::cgi_url() . "/Html/css/default.css";         $css->{'Default'} = "Html/css/default.css";
364      }      }
365      if (!$css->{"Sans Serif"})      if (!$css->{"Sans Serif"})
366      {      {
367         $css->{'Sans Serif'} = &FIG::cgi_url() . "/Html/css/sanserif.css";         $css->{'Sans Serif'} = "Html/css/sanserif.css";
368      }      }
369    
370      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 376 
376         $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";
377      }      }
378    
379      $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";
380    
381      # RAE: also added support for external javascripts here.      # RAE: also added support for external javascripts here.
382      # 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 386 
386      # it will reduce our overhead.      # it will reduce our overhead.
387    
388      # $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
389      push @$javasrc, &FIG::cgi_url() . "/Html/css/FIG.js";      push @$javasrc, "Html/css/FIG.js";
390      foreach my $script (@$javasrc) {      foreach my $script (@$javasrc) {
391          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";
392      }      }
# Line 442  Line 522 
522    
523      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";
524      my $width = defined $options{width} ? "width=\"$options{width}\"" : undef;      my $width = defined $options{width} ? "width=\"$options{width}\"" : undef;
525      push( @tab, "\n<table $border $width>\n",      my $class = defined $options{class} ? "class=\"$options{class}\"" : undef;
526        push( @tab, "\n<table $border $width $class>\n",
527                  "\t<caption><b>$title</b></caption>\n",                  "\t<caption><b>$title</b></caption>\n",
528                  "\t<tr>\n\t\t"                  "\t<tr>\n\t\t"
529                . join( "\n", map { &expand($_, "th") } @$col_hdrs )                . join( "\n", map { &expand($_, "th") } @$col_hdrs )
# Line 462  Line 543 
543      return join("",@tab);      return join("",@tab);
544  }  }
545    
546    sub abstract_coupling_table {
547        my($cgi,$prot,$coupling) = @_;
548        my %fc;
549    
550        my $col_hdrs = ["coupled to","Score","Type of Coupling", "Type-specific Data"];
551        my $tab = [];
552        my %by_peg;
553        foreach my $x (@$coupling)
554        {
555            my($peg2,$psc,$type,$extra) = @$x;
556            if (($type !~ /^[ID]FC$/) || (! $fc{$peg2}))
557            {
558                if ($type =~  /^[ID]FC$/)
559                {
560                    $fc{$peg2} = 1;
561                }
562    
563                $by_peg{$peg2} += $psc;
564            }
565        }
566    
567        foreach my $x (sort { ($by_peg{$b->[0]} <=> $by_peg{$a->[0]})
568                              or ($a->[0] cmp $b->[0])
569                              or ($b->[1] <=> $a->[1])
570                              or ($a->[2] cmp $b->[2]) } @$coupling)
571        {
572            my($peg2,$psc,$type,$extra) = @$x;
573            push(@$tab,[&fid_link($cgi,$peg2,1),$psc,$type,&set_prot_links($cgi,join(", ",@$extra))]);
574        }
575    
576    
577         my $help = "<a href=\"Html/abstract_coupling.html\" target=\"SEED_or_SPROUT_help\">for help</a>";
578    #    my @html = &make_table($col_hdrs,$tab,"Abstract Coupling Data for $prot");
579    #    push(@html,"<hr>\n",$cgi->h3($help),"<br>");
580    #    return @html;
581    
582        return &make_table($col_hdrs,$tab,"Abstract Coupling Data for $prot [$help]");
583    }
584    
585  sub expand {  sub expand {
586      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
587      my( $x, $tag ) = @_;      my( $x, $tag ) = @_;
# Line 670  Line 790 
790      my($cgi,$fid,$local,$just_url) = @_;      my($cgi,$fid,$local,$just_url) = @_;
791      my($n);      my($n);
792    
793        my $top = top_link();
794    
795      if ($fid =~ /^fig\|\d+\.\d+\.([a-z]+)\.(\d+)/)      if ($fid =~ /^fig\|\d+\.\d+\.([a-z]+)\.(\d+)/)
796      {      {
797          if ($local)          if ($local)
# Line 695  Line 817 
817             my $user = $cgi->param('user');             my $user = $cgi->param('user');
818             if (! $user) { $user = "" }             if (! $user) { $user = "" }
819             my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";             my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";
820             $link = &FIG::cgi_url . "/feature.cgi?feature=$fid&user=$user$trans$sprout";             $link = "$top/feature.cgi?feature=$fid&user=$user$trans$sprout";
821             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;
822          }          }
823          else          else
# Line 715  Line 837 
837    
838              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }
839              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";
840              $link = "protein.cgi?prot=$fid&user=$user$trans$sprout";              $link = "$top/protein.cgi?prot=$fid&user=$user$trans$sprout";
841              $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,;  
842          }          }
843          if ($just_url)          if ($just_url)
844          {          {
# Line 728  Line 846 
846          }          }
847          else          else
848          {          {
849              return "<a href=$link>$n</a>";              return "<a href='$link'>$n</a>";
850          }          }
851      }      }
852      return $fid;      return $fid;
# Line 857  Line 975 
975          $after = $3;          $after = $3;
976          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);
977      }      }
978      elsif ($x =~ /^(.*)\b([NXYZA]P_[0-9\.]+)\b(.*)/s)      elsif ($x =~ /^(.*)\b([NXYZA][PM]_[0-9\.]+)\b(.*)/s)
979      {      {
980          $before = $1;          $before = $1;
981          $match = $2;          $match = $2;
# Line 871  Line 989 
989          $after = $3;          $after = $3;
990          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);
991      }      }
992      elsif ($x =~ /^(.*)(tigr\|[0-9a-zA-Z]+)(.*)/s)      elsif ($x =~ /^(.*)(tigr\|\w+)(.*)/s)
993      {      {
994          $before = $1;          $before = $1;
995          $match = $2;          $match = $2;
996          $after = $3;          $after = $3;
997          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);
998      }      }
999        elsif ($x =~ /^(.*)\b(eric\|\S+)\b(.*)/s)
1000        {
1001            $before = $1;
1002            $match = $2;
1003            $after = $3;
1004            return &set_prot_links($cgi,$before) . &HTML::eric_link($cgi,$match) . &set_prot_links($cgi,$after);
1005        }
1006    
1007        elsif ($x =~ /^(.*)\bbhb\|.*?\b(.*)/s)
1008        {
1009            $before = $1;
1010            $match = $2;
1011            $after = $3;
1012            return &set_prot_links($cgi,$before) . &HTML::bhb_link($cgi,$match) . &set_prot_links($cgi,$after);
1013        }
1014    
1015        elsif ($x =~ /^(.*)\bapidb\|.*?\..*\b(.*)/s)
1016        {
1017            $before = $1;
1018            $match = $2;
1019            $after = $3;
1020            return &set_prot_links($cgi,$before) . &HTML::apidb_link($cgi,$match) . &set_prot_links($cgi,$after);
1021        }
1022    
1023        elsif ($x =~ /^(.*)\bpatric\|.*?\b(.*)/s)
1024        {
1025            $before = $1;
1026            $match = $2;
1027            $after = $3;
1028            return &set_prot_links($cgi,$before) . &HTML::patric_link($cgi,$match) . &set_prot_links($cgi,$after);
1029        }
1030    
1031        elsif ($x =~ /^(.*)\bvbrc\|.*?\b(.*)/s)
1032        {
1033            $before = $1;
1034            $match = $2;
1035            $after = $3;
1036            return &set_prot_links($cgi,$before) . &HTML::vbrc_link($cgi,$match) . &set_prot_links($cgi,$after);
1037        }
1038    
1039        elsif ($x =~ /^(.*)\bvectorbase\|.*?\b(.*)/s)
1040        {
1041            $before = $1;
1042            $match = $2;
1043            $after = $3;
1044            return &set_prot_links($cgi,$before) . &HTML::vectorbase_link($cgi,$match) . &set_prot_links($cgi,$after);
1045        }
1046      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)
1047      {      {
1048          $before = $1;          $before = $1;
# Line 906  Line 1071 
1071          $after = $3;          $after = $3;
1072          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);
1073      }      }
1074        elsif ($x =~ /^(.*)(Ensembl[a-zA-Z]+:[a-zA-Z_0-9\.]+)(.*)/s)
1075        {
1076            $before = $1;
1077            $match = $2;
1078            $after = $3;
1079            return &set_prot_links($cgi,$before) . &HTML::ensembl_link($cgi,$match) . &set_prot_links($cgi,$after);
1080        }
1081        elsif ($x =~ /^(.*)(EntrezGene:[a-zA-Z_0-9\.]+)(.*)/s)
1082        {
1083            $before = $1;
1084            $match = $2;
1085            $after = $3;
1086            return &set_prot_links($cgi,$before) . &HTML::entrezgene_link($cgi,$match) . &set_prot_links($cgi,$after);
1087        }
1088        elsif ($x =~ /^(.*)(MIM:[a-zA-Z_0-9\.]+)(.*)/s)
1089        {
1090            $before = $1;
1091            $match = $2;
1092            $after = $3;
1093            return &set_prot_links($cgi,$before) . &HTML::mim_link($cgi,$match) . &set_prot_links($cgi,$after);
1094        }
1095        elsif ($x =~ /^(.*)(UniGene:[a-zA-Z_0-9\.]+)(.*)/s)
1096        {
1097            $before = $1;
1098            $match = $2;
1099            $after = $3;
1100            return &set_prot_links($cgi,$before) . &HTML::unigene_link($cgi,$match) . &set_prot_links($cgi,$after);
1101        }
1102        elsif ($x =~ /^(.*)(IPI:[a-zA-Z_0-9\.]+)(.*)/s)
1103        {
1104            $before = $1;
1105            $match = $2;
1106            $after = $3;
1107            return &set_prot_links($cgi,$before) . &HTML::ipi_link($cgi,$match) . &set_prot_links($cgi,$after);
1108        }
1109        elsif ($x =~ /^(.*)(WP:[a-zA-Z_0-9\.]+)(.*)/s)
1110        {
1111            #wormbase
1112    
1113            $before = $1;
1114            $match = $2;
1115            $after = $3;
1116            return &set_prot_links($cgi,$before) . &HTML::wp_link($cgi,$match) . &set_prot_links($cgi,$after);
1117        }
1118        elsif ($x =~ /^(.*)(FB:[a-zA-Z_0-9\.]+)(.*)/s)
1119        {
1120            #flybase
1121    
1122            $before = $1;
1123            $match = $2;
1124            $after = $3;
1125            return &set_prot_links($cgi,$before) . &HTML::fb_link($cgi,$match) . &set_prot_links($cgi,$after);
1126        }
1127        elsif ($x =~ /^(.*)(FlyBaseORFNames:[a-zA-Z_0-9\.]+)(.*)/s)
1128        {
1129            #flybase
1130    
1131            $before = $1;
1132            $match = $2;
1133            $after = $3;
1134            return &set_prot_links($cgi,$before) . &HTML::fborf_link($cgi,$match) . &set_prot_links($cgi,$after);
1135        }
1136        elsif ($x =~ /^(.*)(SGD_LOCUS:[a-zA-Z_0-9\.]+)(.*)/s)
1137        {
1138            #flybase
1139    
1140            $before = $1;
1141            $match = $2;
1142            $after = $3;
1143            return &set_prot_links($cgi,$before) . &HTML::sgd_link($cgi,$match) . &set_prot_links($cgi,$after);
1144        }
1145      return $x;      return $x;
1146  }  }
1147    
# Line 917  Line 1153 
1153      {      {
1154          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>";
1155      }      }
1156        elsif ($id =~ /^[NXYZA]M_/)
1157        {
1158            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=nuccore&cmd=search&term=$id>$id</a>";
1159        }
1160  }  }
1161    
1162  sub gi_link {  sub gi_link {
# Line 934  Line 1174 
1174      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1175      my($cgi,$tigr) = @_;      my($cgi,$tigr) = @_;
1176    
1177      if ($tigr =~ /^tigr\|([0-9a-zA-Z]+)$/)      if ($tigr =~ /^tigr\|(NT|ntbp|ntbpA|BA|BMAA|BXB|GBA)(\w+)$/)
1178        {
1179            my $id=$1.$2;
1180            return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\">$tigr</a> (Pathema)";
1181        }
1182        elsif ($tigr =~ /^tigr\|(\S+)$/)
1183      {      {
1184          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>";
1185      }      }
1186      return $tigr;      return $tigr;
1187  }  }
1188    
1189    sub eric_link {
1190        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1191        my($cgi,$eric) = @_;
1192    
1193        if ($eric =~ /^eric\|(\S+)/)
1194        {
1195            return "<a href=\"https://asap.ahabs.wisc.edu/asap/feature_info.php?FeatureID=$1\">$eric</a>";
1196        }
1197        return $eric;
1198    }
1199    
1200    sub bhb_link {
1201        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1202        my($cgi,$bhb) = @_;
1203    
1204        return "<a href=\"http://www.biohealthbase.org\">$bhb</a>";
1205    }
1206    
1207    sub apidb_link {
1208        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1209        my($cgi,$api) = @_;
1210    
1211        if ($api =~ /apidb\|(.*?)\.(.*)$/)
1212        {
1213            return "<a href=\"http://www.apidb.org/cgi-bin/redirect.cgi?taxon_id=$1&source_id=$2\">$api</a>";
1214        }
1215        return $api;
1216    }
1217    
1218    sub patric_link {
1219        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1220        my($cgi,$patric) = @_;
1221    
1222        if ($patric =~ /patric\|(.*)/)
1223        {
1224            return "<a href=\"https://patric.vbi.vt.edu/software/curationTool/gep/pgiCuration.php?locus_name=$1\">$patric</a>";
1225        }
1226        return $patric;
1227    }
1228    
1229    sub vbrc_link {
1230        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1231        my($cgi,$vbrc) = @_;
1232    
1233        if ($vbrc =~ /vbrc\|(.*)/)
1234        {
1235            return "<a href=\"http://www.biovirus.org/gene_detail.asp?name=$1\">$vbrc</a>";
1236        }
1237        return $vbrc;
1238    }
1239    
1240    sub vectorbase_link {
1241        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1242        my($cgi,$vec) = @_;
1243        return "<a href=\"http://www.vectorbase.org\">$vec</a>";
1244    }
1245    
1246    
1247  sub uni_link {  sub uni_link {
1248      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1249      my($cgi,$uni) = @_;      my($cgi,$uni) = @_;
# Line 985  Line 1288 
1288      return $kegg;      return $kegg;
1289  }  }
1290    
1291    sub ensembl_link {
1292        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1293        my($cgi,$ensembl) = @_;
1294    
1295        if ($ensembl =~ /^(\S+):(\S+)$/)
1296        {
1297            my $what=$1;
1298            my $key=$2;
1299            my $idx="all";
1300            if ($what eq "EnsemblGene") { $idx = "Gene" }
1301            if ($what eq "EnsemblTranscript") { $idx = "all" }
1302            if ($what eq "EnsemblProtein") { $idx = "all" }
1303    
1304            #I really want to get right to the transcript and peptide pages, but
1305            #can't see how to do that without knowing the org name too, which
1306            #I don't know at this point. (ensembl org name, not real org name)
1307    
1308            return "<a href=http://www.ensembl.org/Homo_sapiens/textview?species=all&idx=$idx&q=$key>$ensembl</a>";
1309        }
1310        return $ensembl;
1311    }
1312    
1313    sub entrezgene_link {
1314        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1315        my($cgi,$entrezgene) = @_;
1316    
1317        if ($entrezgene =~ /^EntrezGene:(\S+)$/)
1318        {
1319            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=gene&cmd=Retrieve&dopt=full_report&list_uids=$1>$entrezgene</a>";
1320        }
1321        return $entrezgene;
1322    }
1323    
1324    sub mim_link {
1325        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1326        my($cgi,$mim) = @_;
1327    
1328        if ($mim =~ /^MIM:(\S+)$/)
1329        {
1330            return "<a href=http://www3.ncbi.nlm.nih.gov/entrez/dispomim.cgi?id=$1>$mim</a>";
1331        }
1332        return $mim;
1333    }
1334    
1335    sub unigene_link {
1336        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1337        my($cgi,$unigene) = @_;
1338    
1339        if ($unigene =~ /^UniGene:(\S+)$/)
1340        {
1341            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=unigene&cmd=search&term=$1>$unigene</a>";
1342        }
1343        return $unigene;
1344    }
1345    
1346    sub ipi_link {
1347        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1348        my($cgi,$ipi) = @_;
1349    
1350        if ($ipi =~ /^IPI:(\S+)$/)
1351        {
1352            return "<a href=http://srs.ebi.ac.uk/srsbin/cgi-bin/wgetz?-id+AEoS1R8Jnn+-e+[IPI:\'$1\']+-qnum+1+-enum+1>$ipi</a>";
1353        }
1354        return $ipi;
1355    }
1356    
1357    sub wp_link {
1358        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1359        my($cgi,$wp) = @_;
1360    
1361        #wormbase
1362    
1363        if ($wp =~ /^WP:(\S+)$/)
1364        {
1365            return "<a href=http://www.wormbase.org/db/searches/basic?class=Any&query=$1&Search=Search>$wp</a>";
1366        }
1367        return $wp;
1368    }
1369    
1370    sub fb_link {
1371        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1372        my($cgi,$fb) = @_;
1373    
1374        #flybase
1375    
1376        if ($fb =~ /^FB:(\S+)$/)
1377        {
1378            return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";
1379        }
1380        return $fb;
1381    }
1382    
1383    sub fborf_link {
1384        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1385        my($cgi,$fb) = @_;
1386    
1387        #flybase
1388    
1389        if ($fb =~ /^FlyBaseORFNames:(\S+)$/)
1390        {
1391            return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";
1392        }
1393        return $fb;
1394    }
1395    
1396    sub sgd_link {
1397        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1398        my($cgi,$sgd) = @_;
1399    
1400        #yeast
1401    
1402        if ($sgd =~ /^SGD_LOCUS:(\S+)$/)
1403        {
1404            return "<a href=http://db.yeastgenome.org/cgi-bin/locus.pl?locus=$1>$sgd</a>";
1405        }
1406        return $sgd;
1407    }
1408    
1409    
1410    
1411    
1412  sub set_map_links {  sub set_map_links {
1413      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1414      my($cgi,$x) = @_;      my($cgi,$x) = @_;
# Line 1002  Line 1426 
1426      return $x;      return $x;
1427  }  }
1428    
1429    
1430    
1431  sub map_link {  sub map_link {
1432      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1433      my($cgi,$map,$org) = @_;      my($cgi,$map,$org) = @_;
# Line 1038  Line 1464 
1464      my($sub_link);      my($sub_link);
1465    
1466      my $user = $cgi->param('user');      my $user = $cgi->param('user');
1467        my $esc_sub = uri_escape( $sub );
1468        $sub =~ s/\_/ /g;
1469      if ($user)      if ($user)
1470      {      {
         my $esc_sub = uri_escape( $sub );  
1471          $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>";
1472      }      }
1473      else      else
1474      {      {
1475          $sub_link = $sub;          $sub_link = "<a href=\"display_subsys.cgi?ssa_name=$esc_sub&request=show_ssa&sort=by_phylo\">$sub</a>";
1476      }      }
1477      return $sub_link;      return $sub_link;
1478  }  }
# Line 1104  Line 1531 
1531  title       : the title. This is usually what is seen by the user in the pull down menu  title       : the title. This is usually what is seen by the user in the pull down menu
1532  description : a more complete description that is often seen is rss viewers but not always  description : a more complete description that is often seen is rss viewers but not always
1533  link        : link to the item that was added/edited  link        : link to the item that was added/edited
1534  All other keys are treated as optional RSS arguments and written to the file. At most, 10 recent entries are stored in the rss file.  All other keys are treated as optional RSS arguments and written to the file.
1535    
1536    At most, $max_entries recent entries are stored in the rss file, and this is currently 50.
1537    
1538  RSS files are quite simple, and contain some standard header information, and then individual items surrounded by an <item> </item> tag. Note that there is also an initial title/description/link set that describes the file.  RSS files are quite simple, and contain some standard header information, and then individual items surrounded by an <item> </item> tag. Note that there is also an initial title/description/link set that describes the file.
1539    
# Line 1114  Line 1543 
1543  sub rss_feed {  sub rss_feed {
1544   shift if UNIVERSAL::isa($_[0],__PACKAGE__);   shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1545   my ($files, $args)=@_;   my ($files, $args)=@_;
1546    
1547     # how many entries to store in the file
1548     my $max_entries=50;
1549    
1550   foreach my $a (keys %$args) {if ($a =~ /^-(.*)/) {my $b=$1; $args->{$b}=$args->{$a}; delete $args->{$a}}}   foreach my $a (keys %$args) {if ($a =~ /^-(.*)/) {my $b=$1; $args->{$b}=$args->{$a}; delete $args->{$a}}}
1551    
1552   my $filepath=$FIG_Config::fig."/CGI/Html/rss";   my $filepath=$FIG_Config::fig."/CGI/Html/rss";
# Line 1127  Line 1560 
1560     {     {
1561          title           => "The SEED",          title           => "The SEED",
1562          description     => "Latest news from the SEED",          description     => "Latest news from the SEED",
1563          link            => &FIG::cgi_url()."/Html/rss/SEED.rss",          link            => "Html/rss/SEED.rss",
1564     },     },
1565    
1566    "SEEDsubsystems.rss" =>    "SEEDsubsystems.rss" =>
1567    {    {
1568          title           => "SEED Subsystems",          title           => "SEED Subsystems",
1569          description     => "Recently updated SEED subsystems",          description     => "Recently updated SEED subsystems",
1570          link            => &FIG::cgi_url()."/Html/rss/SEEDsubsystems.rss",          link            => "Html/rss/SEEDsubsystems.rss",
1571    },    },
1572    
1573    "SEEDsubsystems.rss" =>    "SEEDsubsystems.rss" =>
# Line 1159  Line 1592 
1592    if ($qw eq "link")    if ($qw eq "link")
1593    {    {
1594     $args->{$qw} =~ /^(.*?\.cgi.)(.*)$/;     $args->{$qw} =~ /^(.*?\.cgi.)(.*)$/;
    print STDERR "Got ->>$1<<- and ->>$2<<-\n";  
1595     $args->{$qw} = $1.uri_escape($2) if ($1 && $2);     $args->{$qw} = $1.uri_escape($2) if ($1 && $2);
1596    }    }
1597    
# Line 1193  Line 1625 
1625       $itemcount++;       $itemcount++;
1626       $initem=1;       $initem=1;
1627      }      }
1628      if (/\<\/item\>/) {$initem=0; next if ($itemcount > 9)}      if (/\<\/item\>/) {$initem=0; next if ($itemcount > $max_entries)}
1629      next if ($initem && $itemcount > 9);      next if ($initem && $itemcount > $max_entries);
1630      push @out, $_;      push @out, $_;
1631     }     }
1632     close IN;     close IN;

Legend:
Removed from v.1.64  
changed lines
  Added in v.1.87

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3