[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.95, Tue Jun 27 22:40:49 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      return $x;      return $x;
1176  }  }
1177    
# Line 917  Line 1183 
1183      {      {
1184          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>";
1185      }      }
1186        elsif ($id =~ /^[NXYZA]M_/)
1187        {
1188            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=nuccore&cmd=search&term=$id>$id</a>";
1189        }
1190  }  }
1191    
1192  sub gi_link {  sub gi_link {
# Line 934  Line 1204 
1204      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1205      my($cgi,$tigr) = @_;      my($cgi,$tigr) = @_;
1206    
1207      if ($tigr =~ /^tigr\|([0-9a-zA-Z]+)$/)      if ($tigr =~ /^tigr\|(NT|ntbp|ntbpA|BA|BMAA|BXB|GBA)(\w+)$/)
1208        {
1209            my $id=$1.$2;
1210            return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\">$tigr</a> (Pathema)";
1211        }
1212        elsif ($tigr =~ /^tigr\|(\S+)$/)
1213      {      {
1214          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>";
1215      }      }
1216      return $tigr;      return $tigr;
1217  }  }
1218    
1219    sub eric_link {
1220        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1221        my($cgi,$eric) = @_;
1222    
1223        if ($eric =~ /^eric\|(\S+)/)
1224        {
1225            return "<a href=\"https://asap.ahabs.wisc.edu/asap/feature_info.php?FeatureID=$1\">$eric</a>";
1226        }
1227        return $eric;
1228    }
1229    
1230    sub bhb_link {
1231        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1232        my($cgi,$bhb) = @_;
1233    
1234        return "<a href=\"http://www.biohealthbase.org\">$bhb</a>";
1235    }
1236    
1237    sub apidb_link {
1238        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1239        my($cgi,$api) = @_;
1240    
1241        if ($api =~ /apidb\|(.*?)\.(.*)$/)
1242        {
1243            return "<a href=\"http://www.apidb.org/cgi-bin/redirect.cgi?taxon_id=$1&source_id=$2\">$api</a>";
1244        }
1245        return $api;
1246    }
1247    
1248    sub patric_link {
1249        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1250        my($cgi,$patric) = @_;
1251    
1252        if ($patric =~ /patric\|(.*)/)
1253        {
1254            return "<a href=\"https://patric.vbi.vt.edu/software/curationTool/gep/pgiCuration.php?locus_name=$1\">$patric</a>";
1255        }
1256        return $patric;
1257    }
1258    
1259    sub vbrc_link {
1260        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1261        my($cgi,$vbrc) = @_;
1262    
1263        if ($vbrc =~ /vbrc\|(.*)/)
1264        {
1265            return "<a href=\"http://www.biovirus.org/gene_detail.asp?name=$1\">$vbrc</a>";
1266        }
1267        return $vbrc;
1268    }
1269    
1270    sub vectorbase_link {
1271        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1272        my($cgi,$vec) = @_;
1273        return "<a href=\"http://www.vectorbase.org\">$vec</a>";
1274    }
1275    
1276    
1277  sub uni_link {  sub uni_link {
1278      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1279      my($cgi,$uni) = @_;      my($cgi,$uni) = @_;
1280    
1281      if ($uni =~ /^uni\|(\S+)$/)      if ($uni =~ /^uni\|(\S+)$/)
1282      {      {
1283          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>";
1284            return "<a href='http://www.ebi.uniprot.org/uniprot-srv/uniProtView.do?proteinAc=$1'>$uni</a>";
1285      }      }
1286      return $uni;      return $uni;
1287  }  }
# Line 985  Line 1319 
1319      return $kegg;      return $kegg;
1320  }  }
1321    
1322    sub ensembl_link {
1323        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1324        my($cgi,$ensembl) = @_;
1325    
1326        if ($ensembl =~ /^(\S+):(\S+)$/)
1327        {
1328            my $what=$1;
1329            my $key=$2;
1330            my $idx="All";
1331            if ($what eq "EnsemblGene") { $idx = "Gene" }
1332            if ($what eq "EnsemblTranscript") { $idx = "All" }
1333            if ($what eq "EnsemblProtein") { $idx = "All" }
1334    
1335            #I really want to get right to the transcript and peptide pages, but
1336            #can't see how to do that without knowing the org name too, which
1337            #I don't know at this point. (ensembl org name, not real org name)
1338    
1339            return "<a href=http://www.ensembl.org/Homo_sapiens/searchview?species=all&idx=$idx&q=$key>$ensembl</a>";
1340        }
1341        return $ensembl;
1342    }
1343    
1344    sub entrezgene_link {
1345        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1346        my($cgi,$entrezgene) = @_;
1347    
1348        if ($entrezgene =~ /^EntrezGene:(\S+)$/)
1349        {
1350            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=gene&cmd=Retrieve&dopt=full_report&list_uids=$1>$entrezgene</a>";
1351        }
1352        return $entrezgene;
1353    }
1354    
1355    sub mim_link {
1356        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1357        my($cgi,$mim) = @_;
1358    
1359        if ($mim =~ /^MIM:(\S+)$/)
1360        {
1361            return "<a href=http://www3.ncbi.nlm.nih.gov/entrez/dispomim.cgi?id=$1>$mim</a>";
1362        }
1363        return $mim;
1364    }
1365    
1366    sub hgnc_link {
1367        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1368        my($cgi,$hgnc) = @_;
1369    
1370        if ($hgnc =~ /^HGNC:(\S+)$/)
1371        {
1372            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>";
1373        }
1374        return $mim;
1375    }
1376    
1377    sub unigene_link {
1378        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1379        my($cgi,$unigene) = @_;
1380    
1381        if ($unigene =~ /^UniGene:(\S+)$/)
1382        {
1383            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=unigene&cmd=search&term=$1>$unigene</a>";
1384        }
1385        return $unigene;
1386    }
1387    
1388    sub ipi_link {
1389        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1390        my($cgi,$ipi) = @_;
1391    
1392        if ($ipi =~ /^IPI:(\S+)$/)
1393        {
1394            return "<a href=http://srs.ebi.ac.uk/srsbin/cgi-bin/wgetz?-id+AEoS1R8Jnn+-e+[IPI:\'$1\']+-qnum+1+-enum+1>$ipi</a>";
1395        }
1396        return $ipi;
1397    }
1398    
1399    sub wp_link {
1400        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1401        my($cgi,$wp) = @_;
1402    
1403        #wormbase
1404    
1405        if ($wp =~ /^WP:(\S+)$/)
1406        {
1407            return "<a href=http://www.wormbase.org/db/searches/basic?class=Any&query=$1&Search=Search>$wp</a>";
1408        }
1409        return $wp;
1410    }
1411    
1412    sub fb_link {
1413        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1414        my($cgi,$fb) = @_;
1415    
1416        #flybase
1417    
1418        if ($fb =~ /^FB:(\S+)$/)
1419        {
1420            return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";
1421        }
1422        return $fb;
1423    }
1424    
1425    sub fborf_link {
1426        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1427        my($cgi,$fb) = @_;
1428    
1429        #flybase
1430    
1431        if ($fb =~ /^FlyBaseORFNames:(\S+)$/)
1432        {
1433            return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";
1434        }
1435        return $fb;
1436    }
1437    
1438    sub sgd_link {
1439        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1440        my($cgi,$sgd) = @_;
1441    
1442        #yeast
1443    
1444        if ($sgd =~ /^SGD_LOCUS:(\S+)$/)
1445        {
1446            return "<a href=http://db.yeastgenome.org/cgi-bin/locus.pl?locus=$1>$sgd</a>";
1447        }
1448        return $sgd;
1449    }
1450    
1451    
1452    
1453    
1454  sub set_map_links {  sub set_map_links {
1455      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1456      my($cgi,$x) = @_;      my($cgi,$x) = @_;
# Line 1002  Line 1468 
1468      return $x;      return $x;
1469  }  }
1470    
1471    
1472    
1473  sub map_link {  sub map_link {
1474      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1475      my($cgi,$map,$org) = @_;      my($cgi,$map,$org) = @_;
# Line 1038  Line 1506 
1506      my($sub_link);      my($sub_link);
1507    
1508      my $user = $cgi->param('user');      my $user = $cgi->param('user');
1509        my $esc_sub = uri_escape( $sub );
1510        $sub =~ s/\_/ /g;
1511      if ($user)      if ($user)
1512      {      {
         my $esc_sub = uri_escape( $sub );  
1513          $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>";
1514      }      }
1515      else      else
1516      {      {
1517          $sub_link = $sub;          $sub_link = "<a href=\"display_subsys.cgi?ssa_name=$esc_sub&request=show_ssa&sort=by_phylo\">$sub</a>";
1518      }      }
1519      return $sub_link;      return $sub_link;
1520  }  }
# Line 1104  Line 1573 
1573  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
1574  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
1575  link        : link to the item that was added/edited  link        : link to the item that was added/edited
1576  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.
1577    
1578    At most, $max_entries recent entries are stored in the rss file, and this is currently 50.
1579    
1580  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.
1581    
# Line 1114  Line 1585 
1585  sub rss_feed {  sub rss_feed {
1586   shift if UNIVERSAL::isa($_[0],__PACKAGE__);   shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1587   my ($files, $args)=@_;   my ($files, $args)=@_;
1588    
1589     # how many entries to store in the file
1590     my $max_entries=50;
1591    
1592   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}}}
1593    
1594   my $filepath=$FIG_Config::fig."/CGI/Html/rss";   my $filepath=$FIG_Config::fig."/CGI/Html/rss";
# Line 1127  Line 1602 
1602     {     {
1603          title           => "The SEED",          title           => "The SEED",
1604          description     => "Latest news from the SEED",          description     => "Latest news from the SEED",
1605          link            => &FIG::cgi_url()."/Html/rss/SEED.rss",          link            => "Html/rss/SEED.rss",
1606     },     },
1607    
1608    "SEEDsubsystems.rss" =>    "SEEDsubsystems.rss" =>
1609    {    {
1610          title           => "SEED Subsystems",          title           => "SEED Subsystems",
1611          description     => "Recently updated SEED subsystems",          description     => "Recently updated SEED subsystems",
1612          link            => &FIG::cgi_url()."/Html/rss/SEEDsubsystems.rss",          link            => "Html/rss/SEEDsubsystems.rss",
1613    },    },
1614    
1615    "SEEDsubsystems.rss" =>    "SEEDsubsystems.rss" =>
# Line 1159  Line 1634 
1634    if ($qw eq "link")    if ($qw eq "link")
1635    {    {
1636     $args->{$qw} =~ /^(.*?\.cgi.)(.*)$/;     $args->{$qw} =~ /^(.*?\.cgi.)(.*)$/;
    print STDERR "Got ->>$1<<- and ->>$2<<-\n";  
1637     $args->{$qw} = $1.uri_escape($2) if ($1 && $2);     $args->{$qw} = $1.uri_escape($2) if ($1 && $2);
1638    }    }
1639    
# Line 1193  Line 1667 
1667       $itemcount++;       $itemcount++;
1668       $initem=1;       $initem=1;
1669      }      }
1670      if (/\<\/item\>/) {$initem=0; next if ($itemcount > 9)}      if (/\<\/item\>/) {$initem=0; next if ($itemcount > $max_entries)}
1671      next if ($initem && $itemcount > 9);      next if ($initem && $itemcount > $max_entries);
1672      push @out, $_;      push @out, $_;
1673     }     }
1674     close IN;     close IN;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3