[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.91, Wed May 17 17:50:38 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 11  Line 28 
28  use HTTP::Request::Common;  use HTTP::Request::Common;
29  use POSIX;  use POSIX;
30    
31    use raelib; # now used for the excel function, that should eventually end up in here. Way too experimental!
32    my $raelib=new raelib;
33    
34    
35    my $top_link_cache;
36    
37    
38  sub new  sub new
39  {  {
# Line 21  Line 44 
44      return bless $self, $class;      return bless $self, $class;
45  }  }
46    
47    sub top_link
48    {
49    
50        #
51        # Determine if this is a toplevel cgi or one in one of the subdirs (currently
52        # just /p2p).
53        #
54    
55        return $top_link_cache if ($top_link_cache);
56    
57        my @parts = split(/\//, $ENV{SCRIPT_NAME});
58        my $top;
59        if ($parts[-2] eq 'FIG')
60        {
61            $top = '.';
62    #       warn "toplevel @parts\n";
63        }
64        elsif ($parts[-3] eq 'FIG')
65        {
66            $top = '..';
67    #       warn "subdir @parts\n";
68        }
69        else
70        {
71            $top = $FIG_Config::cgi_base;
72    #       warn "other @parts\n";
73        }
74    
75        $top_link_cache = $top;
76        return $top;
77    }
78    
79  sub compute_html_header  sub compute_html_header
80  {  {
81      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
82      my($additional_insert, $user, %options ) = @_;      my($additional_insert, $user, %options ) = @_;
83    
84        local $/ = "\n";
85    
86      my $header_name = $options{header_name} ? $options{header_name} : "html.hdr";      my $header_name = $options{header_name} ? $options{header_name} : "html.hdr";
87      my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";      my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";
88    
# Line 36  Line 93 
93      }      }
94      my @html_hdr = &FIG::file_read($html_hdr_file);      my @html_hdr = &FIG::file_read($html_hdr_file);
95    
96      $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"; }
97    
98        #
99        # Determine if this is a toplevel cgi or one in one of the subdirs (currently
100        # just /p2p).
101        #
102    
103        my @parts = split(/\//, $ENV{SCRIPT_NAME});
104        my $top;
105        if ($parts[-2] eq 'FIG')
106        {
107            $top = '.';
108    #       warn "toplevel @parts\n";
109        }
110        elsif ($parts[-3] eq 'FIG')
111        {
112            $top = '..';
113    #       warn "subdir @parts\n";
114        }
115        else
116        {
117            $top = $FIG_Config::cgi_base;
118    #       warn "other @parts\n";
119        }
120    
121        $options{no_fig_search} or push( @html_hdr, "<br><a href=\"$top/index.cgi?user=$user\">FIG search</a>\n" );
122    
123      if (@html_hdr)      if (@html_hdr)
124      {      {
# Line 64  Line 146 
146    
147          for $_ (@html_hdr)          for $_ (@html_hdr)
148          {          {
149              s,(href|img\s+src)="/FIG/,\1="$FIG_Config::cgi_base,g;              s,(href|img\s+src)="/FIG/,$1="$top/,g;
150              s,(\?user\=)\",$1$user",;              s,(\?user\=)\",$1$user",;
151              if ($_ eq "<!-- HEADER_INSERT -->\n")              if ($_ eq "<!-- HEADER_INSERT -->\n")
152              {              {
# Line 79  Line 161 
161  sub show_page {  sub show_page {
162      #warn "SHOWPAGE: cgi=", Dumper(@_);      #warn "SHOWPAGE: cgi=", Dumper(@_);
163      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
164      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie) = @_;      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie, $options) = @_;
165      my $i;      my $i;
166    
167        my $top = top_link();
168    
169      # ARGUMENTS:      # ARGUMENTS:
170      #     $cgi is the CGI method      #     $cgi is the CGI method
171      #     $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 174 
174      #     $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
175      #               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
176      #               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
177      #     $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")
178      #     $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
179        #     $options is a reference to a hash of options that you can pass around the pages
180      #      #
181      # Find the HTML header      # Find the HTML header
182      #      #
# Line 110  Line 195 
195      }      }
196      else      else
197      {      {
198          @html_hdr = compute_html_header(undef,$user);          @html_hdr = compute_html_header(undef,$user,%$options);
199      }      }
200    
201      # 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 266 
266          if ( $html->[$i] =~ /\<body[^0-9a-z]/i )          if ( $html->[$i] =~ /\<body[^0-9a-z]/i )
267          {          {
268              $body_line = $i;              $body_line = $i;
269              $last;              last;
270          }          }
271    
272          #  Now the general case.          #  Now the general case.
# Line 280  Line 365 
365    
366      if (!$css || !$css->{'Default'})      if (!$css || !$css->{'Default'})
367      {      {
368         $css->{'Default'} = &FIG::cgi_url() . "/Html/css/default.css";         $css->{'Default'} = "Html/css/default.css";
369      }      }
370      if (!$css->{"Sans Serif"})      if (!$css->{"Sans Serif"})
371      {      {
372         $css->{'Sans Serif'} = &FIG::cgi_url() . "/Html/css/sanserif.css";         $css->{'Sans Serif'} = "Html/css/sanserif.css";
373      }      }
374    
375      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 381 
381         $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";
382      }      }
383    
384      $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";
385    
386      # RAE: also added support for external javascripts here.      # RAE: also added support for external javascripts here.
387      # 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 391 
391      # it will reduce our overhead.      # it will reduce our overhead.
392    
393      # $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
394      push @$javasrc, &FIG::cgi_url() . "/Html/css/FIG.js";      push @$javasrc, "Html/css/FIG.js";
395      foreach my $script (@$javasrc) {      foreach my $script (@$javasrc) {
396          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";
397      }      }
# Line 436  Line 521 
521    
522  }  }
523    
524    
525    =head1 make_table
526    
527    The main method to convert an array into a table.
528    
529    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.
530    
531    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.
532    
533    =cut
534    
535  sub make_table {  sub make_table {
536      my($col_hdrs,$tab,$title, %options ) = @_;      my($col_hdrs,$tab,$title, %options ) = @_;
537      my(@tab);      my(@tab);
538    
539      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";
540      my $width = defined $options{width} ? "width=\"$options{width}\"" : undef;      my $width = defined $options{width} ? "width=\"$options{width}\"" : undef;
541      push( @tab, "\n<table $border $width>\n",      my $class = defined $options{class} ? "class=\"$options{class}\"" : undef;
542        push( @tab, "\n<table $border $width $class>\n",
543                  "\t<caption><b>$title</b></caption>\n",                  "\t<caption><b>$title</b></caption>\n",
544                  "\t<tr>\n\t\t"                  "\t<tr>\n\t\t"
545                . join( "\n", map { &expand($_, "th") } @$col_hdrs )                . join( "\n", map { &expand($_, "th") } @$col_hdrs )
# Line 459  Line 556 
556              );              );
557      }      }
558      push(@tab,"</table>\n");      push(@tab,"</table>\n");
559    
560        # excelfile should be appropriate for a filename (no spaces/special characters)
561        if (defined $options{"excelfile"}) {push @tab, $raelib->tab2excel($col_hdrs,$tab,$title,\%options,$options{"excelfile"})}
562    
563      return join("",@tab);      return join("",@tab);
564  }  }
565    
566    sub abstract_coupling_table {
567        my($cgi,$prot,$coupling) = @_;
568        my %fc;
569    
570        my $col_hdrs = ["coupled to","Score","Type of Coupling", "Type-specific Data"];
571        my $tab = [];
572        my %by_peg;
573        foreach my $x (@$coupling)
574        {
575            my($peg2,$psc,$type,$extra) = @$x;
576            if (($type !~ /^[ID]FC$/) || (! $fc{$peg2}))
577            {
578                if ($type =~  /^[ID]FC$/)
579                {
580                    $fc{$peg2} = 1;
581                }
582    
583                $by_peg{$peg2} += $psc;
584            }
585        }
586    
587        foreach my $x (sort { ($by_peg{$b->[0]} <=> $by_peg{$a->[0]})
588                              or ($a->[0] cmp $b->[0])
589                              or ($b->[1] <=> $a->[1])
590                              or ($a->[2] cmp $b->[2]) } @$coupling)
591        {
592            my($peg2,$psc,$type,$extra) = @$x;
593            push(@$tab,[&fid_link($cgi,$peg2,1),$psc,$type,&set_prot_links($cgi,join(", ",@$extra))]);
594        }
595    
596    
597         my $help = "<a href=\"Html/abstract_coupling.html\" target=\"SEED_or_SPROUT_help\">for help</a>";
598    #    my @html = &make_table($col_hdrs,$tab,"Abstract Coupling Data for $prot");
599    #    push(@html,"<hr>\n",$cgi->h3($help),"<br>");
600    #    return @html;
601    
602        return &make_table($col_hdrs,$tab,"Abstract Coupling Data for $prot [$help]");
603    }
604    
605  sub expand {  sub expand {
606      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
607      my( $x, $tag ) = @_;      my( $x, $tag ) = @_;
# Line 670  Line 810 
810      my($cgi,$fid,$local,$just_url) = @_;      my($cgi,$fid,$local,$just_url) = @_;
811      my($n);      my($n);
812    
813        my $top = top_link();
814    
815      if ($fid =~ /^fig\|\d+\.\d+\.([a-z]+)\.(\d+)/)      if ($fid =~ /^fig\|\d+\.\d+\.([a-z]+)\.(\d+)/)
816      {      {
817          if ($local)          if ($local)
# Line 695  Line 837 
837             my $user = $cgi->param('user');             my $user = $cgi->param('user');
838             if (! $user) { $user = "" }             if (! $user) { $user = "" }
839             my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";             my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";
840             $link = &FIG::cgi_url . "/feature.cgi?feature=$fid&user=$user$trans$sprout";             $link = "$top/feature.cgi?feature=$fid&user=$user$trans$sprout";
841             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;
842          }          }
843          else          else
# Line 715  Line 857 
857    
858              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }
859              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";
860              $link = "protein.cgi?prot=$fid&user=$user$trans$sprout";              $link = "$top/protein.cgi?prot=$fid&user=$user$trans$sprout";
861              $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,;  
862          }          }
863          if ($just_url)          if ($just_url)
864          {          {
# Line 728  Line 866 
866          }          }
867          else          else
868          {          {
869              return "<a href=$link>$n</a>";              return "<a href='$link'>$n</a>";
870          }          }
871      }      }
872      return $fid;      return $fid;
# Line 857  Line 995 
995          $after = $3;          $after = $3;
996          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);
997      }      }
998      elsif ($x =~ /^(.*)\b([NXYZA]P_[0-9\.]+)\b(.*)/s)      elsif ($x =~ /^(.*)\b([NXYZA][PM]_[0-9\.]+)\b(.*)/s)
999      {      {
1000          $before = $1;          $before = $1;
1001          $match = $2;          $match = $2;
# Line 871  Line 1009 
1009          $after = $3;          $after = $3;
1010          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);
1011      }      }
1012      elsif ($x =~ /^(.*)(tigr\|[0-9a-zA-Z]+)(.*)/s)      elsif ($x =~ /^(.*)(tigr\|\w+)(.*)/s)
1013      {      {
1014          $before = $1;          $before = $1;
1015          $match = $2;          $match = $2;
1016          $after = $3;          $after = $3;
1017          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);
1018      }      }
1019        elsif ($x =~ /^(.*)\b(eric\|\S+)\b(.*)/s)
1020        {
1021            $before = $1;
1022            $match = $2;
1023            $after = $3;
1024            return &set_prot_links($cgi,$before) . &HTML::eric_link($cgi,$match) . &set_prot_links($cgi,$after);
1025        }
1026    
1027        elsif ($x =~ /^(.*)\bbhb\|.*?\b(.*)/s)
1028        {
1029            $before = $1;
1030            $match = $2;
1031            $after = $3;
1032            return &set_prot_links($cgi,$before) . &HTML::bhb_link($cgi,$match) . &set_prot_links($cgi,$after);
1033        }
1034    
1035        elsif ($x =~ /^(.*)\bapidb\|.*?\..*\b(.*)/s)
1036        {
1037            $before = $1;
1038            $match = $2;
1039            $after = $3;
1040            return &set_prot_links($cgi,$before) . &HTML::apidb_link($cgi,$match) . &set_prot_links($cgi,$after);
1041        }
1042    
1043        elsif ($x =~ /^(.*)\bpatric\|.*?\b(.*)/s)
1044        {
1045            $before = $1;
1046            $match = $2;
1047            $after = $3;
1048            return &set_prot_links($cgi,$before) . &HTML::patric_link($cgi,$match) . &set_prot_links($cgi,$after);
1049        }
1050    
1051        elsif ($x =~ /^(.*)\bvbrc\|.*?\b(.*)/s)
1052        {
1053            $before = $1;
1054            $match = $2;
1055            $after = $3;
1056            return &set_prot_links($cgi,$before) . &HTML::vbrc_link($cgi,$match) . &set_prot_links($cgi,$after);
1057        }
1058    
1059        elsif ($x =~ /^(.*)\bvectorbase\|.*?\b(.*)/s)
1060        {
1061            $before = $1;
1062            $match = $2;
1063            $after = $3;
1064            return &set_prot_links($cgi,$before) . &HTML::vectorbase_link($cgi,$match) . &set_prot_links($cgi,$after);
1065        }
1066      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)
1067      {      {
1068          $before = $1;          $before = $1;
# Line 906  Line 1091 
1091          $after = $3;          $after = $3;
1092          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);
1093      }      }
1094        elsif ($x =~ /^(.*)(Ensembl[a-zA-Z]+:[a-zA-Z_0-9\.]+)(.*)/s)
1095        {
1096            $before = $1;
1097            $match = $2;
1098            $after = $3;
1099            return &set_prot_links($cgi,$before) . &HTML::ensembl_link($cgi,$match) . &set_prot_links($cgi,$after);
1100        }
1101        elsif ($x =~ /^(.*)(EntrezGene:[a-zA-Z_0-9\.]+)(.*)/s)
1102        {
1103            $before = $1;
1104            $match = $2;
1105            $after = $3;
1106            return &set_prot_links($cgi,$before) . &HTML::entrezgene_link($cgi,$match) . &set_prot_links($cgi,$after);
1107        }
1108        elsif ($x =~ /^(.*)(MIM:[a-zA-Z_0-9\.]+)(.*)/s)
1109        {
1110            $before = $1;
1111            $match = $2;
1112            $after = $3;
1113            return &set_prot_links($cgi,$before) . &HTML::mim_link($cgi,$match) . &set_prot_links($cgi,$after);
1114        }
1115        elsif ($x =~ /^(.*)(HGNC:[a-zA-Z_0-9\.]+)(.*)/s)
1116        {
1117            $before = $1;
1118            $match = $2;
1119            $after = $3;
1120            return &set_prot_links($cgi,$before) . &HTML::hgnc_link($cgi,$match) . &set_prot_links($cgi,$after);
1121        }
1122        elsif ($x =~ /^(.*)(UniGene:[a-zA-Z_0-9\.]+)(.*)/s)
1123        {
1124            $before = $1;
1125            $match = $2;
1126            $after = $3;
1127            return &set_prot_links($cgi,$before) . &HTML::unigene_link($cgi,$match) . &set_prot_links($cgi,$after);
1128        }
1129    # IPI stopped working. turn off for now.
1130    #    elsif ($x =~ /^(.*)(IPI:[a-zA-Z_0-9\.]+)(.*)/s)
1131    #    {
1132    #        $before = $1;
1133    #        $match = $2;
1134    #        $after = $3;
1135    #        return &set_prot_links($cgi,$before) . &HTML::ipi_link($cgi,$match) . &set_prot_links($cgi,$after);
1136    #    }
1137        elsif ($x =~ /^(.*)(WP:[a-zA-Z_0-9\.]+)(.*)/s)
1138        {
1139            #wormbase
1140    
1141            $before = $1;
1142            $match = $2;
1143            $after = $3;
1144            return &set_prot_links($cgi,$before) . &HTML::wp_link($cgi,$match) . &set_prot_links($cgi,$after);
1145        }
1146        elsif ($x =~ /^(.*)(FB:[a-zA-Z_0-9\.]+)(.*)/s)
1147        {
1148            #flybase
1149    
1150            $before = $1;
1151            $match = $2;
1152            $after = $3;
1153            return &set_prot_links($cgi,$before) . &HTML::fb_link($cgi,$match) . &set_prot_links($cgi,$after);
1154        }
1155        elsif ($x =~ /^(.*)(FlyBaseORFNames:[a-zA-Z_0-9\.]+)(.*)/s)
1156        {
1157            #flybase
1158    
1159            $before = $1;
1160            $match = $2;
1161            $after = $3;
1162            return &set_prot_links($cgi,$before) . &HTML::fborf_link($cgi,$match) . &set_prot_links($cgi,$after);
1163        }
1164        elsif ($x =~ /^(.*)(SGD_LOCUS:[a-zA-Z_0-9\.]+)(.*)/s)
1165        {
1166            #flybase
1167    
1168            $before = $1;
1169            $match = $2;
1170            $after = $3;
1171            return &set_prot_links($cgi,$before) . &HTML::sgd_link($cgi,$match) . &set_prot_links($cgi,$after);
1172        }
1173      return $x;      return $x;
1174  }  }
1175    
# Line 917  Line 1181 
1181      {      {
1182          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>";
1183      }      }
1184        elsif ($id =~ /^[NXYZA]M_/)
1185        {
1186            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=nuccore&cmd=search&term=$id>$id</a>";
1187        }
1188  }  }
1189    
1190  sub gi_link {  sub gi_link {
# Line 934  Line 1202 
1202      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1203      my($cgi,$tigr) = @_;      my($cgi,$tigr) = @_;
1204    
1205      if ($tigr =~ /^tigr\|([0-9a-zA-Z]+)$/)      if ($tigr =~ /^tigr\|(NT|ntbp|ntbpA|BA|BMAA|BXB|GBA)(\w+)$/)
1206      {      {
1207          return "<a href=\"http://pathema.tigr.org/tigr-scripts/CMR/GenePage.cgi?locus=$1\">$tigr</a>";          my $id=$1.$2;
1208            return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\">$tigr</a> (Pathema)";
1209        }
1210        elsif ($tigr =~ /^tigr\|(\S+)$/)
1211        {
1212            return "<a href=\"http://www.tigr.org/tigr-scripts/CMR2/GenePage.spl?locus=$1\">$tigr</a>";
1213      }      }
1214      return $tigr;      return $tigr;
1215  }  }
1216    
1217    sub eric_link {
1218        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1219        my($cgi,$eric) = @_;
1220    
1221        if ($eric =~ /^eric\|(\S+)/)
1222        {
1223            return "<a href=\"https://asap.ahabs.wisc.edu/asap/feature_info.php?FeatureID=$1\">$eric</a>";
1224        }
1225        return $eric;
1226    }
1227    
1228    sub bhb_link {
1229        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1230        my($cgi,$bhb) = @_;
1231    
1232        return "<a href=\"http://www.biohealthbase.org\">$bhb</a>";
1233    }
1234    
1235    sub apidb_link {
1236        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1237        my($cgi,$api) = @_;
1238    
1239        if ($api =~ /apidb\|(.*?)\.(.*)$/)
1240        {
1241            return "<a href=\"http://www.apidb.org/cgi-bin/redirect.cgi?taxon_id=$1&source_id=$2\">$api</a>";
1242        }
1243        return $api;
1244    }
1245    
1246    sub patric_link {
1247        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1248        my($cgi,$patric) = @_;
1249    
1250        if ($patric =~ /patric\|(.*)/)
1251        {
1252            return "<a href=\"https://patric.vbi.vt.edu/software/curationTool/gep/pgiCuration.php?locus_name=$1\">$patric</a>";
1253        }
1254        return $patric;
1255    }
1256    
1257    sub vbrc_link {
1258        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1259        my($cgi,$vbrc) = @_;
1260    
1261        if ($vbrc =~ /vbrc\|(.*)/)
1262        {
1263            return "<a href=\"http://www.biovirus.org/gene_detail.asp?name=$1\">$vbrc</a>";
1264        }
1265        return $vbrc;
1266    }
1267    
1268    sub vectorbase_link {
1269        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1270        my($cgi,$vec) = @_;
1271        return "<a href=\"http://www.vectorbase.org\">$vec</a>";
1272    }
1273    
1274    
1275  sub uni_link {  sub uni_link {
1276      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1277      my($cgi,$uni) = @_;      my($cgi,$uni) = @_;
1278    
1279      if ($uni =~ /^uni\|(\S+)$/)      if ($uni =~ /^uni\|(\S+)$/)
1280      {      {
1281          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>";
1282            return "<a href='http://www.ebi.uniprot.org/uniprot-srv/uniProtView.do?proteinAc=$1'>$uni</a>";
1283      }      }
1284      return $uni;      return $uni;
1285  }  }
# Line 985  Line 1317 
1317      return $kegg;      return $kegg;
1318  }  }
1319    
1320    sub ensembl_link {
1321        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1322        my($cgi,$ensembl) = @_;
1323    
1324        if ($ensembl =~ /^(\S+):(\S+)$/)
1325        {
1326            my $what=$1;
1327            my $key=$2;
1328            my $idx="All";
1329            if ($what eq "EnsemblGene") { $idx = "Gene" }
1330            if ($what eq "EnsemblTranscript") { $idx = "All" }
1331            if ($what eq "EnsemblProtein") { $idx = "All" }
1332    
1333            #I really want to get right to the transcript and peptide pages, but
1334            #can't see how to do that without knowing the org name too, which
1335            #I don't know at this point. (ensembl org name, not real org name)
1336    
1337            return "<a href=http://www.ensembl.org/Homo_sapiens/searchview?species=all&idx=$idx&q=$key>$ensembl</a>";
1338        }
1339        return $ensembl;
1340    }
1341    
1342    sub entrezgene_link {
1343        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1344        my($cgi,$entrezgene) = @_;
1345    
1346        if ($entrezgene =~ /^EntrezGene:(\S+)$/)
1347        {
1348            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=gene&cmd=Retrieve&dopt=full_report&list_uids=$1>$entrezgene</a>";
1349        }
1350        return $entrezgene;
1351    }
1352    
1353    sub mim_link {
1354        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1355        my($cgi,$mim) = @_;
1356    
1357        if ($mim =~ /^MIM:(\S+)$/)
1358        {
1359            return "<a href=http://www3.ncbi.nlm.nih.gov/entrez/dispomim.cgi?id=$1>$mim</a>";
1360        }
1361        return $mim;
1362    }
1363    
1364    sub hgnc_link {
1365        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1366        my($cgi,$hgnc) = @_;
1367    
1368        if ($hgnc =~ /^HGNC:(\S+)$/)
1369        {
1370            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>$hgnc</a>";
1371        }
1372        return $mim;
1373    }
1374    
1375    sub unigene_link {
1376        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1377        my($cgi,$unigene) = @_;
1378    
1379        if ($unigene =~ /^UniGene:(\S+)$/)
1380        {
1381            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=unigene&cmd=search&term=$1>$unigene</a>";
1382        }
1383        return $unigene;
1384    }
1385    
1386    sub ipi_link {
1387        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1388        my($cgi,$ipi) = @_;
1389    
1390        if ($ipi =~ /^IPI:(\S+)$/)
1391        {
1392            return "<a href=http://srs.ebi.ac.uk/srsbin/cgi-bin/wgetz?-id+AEoS1R8Jnn+-e+[IPI:\'$1\']+-qnum+1+-enum+1>$ipi</a>";
1393        }
1394        return $ipi;
1395    }
1396    
1397    sub wp_link {
1398        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1399        my($cgi,$wp) = @_;
1400    
1401        #wormbase
1402    
1403        if ($wp =~ /^WP:(\S+)$/)
1404        {
1405            return "<a href=http://www.wormbase.org/db/searches/basic?class=Any&query=$1&Search=Search>$wp</a>";
1406        }
1407        return $wp;
1408    }
1409    
1410    sub fb_link {
1411        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1412        my($cgi,$fb) = @_;
1413    
1414        #flybase
1415    
1416        if ($fb =~ /^FB:(\S+)$/)
1417        {
1418            return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";
1419        }
1420        return $fb;
1421    }
1422    
1423    sub fborf_link {
1424        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1425        my($cgi,$fb) = @_;
1426    
1427        #flybase
1428    
1429        if ($fb =~ /^FlyBaseORFNames:(\S+)$/)
1430        {
1431            return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";
1432        }
1433        return $fb;
1434    }
1435    
1436    sub sgd_link {
1437        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1438        my($cgi,$sgd) = @_;
1439    
1440        #yeast
1441    
1442        if ($sgd =~ /^SGD_LOCUS:(\S+)$/)
1443        {
1444            return "<a href=http://db.yeastgenome.org/cgi-bin/locus.pl?locus=$1>$sgd</a>";
1445        }
1446        return $sgd;
1447    }
1448    
1449    
1450    
1451    
1452  sub set_map_links {  sub set_map_links {
1453      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1454      my($cgi,$x) = @_;      my($cgi,$x) = @_;
# Line 1002  Line 1466 
1466      return $x;      return $x;
1467  }  }
1468    
1469    
1470    
1471  sub map_link {  sub map_link {
1472      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1473      my($cgi,$map,$org) = @_;      my($cgi,$map,$org) = @_;
# Line 1038  Line 1504 
1504      my($sub_link);      my($sub_link);
1505    
1506      my $user = $cgi->param('user');      my $user = $cgi->param('user');
1507        my $esc_sub = uri_escape( $sub );
1508        $sub =~ s/\_/ /g;
1509      if ($user)      if ($user)
1510      {      {
         my $esc_sub = uri_escape( $sub );  
1511          $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>";
1512      }      }
1513      else      else
1514      {      {
1515          $sub_link = $sub;          $sub_link = "<a href=\"display_subsys.cgi?ssa_name=$esc_sub&request=show_ssa&sort=by_phylo\">$sub</a>";
1516      }      }
1517      return $sub_link;      return $sub_link;
1518  }  }
# Line 1104  Line 1571 
1571  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
1572  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
1573  link        : link to the item that was added/edited  link        : link to the item that was added/edited
1574  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.
1575    
1576    At most, $max_entries recent entries are stored in the rss file, and this is currently 50.
1577    
1578  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.
1579    
# Line 1114  Line 1583 
1583  sub rss_feed {  sub rss_feed {
1584   shift if UNIVERSAL::isa($_[0],__PACKAGE__);   shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1585   my ($files, $args)=@_;   my ($files, $args)=@_;
1586    
1587     # how many entries to store in the file
1588     my $max_entries=50;
1589    
1590   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}}}
1591    
1592   my $filepath=$FIG_Config::fig."/CGI/Html/rss";   my $filepath=$FIG_Config::fig."/CGI/Html/rss";
# Line 1127  Line 1600 
1600     {     {
1601          title           => "The SEED",          title           => "The SEED",
1602          description     => "Latest news from the SEED",          description     => "Latest news from the SEED",
1603          link            => &FIG::cgi_url()."/Html/rss/SEED.rss",          link            => "Html/rss/SEED.rss",
1604     },     },
1605    
1606    "SEEDsubsystems.rss" =>    "SEEDsubsystems.rss" =>
1607    {    {
1608          title           => "SEED Subsystems",          title           => "SEED Subsystems",
1609          description     => "Recently updated SEED subsystems",          description     => "Recently updated SEED subsystems",
1610          link            => &FIG::cgi_url()."/Html/rss/SEEDsubsystems.rss",          link            => "Html/rss/SEEDsubsystems.rss",
1611    },    },
1612    
1613    "SEEDsubsystems.rss" =>    "SEEDsubsystems.rss" =>
# Line 1159  Line 1632 
1632    if ($qw eq "link")    if ($qw eq "link")
1633    {    {
1634     $args->{$qw} =~ /^(.*?\.cgi.)(.*)$/;     $args->{$qw} =~ /^(.*?\.cgi.)(.*)$/;
    print STDERR "Got ->>$1<<- and ->>$2<<-\n";  
1635     $args->{$qw} = $1.uri_escape($2) if ($1 && $2);     $args->{$qw} = $1.uri_escape($2) if ($1 && $2);
1636    }    }
1637    
# Line 1193  Line 1665 
1665       $itemcount++;       $itemcount++;
1666       $initem=1;       $initem=1;
1667      }      }
1668      if (/\<\/item\>/) {$initem=0; next if ($itemcount > 9)}      if (/\<\/item\>/) {$initem=0; next if ($itemcount > $max_entries)}
1669      next if ($initem && $itemcount > 9);      next if ($initem && $itemcount > $max_entries);
1670      push @out, $_;      push @out, $_;
1671     }     }
1672     close IN;     close IN;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3