[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.96, Wed Jul 19 15:41:47 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 689  Line 831 
831          }          }
832    
833          my $link;          my $link;
834            my $new_framework = $cgi->param('new_framework') ? 1 : 0;
835          #added to format prophage and path island links to feature.cgi          #added to format prophage and path island links to feature.cgi
836          if ($1 ne "peg")          if ($1 ne "peg")
837          {          {
838             my $user = $cgi->param('user');             my $user = $cgi->param('user');
839             if (! $user) { $user = "" }             if (! $user) { $user = "" }
840             my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";             my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";
841             $link = &FIG::cgi_url . "/feature.cgi?feature=$fid&user=$user$trans$sprout";             $link = "$top/feature.cgi?feature=$fid&user=$user$trans$sprout";
842             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;
843          }          }
844          else          else
# Line 715  Line 858 
858    
859              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }
860              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";
861              $link = "protein.cgi?prot=$fid&user=$user$trans$sprout";              $link = "$top/protein.cgi?prot=$fid&user=$user$trans$sprout\&new_framework=$new_framework";
862              $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,;  
863          }          }
864          if ($just_url)          if ($just_url)
865          {          {
# Line 728  Line 867 
867          }          }
868          else          else
869          {          {
870              return "<a href=$link>$n</a>";              return "<a href='$link'>$n</a>";
871          }          }
872      }      }
873      return $fid;      return $fid;
# Line 760  Line 899 
899          my $response = $ua->request($request);          my $response = $ua->request($request);
900          $out = $response->content;          $out = $response->content;
901      }      }
902      else  
903        if ($type =~/get/i)
904      {      {
905          @args = ();          @args = ();
906          foreach $x (@$kv_pairs)          foreach $x (@$kv_pairs)
# Line 857  Line 997 
997          $after = $3;          $after = $3;
998          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);
999      }      }
1000      elsif ($x =~ /^(.*)\b([NXYZA]P_[0-9\.]+)\b(.*)/s)      elsif ($x =~ /^(.*)\b([NXYZA][PM]_[0-9\.]+)\b(.*)/s)
1001      {      {
1002          $before = $1;          $before = $1;
1003          $match = $2;          $match = $2;
# Line 871  Line 1011 
1011          $after = $3;          $after = $3;
1012          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);
1013      }      }
1014      elsif ($x =~ /^(.*)(tigr\|[0-9a-zA-Z]+)(.*)/s)      elsif ($x =~ /^(.*)(tigr\|\w+)(.*)/s)
1015      {      {
1016          $before = $1;          $before = $1;
1017          $match = $2;          $match = $2;
1018          $after = $3;          $after = $3;
1019          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);
1020      }      }
1021        elsif ($x =~ /^(.*)\b(eric\|\S+)\b(.*)/s)
1022        {
1023            $before = $1;
1024            $match = $2;
1025            $after = $3;
1026            return &set_prot_links($cgi,$before) . &HTML::eric_link($cgi,$match) . &set_prot_links($cgi,$after);
1027        }
1028    
1029        elsif ($x =~ /^(.*)\b(bhb\|.*?)\b(.*)/s)
1030        {
1031            $before = $1;
1032            $match = $2;
1033            $after = $3;
1034            return &set_prot_links($cgi,$before) . &HTML::bhb_link($cgi,$match) . &set_prot_links($cgi,$after);
1035        }
1036    
1037        elsif ($x =~ /^(.*)\b(apidb\|[0-9\.a-z_]+)\b(.*)/s)
1038        {
1039            $before = $1;
1040            $match = $2;
1041            $after = $3;
1042            return &set_prot_links($cgi,$before) . &HTML::apidb_link($cgi,$match) . &set_prot_links($cgi,$after);
1043        }
1044    
1045        elsif ($x =~ /^(.*)\b(patric\|.*?)\b(.*)/s)
1046        {
1047            $before = $1;
1048            $match = $2;
1049            $after = $3;
1050            return &set_prot_links($cgi,$before) . &HTML::patric_link($cgi,$match) . &set_prot_links($cgi,$after);
1051        }
1052    
1053        elsif ($x =~ /^(.*)\b(vbrc\|.*?)\b(.*)/s)
1054        {
1055            $before = $1;
1056            $match = $2;
1057            $after = $3;
1058            return &set_prot_links($cgi,$before) . &HTML::vbrc_link($cgi,$match) . &set_prot_links($cgi,$after);
1059        }
1060    
1061        elsif ($x =~ /^(.*)\b(vectorbase\|.*?)\b(.*)/s)
1062        {
1063            $before = $1;
1064            $match = $2;
1065            $after = $3;
1066            return &set_prot_links($cgi,$before) . &HTML::vectorbase_link($cgi,$match) . &set_prot_links($cgi,$after);
1067        }
1068      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)
1069      {      {
1070          $before = $1;          $before = $1;
# Line 906  Line 1093 
1093          $after = $3;          $after = $3;
1094          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);
1095      }      }
1096        elsif ($x =~ /^(.*)(Ensembl[a-zA-Z]+:[a-zA-Z_0-9\.]+)(.*)/s)
1097        {
1098            $before = $1;
1099            $match = $2;
1100            $after = $3;
1101            return &set_prot_links($cgi,$before) . &HTML::ensembl_link($cgi,$match) . &set_prot_links($cgi,$after);
1102        }
1103        elsif ($x =~ /^(.*)(EntrezGene:[a-zA-Z_0-9\.]+)(.*)/s)
1104        {
1105            $before = $1;
1106            $match = $2;
1107            $after = $3;
1108            return &set_prot_links($cgi,$before) . &HTML::entrezgene_link($cgi,$match) . &set_prot_links($cgi,$after);
1109        }
1110        elsif ($x =~ /^(.*)(MIM:[a-zA-Z_0-9\.]+)(.*)/s)
1111        {
1112            $before = $1;
1113            $match = $2;
1114            $after = $3;
1115            return &set_prot_links($cgi,$before) . &HTML::mim_link($cgi,$match) . &set_prot_links($cgi,$after);
1116        }
1117        elsif ($x =~ /^(.*)(HGNC:[a-zA-Z_0-9\.]+)(.*)/s)
1118        {
1119            $before = $1;
1120            $match = $2;
1121            $after = $3;
1122            return &set_prot_links($cgi,$before) . &HTML::hgnc_link($cgi,$match) . &set_prot_links($cgi,$after);
1123        }
1124        elsif ($x =~ /^(.*)(UniGene:[a-zA-Z_0-9\.]+)(.*)/s)
1125        {
1126            $before = $1;
1127            $match = $2;
1128            $after = $3;
1129            return &set_prot_links($cgi,$before) . &HTML::unigene_link($cgi,$match) . &set_prot_links($cgi,$after);
1130        }
1131    # IPI stopped working. turn off for now.
1132    #    elsif ($x =~ /^(.*)(IPI:[a-zA-Z_0-9\.]+)(.*)/s)
1133    #    {
1134    #        $before = $1;
1135    #        $match = $2;
1136    #        $after = $3;
1137    #        return &set_prot_links($cgi,$before) . &HTML::ipi_link($cgi,$match) . &set_prot_links($cgi,$after);
1138    #    }
1139        elsif ($x =~ /^(.*)(WP:[a-zA-Z_0-9\.]+)(.*)/s)
1140        {
1141            #wormbase
1142    
1143            $before = $1;
1144            $match = $2;
1145            $after = $3;
1146            return &set_prot_links($cgi,$before) . &HTML::wp_link($cgi,$match) . &set_prot_links($cgi,$after);
1147        }
1148        elsif ($x =~ /^(.*)(FB:[a-zA-Z_0-9\.]+)(.*)/s)
1149        {
1150            #flybase
1151    
1152            $before = $1;
1153            $match = $2;
1154            $after = $3;
1155            return &set_prot_links($cgi,$before) . &HTML::fb_link($cgi,$match) . &set_prot_links($cgi,$after);
1156        }
1157        elsif ($x =~ /^(.*)(FlyBaseORFNames:[a-zA-Z_0-9\.]+)(.*)/s)
1158        {
1159            #flybase
1160    
1161            $before = $1;
1162            $match = $2;
1163            $after = $3;
1164            return &set_prot_links($cgi,$before) . &HTML::fborf_link($cgi,$match) . &set_prot_links($cgi,$after);
1165        }
1166        elsif ($x =~ /^(.*)(SGD_LOCUS:[a-zA-Z_0-9\.]+)(.*)/s)
1167        {
1168            #flybase
1169    
1170            $before = $1;
1171            $match = $2;
1172            $after = $3;
1173            return &set_prot_links($cgi,$before) . &HTML::sgd_link($cgi,$match) . &set_prot_links($cgi,$after);
1174        }
1175        elsif ($x =~ /^(.*)(tr\|[a-zA-Z0-9]+)(.*)/s)
1176        {
1177    
1178          $before = $1;
1179          $match = $2;
1180          $after = $3;
1181    
1182          return &set_prot_links($cgi,$before) .  &HTML::trembl_link($cgi,$match) . &set_prot_links($cgi,$after);
1183        }
1184      return $x;      return $x;
1185  }  }
1186    
1187    sub trembl_link {
1188        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1189        my($cgi,$id) = @_;
1190    
1191        if ($id =~ /^tr\|(.*)/) {
1192          return "<a href='http://ca.expasy.org/uniprot/$1'>$id</a>";
1193        } else {
1194          return "invalid call to trembl link";
1195        }
1196    }
1197    
1198  sub refseq_link {  sub refseq_link {
1199      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1200      my($cgi,$id) = @_;      my($cgi,$id) = @_;
# Line 917  Line 1203 
1203      {      {
1204          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>";
1205      }      }
1206        elsif ($id =~ /^[NXYZA]M_/)
1207        {
1208            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=nuccore&cmd=search&term=$id>$id</a>";
1209        }
1210  }  }
1211    
1212  sub gi_link {  sub gi_link {
# Line 934  Line 1224 
1224      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1225      my($cgi,$tigr) = @_;      my($cgi,$tigr) = @_;
1226    
1227      if ($tigr =~ /^tigr\|([0-9a-zA-Z]+)$/)      if ($tigr =~ /^tigr\|(NT|ntbp|ntbpA|BA|BMAA|BXB|GBA)(\w+)$/)
1228        {
1229            my $id=$1.$2;
1230            return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\">$tigr</a> (Pathema)";
1231        }
1232        elsif ($tigr =~ /^tigr\|(\S+)$/)
1233      {      {
1234          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>";
1235      }      }
1236      return $tigr;      return $tigr;
1237  }  }
1238    
1239    sub eric_link {
1240        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1241        my($cgi,$eric) = @_;
1242    
1243        if ($eric =~ /^eric\|(\S+)/)
1244        {
1245            return "<a href=\"https://asap.ahabs.wisc.edu/asap/feature_info.php?FeatureID=$1\">$eric</a>";
1246        }
1247        return $eric;
1248    }
1249    
1250    sub bhb_link {
1251        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1252        my($cgi,$bhb) = @_;
1253    
1254        return "<a href=\"http://www.biohealthbase.org\">$bhb</a>";
1255    }
1256    
1257    sub apidb_link {
1258        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1259        my($cgi,$api) = @_;
1260    
1261        if ($api =~ /apidb\|(.*?)\.(.*)$/)
1262        {
1263            return "<a href=\"http://www.apidb.org/cgi-bin/redirect.cgi?taxon_id=$1&source_id=$2\">$api</a>";
1264        }
1265        return $api;
1266    }
1267    
1268    sub patric_link {
1269        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1270        my($cgi,$patric) = @_;
1271    
1272        if ($patric =~ /patric\|(.*)/)
1273        {
1274            return "<a href=\"https://patric.vbi.vt.edu/software/curationTool/gep/pgiCuration.php?locus_name=$1\">$patric</a>";
1275        }
1276        return $patric;
1277    }
1278    
1279    sub vbrc_link {
1280        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1281        my($cgi,$vbrc) = @_;
1282    
1283        if ($vbrc =~ /vbrc\|(.*)/)
1284        {
1285            return "<a href=\"http://www.biovirus.org/gene_detail.asp?name=$1\">$vbrc</a>";
1286        }
1287        return $vbrc;
1288    }
1289    
1290    sub vectorbase_link {
1291        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1292        my($cgi,$vec) = @_;
1293        return "<a href=\"http://www.vectorbase.org\">$vec</a>";
1294    }
1295    
1296    
1297  sub uni_link {  sub uni_link {
1298      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1299      my($cgi,$uni) = @_;      my($cgi,$uni) = @_;
1300    
1301      if ($uni =~ /^uni\|(\S+)$/)      if ($uni =~ /^uni\|(\S+)$/)
1302      {      {
1303          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>";
1304            return "<a href='http://www.ebi.uniprot.org/uniprot-srv/uniProtView.do?proteinAc=$1'>$uni</a>";
1305      }      }
1306      return $uni;      return $uni;
1307  }  }
# Line 985  Line 1339 
1339      return $kegg;      return $kegg;
1340  }  }
1341    
1342    sub ensembl_link {
1343        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1344        my($cgi,$ensembl) = @_;
1345    
1346        if ($ensembl =~ /^(\S+):(\S+)$/)
1347        {
1348            my $what=$1;
1349            my $key=$2;
1350            my $idx="All";
1351            if ($what eq "EnsemblGene") { $idx = "Gene" }
1352            if ($what eq "EnsemblTranscript") { $idx = "All" }
1353            if ($what eq "EnsemblProtein") { $idx = "All" }
1354    
1355            #I really want to get right to the transcript and peptide pages, but
1356            #can't see how to do that without knowing the org name too, which
1357            #I don't know at this point. (ensembl org name, not real org name)
1358    
1359            return "<a href=http://www.ensembl.org/Homo_sapiens/searchview?species=all&idx=$idx&q=$key>$ensembl</a>";
1360        }
1361        return $ensembl;
1362    }
1363    
1364    sub entrezgene_link {
1365        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1366        my($cgi,$entrezgene) = @_;
1367    
1368        if ($entrezgene =~ /^EntrezGene:(\S+)$/)
1369        {
1370            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=gene&cmd=Retrieve&dopt=full_report&list_uids=$1>$entrezgene</a>";
1371        }
1372        return $entrezgene;
1373    }
1374    
1375    sub mim_link {
1376        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1377        my($cgi,$mim) = @_;
1378    
1379        if ($mim =~ /^MIM:(\S+)$/)
1380        {
1381            return "<a href=http://www3.ncbi.nlm.nih.gov/entrez/dispomim.cgi?id=$1>$mim</a>";
1382        }
1383        return $mim;
1384    }
1385    
1386    sub hgnc_link {
1387        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1388        my($cgi,$hgnc) = @_;
1389    
1390        if ($hgnc =~ /^HGNC:(\S+)$/)
1391        {
1392            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>";
1393        }
1394        return $mim;
1395    }
1396    
1397    sub unigene_link {
1398        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1399        my($cgi,$unigene) = @_;
1400    
1401        if ($unigene =~ /^UniGene:(\S+)$/)
1402        {
1403            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=unigene&cmd=search&term=$1>$unigene</a>";
1404        }
1405        return $unigene;
1406    }
1407    
1408    sub ipi_link {
1409        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1410        my($cgi,$ipi) = @_;
1411    
1412        if ($ipi =~ /^IPI:(\S+)$/)
1413        {
1414            return "<a href=http://srs.ebi.ac.uk/srsbin/cgi-bin/wgetz?-id+AEoS1R8Jnn+-e+[IPI:\'$1\']+-qnum+1+-enum+1>$ipi</a>";
1415        }
1416        return $ipi;
1417    }
1418    
1419    sub wp_link {
1420        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1421        my($cgi,$wp) = @_;
1422    
1423        #wormbase
1424    
1425        if ($wp =~ /^WP:(\S+)$/)
1426        {
1427            return "<a href=http://www.wormbase.org/db/searches/basic?class=Any&query=$1&Search=Search>$wp</a>";
1428        }
1429        return $wp;
1430    }
1431    
1432    sub fb_link {
1433        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1434        my($cgi,$fb) = @_;
1435    
1436        #flybase
1437    
1438        if ($fb =~ /^FB:(\S+)$/)
1439        {
1440            return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";
1441        }
1442        return $fb;
1443    }
1444    
1445    sub fborf_link {
1446        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1447        my($cgi,$fb) = @_;
1448    
1449        #flybase
1450    
1451        if ($fb =~ /^FlyBaseORFNames:(\S+)$/)
1452        {
1453            return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";
1454        }
1455        return $fb;
1456    }
1457    
1458    sub sgd_link {
1459        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1460        my($cgi,$sgd) = @_;
1461    
1462        #yeast
1463    
1464        if ($sgd =~ /^SGD_LOCUS:(\S+)$/)
1465        {
1466            return "<a href=http://db.yeastgenome.org/cgi-bin/locus.pl?locus=$1>$sgd</a>";
1467        }
1468        return $sgd;
1469    }
1470    
1471    
1472    
1473    
1474  sub set_map_links {  sub set_map_links {
1475      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1476      my($cgi,$x) = @_;      my($cgi,$x) = @_;
# Line 1002  Line 1488 
1488      return $x;      return $x;
1489  }  }
1490    
1491    
1492    
1493  sub map_link {  sub map_link {
1494      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1495      my($cgi,$map,$org) = @_;      my($cgi,$map,$org) = @_;
# Line 1038  Line 1526 
1526      my($sub_link);      my($sub_link);
1527    
1528      my $user = $cgi->param('user');      my $user = $cgi->param('user');
1529        my $esc_sub = uri_escape( $sub );
1530        $sub =~ s/\_/ /g;
1531      if ($user)      if ($user)
1532      {      {
         my $esc_sub = uri_escape( $sub );  
1533          $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>";
1534      }      }
1535      else      else
1536      {      {
1537          $sub_link = $sub;          $sub_link = "<a href=\"display_subsys.cgi?ssa_name=$esc_sub&request=show_ssa&sort=by_phylo\">$sub</a>";
1538      }      }
1539      return $sub_link;      return $sub_link;
1540  }  }
# Line 1104  Line 1593 
1593  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
1594  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
1595  link        : link to the item that was added/edited  link        : link to the item that was added/edited
1596  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.
1597    
1598    At most, $max_entries recent entries are stored in the rss file, and this is currently 50.
1599    
1600  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.
1601    
# Line 1114  Line 1605 
1605  sub rss_feed {  sub rss_feed {
1606   shift if UNIVERSAL::isa($_[0],__PACKAGE__);   shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1607   my ($files, $args)=@_;   my ($files, $args)=@_;
1608    
1609     # how many entries to store in the file
1610     my $max_entries=50;
1611    
1612   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}}}
1613    
1614   my $filepath=$FIG_Config::fig."/CGI/Html/rss";   my $filepath=$FIG_Config::fig."/CGI/Html/rss";
# Line 1127  Line 1622 
1622     {     {
1623          title           => "The SEED",          title           => "The SEED",
1624          description     => "Latest news from the SEED",          description     => "Latest news from the SEED",
1625          link            => &FIG::cgi_url()."/Html/rss/SEED.rss",          link            => "Html/rss/SEED.rss",
1626     },     },
1627    
1628    "SEEDsubsystems.rss" =>    "SEEDsubsystems.rss" =>
1629    {    {
1630          title           => "SEED Subsystems",          title           => "SEED Subsystems",
1631          description     => "Recently updated SEED subsystems",          description     => "Recently updated SEED subsystems",
1632          link            => &FIG::cgi_url()."/Html/rss/SEEDsubsystems.rss",          link            => "Html/rss/SEEDsubsystems.rss",
1633    },    },
1634    
1635    "SEEDsubsystems.rss" =>    "SEEDsubsystems.rss" =>
# Line 1159  Line 1654 
1654    if ($qw eq "link")    if ($qw eq "link")
1655    {    {
1656     $args->{$qw} =~ /^(.*?\.cgi.)(.*)$/;     $args->{$qw} =~ /^(.*?\.cgi.)(.*)$/;
    print STDERR "Got ->>$1<<- and ->>$2<<-\n";  
1657     $args->{$qw} = $1.uri_escape($2) if ($1 && $2);     $args->{$qw} = $1.uri_escape($2) if ($1 && $2);
1658    }    }
1659    
# Line 1193  Line 1687 
1687       $itemcount++;       $itemcount++;
1688       $initem=1;       $initem=1;
1689      }      }
1690      if (/\<\/item\>/) {$initem=0; next if ($itemcount > 9)}      if (/\<\/item\>/) {$initem=0; next if ($itemcount > $max_entries)}
1691      next if ($initem && $itemcount > 9);      next if ($initem && $itemcount > $max_entries);
1692      push @out, $_;      push @out, $_;
1693     }     }
1694     close IN;     close IN;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3