[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.75, Fri Dec 23 18:13:45 2005 UTC revision 1.101, Mon Sep 25 19:34:14 2006 UTC
# Line 17  Line 17 
17    
18  package HTML;  package HTML;
19    
20    use strict;
21  use Tracer;  use Tracer;
22  use FIG;  use FIG;
23  use Carp;  use Carp;
# Line 28  Line 29 
29  use HTTP::Request::Common;  use HTTP::Request::Common;
30  use POSIX;  use POSIX;
31    
32    #use raelib; # now used for the excel function, that should eventually end up in here. Way too experimental!
33    my $raelib;
34    
35    
36  my $top_link_cache;  my $top_link_cache;
37    
# Line 78  Line 82 
82      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
83      my($additional_insert, $user, %options ) = @_;      my($additional_insert, $user, %options ) = @_;
84    
85        local $/ = "\n";
86    
87      my $header_name = $options{header_name} ? $options{header_name} : "html.hdr";      my $header_name = $options{header_name} ? $options{header_name} : "html.hdr";
88      my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";      my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";
89    
# Line 156  Line 162 
162  sub show_page {  sub show_page {
163      #warn "SHOWPAGE: cgi=", Dumper(@_);      #warn "SHOWPAGE: cgi=", Dumper(@_);
164      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
165      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie) = @_;      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie, $options) = @_;
166      my $i;      my $i;
167    
168      my $top = top_link();      my $top = top_link();
# Line 169  Line 175 
175      #     $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
176      #               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
177      #               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
178      #     $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")
179      #     $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
180        #     $options is a reference to a hash of options that you can pass around the pages
181      #      #
182      # Find the HTML header      # Find the HTML header
183      #      #
184    
185        my $tail_name = $options->{tail_name} ? $options->{tail_name} : "html.tail";
186      my $html_tail_file = "./Html/$tail_name";      my $html_tail_file = "./Html/$tail_name";
187      if (! -f $html_tail_file)      if (! -f $html_tail_file)
188      {      {
# Line 189  Line 197 
197      }      }
198      else      else
199      {      {
200          @html_hdr = compute_html_header(undef,$user);          @html_hdr = compute_html_header(undef,$user,%$options);
201      }      }
202    
203      # 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 359  Line 367 
367    
368      if (!$css || !$css->{'Default'})      if (!$css || !$css->{'Default'})
369      {      {
370         $css->{'Default'} = "$top/Html/css/default.css";         $css->{'Default'} = "Html/css/default.css";
371      }      }
372      if (!$css->{"Sans Serif"})      if (!$css->{"Sans Serif"})
373      {      {
374         $css->{'Sans Serif'} = "$top/Html/css/sanserif.css";         $css->{'Sans Serif'} = "Html/css/sanserif.css";
375      }      }
376    
377      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 375  Line 383 
383         $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";
384      }      }
385    
386      $csstext   .= "<link rel='alternate'  title='SEED RSS feeds' href='$top/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";
387    
388      # RAE: also added support for external javascripts here.      # RAE: also added support for external javascripts here.
389      # 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 385  Line 393 
393      # it will reduce our overhead.      # it will reduce our overhead.
394    
395      # $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
396      push @$javasrc, "$top/Html/css/FIG.js";      push @$javasrc, "Html/css/FIG.js";
397      foreach my $script (@$javasrc) {      foreach my $script (@$javasrc) {
398          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";
399      }      }
# Line 409  Line 417 
417          # BASE href needs to be absolute. RDO.          # BASE href needs to be absolute. RDO.
418          #          #
419          #          #
420          $base_url = &FIG::cgi_url;  #        $base_url = &FIG::cgi_url;
421  #       my $base_url = $FIG_Config::cgi_base;  #       my $base_url = $FIG_Config::cgi_base;
422  #       if ( ! $base_url )                      # if cgi_base was not defined  #       if ( ! $base_url )                      # if cgi_base was not defined
423  #       {  #       {
# Line 515  Line 523 
523    
524  }  }
525    
526    
527    =head1 make_table
528    
529    The main method to convert an array into a table.
530    
531    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.
532    
533    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.
534    
535    =cut
536    
537  sub make_table {  sub make_table {
538      my($col_hdrs,$tab,$title, %options ) = @_;      my($col_hdrs,$tab,$title, %options ) = @_;
539      my(@tab);      my(@tab);
# Line 539  Line 558 
558              );              );
559      }      }
560      push(@tab,"</table>\n");      push(@tab,"</table>\n");
561    
562        # excelfile should be appropriate for a filename (no spaces/special characters)
563        if (defined $options{"excelfile"}) {
564            if (! defined($raelib)) {
565                require raelib;
566                $raelib = new raelib;
567            }
568            push @tab, $raelib->tab2excel($col_hdrs,$tab,$title,\%options,$options{"excelfile"})}
569    
570      return join("",@tab);      return join("",@tab);
571  }  }
572    
573  sub abstract_coupling_table {  sub abstract_coupling_table {
574      my($cgi,$prot,$coupling) = @_;      my($cgi,$prot,$coupling) = @_;
575        my %fc;
576    
577      my $col_hdrs = ["coupled to","Score","Type of Coupling", "Type-specific Data"];      my $col_hdrs = ["coupled to","Score","Type of Coupling", "Type-specific Data"];
578      my $tab = [];      my $tab = [];
579        my %by_peg;
580      foreach my $x (@$coupling)      foreach my $x (@$coupling)
581      {      {
582          my($peg2,$psc,$type,$extra) = @$x;          my($peg2,$psc,$type,$extra) = @$x;
583            if (($type !~ /^[ID]FC$/) || (! $fc{$peg2}))
584            {
585                if ($type =~  /^[ID]FC$/)
586                {
587                    $fc{$peg2} = 1;
588                }
589    
590                $by_peg{$peg2} += $psc;
591            }
592        }
593    
594        foreach my $x (sort { ($by_peg{$b->[0]} <=> $by_peg{$a->[0]})
595                              or ($a->[0] cmp $b->[0])
596                              or ($b->[1] <=> $a->[1])
597                              or ($a->[2] cmp $b->[2]) } @$coupling)
598        {
599            my($peg2,$psc,$type,$extra) = @$x;
600          push(@$tab,[&fid_link($cgi,$peg2,1),$psc,$type,&set_prot_links($cgi,join(", ",@$extra))]);          push(@$tab,[&fid_link($cgi,$peg2,1),$psc,$type,&set_prot_links($cgi,join(", ",@$extra))]);
601      }      }
602    
603    
604      my $help = "<a href=\"Html/abstract_coupling.html\" target=\"SEED_or_SPROUT_help\">for help</a>";      my $help = "<a href=\"Html/abstract_coupling.html\" target=\"SEED_or_SPROUT_help\">for help</a>";
605  #    my @html = &make_table($col_hdrs,$tab,"Abstract Coupling Data for $prot");  #    my @html = &make_table($col_hdrs,$tab,"Abstract Coupling Data for $prot");
606  #    push(@html,"<hr>\n",$cgi->h3($help),"<br>");  #    push(@html,"<hr>\n",$cgi->h3($help),"<br>");
# Line 790  Line 838 
838          }          }
839    
840          my $link;          my $link;
841            my $new_framework = $cgi->param('new_framework') ? 1 : 0;
842          #added to format prophage and path island links to feature.cgi          #added to format prophage and path island links to feature.cgi
843          if ($1 ne "peg")          my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";
844            if ($1 ne "peg" && ! $sprout)
845          {          {
846             my $user = $cgi->param('user');             my $user = $cgi->param('user');
847             if (! $user) { $user = "" }             if (! $user) { $user = "" }
848             my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";             $link = "$top/feature.cgi?feature=$fid&user=$user$sprout";
            $link = "$top/feature.cgi?feature=$fid&user=$user$trans$sprout";  
849             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;
850          }          }
851          else          else
# Line 816  Line 865 
865    
866              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }
867              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";
868              $link = "$top/protein.cgi?prot=$fid&user=$user$trans$sprout";              $link = "$top/protein.cgi?prot=$fid&user=$user$trans$sprout\&new_framework=$new_framework";
869              $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;              $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;
870          }          }
871          if ($just_url)          if ($just_url)
# Line 825  Line 874 
874          }          }
875          else          else
876          {          {
877              return "<a href=$link>$n</a>";              return "<a href='$link'>$n</a>";
878          }          }
879      }      }
880      return $fid;      return $fid;
# Line 857  Line 906 
906          my $response = $ua->request($request);          my $response = $ua->request($request);
907          $out = $response->content;          $out = $response->content;
908      }      }
909      else  
910        if ($type =~/get/i)
911      {      {
912          @args = ();          @args = ();
913          foreach $x (@$kv_pairs)          foreach $x (@$kv_pairs)
# Line 869  Line 919 
919          {          {
920              $url .= "?" . join("&",@args);              $url .= "?" . join("&",@args);
921          }          }
922          $request = new HTTP::Request('GET', $url);          my $request = new HTTP::Request('GET', $url);
923          my $response = $ua->request($request);          my $response = $ua->request($request);
924    
925          if ($response->is_success)          if ($response->is_success)
# Line 887  Line 937 
937    
938  #   Now splice in a line of the form <base href=URL> to cause all relative links to work  #   Now splice in a line of the form <base href=URL> to cause all relative links to work
939  #   properly.  Remove the header.  #   properly.  Remove the header.
940        my $i;
941      for ($i=0; ($i < @output) && ($output[$i] !~ /^\s*\</); $i++) {}      for ($i=0; ($i < @output) && ($output[$i] !~ /^\s*\</); $i++) {}
942      if ($i < @output)      if ($i < @output) {
     {  
   
943          splice(@output,0,$i);          splice(@output,0,$i);
944      }      }
945    
# Line 907  Line 955 
955  sub trim_output {  sub trim_output {
956      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
957      my($out) = @_;      my($out) = @_;
958      my $i;      my ($i, $j);
959    
960      for ($i=0; ($i < @$out) && ($out->[$i] !~ /^\</); $i++) {}      for ($i=0; ($i < @$out) && ($out->[$i] !~ /^\</); $i++) {}
961      splice(@$out,0,$i);      splice(@$out,0,$i);
# Line 936  Line 984 
984      for ($j=$i-1; ($j > 0) && ($out->[$j] !~ /FIG search/); $j--) {}      for ($j=$i-1; ($j > 0) && ($out->[$j] !~ /FIG search/); $j--) {}
985      if ($j > 0)      if ($j > 0)
986      {      {
987            #
988            # Hm. We would have tried using the options here:
989            # my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";
990            # but they're not passed in. So use the default html.tail.
991            #
992            my $html_tail_file = "./Html/html.tail";
993          my @tmp = `cat $html_tail_file`;          my @tmp = `cat $html_tail_file`;
994          my $n = @tmp;          my $n = @tmp;
995          splice(@$out,$j-$n,$n+1);          splice(@$out,$j-$n,$n+1);
# Line 968  Line 1022 
1022          $after = $3;          $after = $3;
1023          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);
1024      }      }
1025      elsif ($x =~ /^(.*)(tigr\|[0-9a-zA-Z]+)(.*)/s)      elsif ($x =~ /^(.*)(tigr\|\w+)(.*)/s)
1026      {      {
1027          $before = $1;          $before = $1;
1028          $match = $2;          $match = $2;
1029          $after = $3;          $after = $3;
1030          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);
1031      }      }
1032        elsif ($x =~ /^(.*)\b(eric\|\S+)\b(.*)/s)
1033        {
1034            $before = $1;
1035            $match = $2;
1036            $after = $3;
1037            return &set_prot_links($cgi,$before) . &HTML::eric_link($cgi,$match) . &set_prot_links($cgi,$after);
1038        }
1039    
1040        elsif ($x =~ /^(.*)\b(bhb\|.*?)\b(.*)/s)
1041        {
1042            $before = $1;
1043            $match = $2;
1044            $after = $3;
1045            return &set_prot_links($cgi,$before) . &HTML::bhb_link($cgi,$match) . &set_prot_links($cgi,$after);
1046        }
1047    
1048        elsif ($x =~ /^(.*)\b(apidb\|[0-9\.a-z_]+)\b(.*)/s)
1049        {
1050            $before = $1;
1051            $match = $2;
1052            $after = $3;
1053            return &set_prot_links($cgi,$before) . &HTML::apidb_link($cgi,$match) . &set_prot_links($cgi,$after);
1054        }
1055    
1056        elsif ($x =~ /^(.*)\b(patric\|.*?)\b(.*)/s)
1057        {
1058            $before = $1;
1059            $match = $2;
1060            $after = $3;
1061            return &set_prot_links($cgi,$before) . &HTML::patric_link($cgi,$match) . &set_prot_links($cgi,$after);
1062        }
1063    
1064        elsif ($x =~ /^(.*)\b(vbrc\|.*?)\b(.*)/s)
1065        {
1066            $before = $1;
1067            $match = $2;
1068            $after = $3;
1069            return &set_prot_links($cgi,$before) . &HTML::vbrc_link($cgi,$match) . &set_prot_links($cgi,$after);
1070        }
1071    
1072        elsif ($x =~ /^(.*)\b(vectorbase\|.*?)\b(.*)/s)
1073        {
1074            $before = $1;
1075            $match = $2;
1076            $after = $3;
1077            return &set_prot_links($cgi,$before) . &HTML::vectorbase_link($cgi,$match) . &set_prot_links($cgi,$after);
1078        }
1079      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)
1080      {      {
1081          $before = $1;          $before = $1;
# Line 1024  Line 1125 
1125          $after = $3;          $after = $3;
1126          return &set_prot_links($cgi,$before) . &HTML::mim_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::mim_link($cgi,$match) . &set_prot_links($cgi,$after);
1127      }      }
1128      elsif ($x =~ /^(.*)(UniGene:[a-zA-Z_0-9\.]+)(.*)/s)      elsif ($x =~ /^(.*)(HGNC:[a-zA-Z_0-9\.]+)(.*)/s)
1129      {      {
1130          $before = $1;          $before = $1;
1131          $match = $2;          $match = $2;
1132          $after = $3;          $after = $3;
1133          return &set_prot_links($cgi,$before) . &HTML::unigene_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::hgnc_link($cgi,$match) . &set_prot_links($cgi,$after);
1134      }      }
1135      elsif ($x =~ /^(.*)(IPI:[a-zA-Z_0-9\.]+)(.*)/s)      elsif ($x =~ /^(.*)(UniGene:[a-zA-Z_0-9\.]+)(.*)/s)
1136      {      {
1137          $before = $1;          $before = $1;
1138          $match = $2;          $match = $2;
1139          $after = $3;          $after = $3;
1140          return &set_prot_links($cgi,$before) . &HTML::ipi_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::unigene_link($cgi,$match) . &set_prot_links($cgi,$after);
1141      }      }
1142    # IPI stopped working. turn off for now.
1143    #    elsif ($x =~ /^(.*)(IPI:[a-zA-Z_0-9\.]+)(.*)/s)
1144    #    {
1145    #        $before = $1;
1146    #        $match = $2;
1147    #        $after = $3;
1148    #        return &set_prot_links($cgi,$before) . &HTML::ipi_link($cgi,$match) . &set_prot_links($cgi,$after);
1149    #    }
1150      elsif ($x =~ /^(.*)(WP:[a-zA-Z_0-9\.]+)(.*)/s)      elsif ($x =~ /^(.*)(WP:[a-zA-Z_0-9\.]+)(.*)/s)
1151      {      {
1152          #wormbase          #wormbase
# Line 1074  Line 1183 
1183          $after = $3;          $after = $3;
1184          return &set_prot_links($cgi,$before) . &HTML::sgd_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::sgd_link($cgi,$match) . &set_prot_links($cgi,$after);
1185      }      }
1186        elsif ($x =~ /^(.*)(tr\|[a-zA-Z0-9]+)(.*)/s)
1187        {
1188    
1189          $before = $1;
1190          $match = $2;
1191          $after = $3;
1192    
1193          return &set_prot_links($cgi,$before) .  &HTML::trembl_link($cgi,$match) . &set_prot_links($cgi,$after);
1194        }
1195      return $x;      return $x;
1196  }  }
1197    
1198    sub trembl_link {
1199        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1200        my($cgi,$id) = @_;
1201    
1202        if ($id =~ /^tr\|(.*)/) {
1203          return "<a href='http://ca.expasy.org/uniprot/$1' target=_blank>$id</a>";
1204        } else {
1205          return "invalid call to trembl link";
1206        }
1207    }
1208    
1209  sub refseq_link {  sub refseq_link {
1210      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1211      my($cgi,$id) = @_;      my($cgi,$id) = @_;
1212    
1213      if ($id =~ /^[NXYZA]P_/)      if ($id =~ /^[NXYZA]P_/)
1214      {      {
1215          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' target=_blank>$id</a>";
1216      }      }
1217      elsif ($id =~ /^[NXYZA]M_/)      elsif ($id =~ /^[NXYZA]M_/)
1218      {      {
1219          return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=nuccore&cmd=search&term=$id>$id</a>";          return "<a href='http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=nuccore&cmd=search&term=$id' target=_blank>$id</a>";
1220      }      }
1221  }  }
1222    
# Line 1097  Line 1226 
1226    
1227      if ($gi =~ /^gi\|(\d+)$/)      if ($gi =~ /^gi\|(\d+)$/)
1228      {      {
1229          return "<a href=http://www.ncbi.nlm.nih.gov:80/entrez/query.fcgi?cmd=Retrieve&db=Protein&list_uids=$1&dopt=GenPept>$gi</a>";          return "<a href='http://www.ncbi.nlm.nih.gov:80/entrez/query.fcgi?cmd=Retrieve&db=Protein&list_uids=$1&dopt=GenPept' target=_blank>$gi</a>";
1230      }      }
1231      return $gi;      return $gi;
1232  }  }
# Line 1106  Line 1235 
1235      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1236      my($cgi,$tigr) = @_;      my($cgi,$tigr) = @_;
1237    
1238      if ($tigr =~ /^tigr\|([0-9a-zA-Z]+)$/)      if ($tigr =~ /^tigr\|(NT|ntbp|ntbpA|BA|BMAA|BXB|GBA)(\w+)$/)
1239        {
1240            my $id=$1.$2;
1241            return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\" target=_blank>$tigr</a> (Pathema)";
1242        }
1243        elsif ($tigr =~ /^tigr\|(\S+)$/)
1244      {      {
1245          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\" target=_blank>$tigr</a>";
1246      }      }
1247      return $tigr;      return $tigr;
1248  }  }
1249    
1250    sub eric_link {
1251        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1252        my($cgi,$eric) = @_;
1253    
1254        if ($eric =~ /^eric\|(\S+)/)
1255        {
1256            return "<a href=\"https://asap.ahabs.wisc.edu/asap/feature_info.php?FeatureID=$1\" target=_blank>$eric</a>";
1257        }
1258        return $eric;
1259    }
1260    
1261    sub bhb_link {
1262        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1263        my($cgi,$bhb) = @_;
1264    
1265        return "<a href=\"http://www.biohealthbase.org\" target=_blank>$bhb</a>";
1266    }
1267    
1268    sub apidb_link {
1269        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1270        my($cgi,$api) = @_;
1271    
1272        if ($api =~ /apidb\|(.*?)\.(.*)$/)
1273        {
1274            return "<a href=\"http://www.apidb.org/cgi-bin/redirect.cgi?taxon_id=$1&source_id=$2\" target=_blank>$api</a>";
1275        }
1276        return $api;
1277    }
1278    
1279    sub patric_link {
1280        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1281        my($cgi,$patric) = @_;
1282    
1283        if ($patric =~ /patric\|(.*)/)
1284        {
1285            return "<a href=\"https://patric.vbi.vt.edu/software/curationTool/gep/pgiCuration.php?locus_name=$1\" target=_blank>$patric</a>";
1286        }
1287        return $patric;
1288    }
1289    
1290    sub vbrc_link {
1291        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1292        my($cgi,$vbrc) = @_;
1293    
1294        if ($vbrc =~ /vbrc\|(.*)/)
1295        {
1296            return "<a href=\"http://www.biovirus.org/gene_detail.asp?name=$1\" target=_blank>$vbrc</a>";
1297        }
1298        return $vbrc;
1299    }
1300    
1301    sub vectorbase_link {
1302        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1303        my($cgi,$vec) = @_;
1304        return "<a href=\"http://www.vectorbase.org\" target=_blank>$vec</a>";
1305    }
1306    
1307    
1308  sub uni_link {  sub uni_link {
1309      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1310      my($cgi,$uni) = @_;      my($cgi,$uni) = @_;
1311    
1312      if ($uni =~ /^uni\|(\S+)$/)      if ($uni =~ /^uni\|(\S+)$/)
1313      {      {
1314          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>";
1315            return "<a href='http://www.ebi.uniprot.org/uniprot-srv/uniProtView.do?proteinAc=$1' target=_blank>$uni</a>";
1316      }      }
1317      return $uni;      return $uni;
1318  }  }
# Line 1130  Line 1323 
1323    
1324      if ($sp =~ /^sp\|(\S+)$/)      if ($sp =~ /^sp\|(\S+)$/)
1325      {      {
1326          return "<a href=http://us.expasy.org/cgi-bin/get-sprot-entry?$1>$sp</a>";          return "<a href='http://us.expasy.org/cgi-bin/get-sprot-entry?$1' target=_blank>$sp</a>";
1327      }      }
1328      return $sp;      return $sp;
1329  }  }
# Line 1141  Line 1334 
1334    
1335      if ($pir =~ /^pirnr\|(NF\d+)$/)      if ($pir =~ /^pirnr\|(NF\d+)$/)
1336      {      {
1337          return "<a href=http://pir.georgetown.edu/cgi-bin/nfEntry.pl?id=$1>$pir</a>";          return "<a href='http://pir.georgetown.edu/cgi-bin/nfEntry.pl?id=$1' target=_blank>$pir</a>";
1338      }      }
1339      return $pir;      return $pir;
1340  }  }
# Line 1152  Line 1345 
1345    
1346      if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)      if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)
1347      {      {
1348          return "<a href=http://www.genome.ad.jp/dbget-bin/www_bget?$1+$2>$kegg</a>";          return "<a href='http://www.genome.ad.jp/dbget-bin/www_bget?$1+$2' target=_blank>$kegg</a>";
1349      }      }
1350      return $kegg;      return $kegg;
1351  }  }
# Line 1165  Line 1358 
1358      {      {
1359          my $what=$1;          my $what=$1;
1360          my $key=$2;          my $key=$2;
1361          my $idx="all";          my $idx="All";
1362          if ($what eq "EnsemblGene") { $idx = "Gene" }          if ($what eq "EnsemblGene") { $idx = "Gene" }
1363          if ($what eq "EnsemblTranscript") { $idx = "all" }          if ($what eq "EnsemblTranscript") { $idx = "All" }
1364          if ($what eq "EnsemblProtein") { $idx = "all" }          if ($what eq "EnsemblProtein") { $idx = "All" }
1365    
1366          #I really want to get right to the transcript and peptide pages, but          #I really want to get right to the transcript and peptide pages, but
1367          #can't see how to do that without knowing the org name too, which          #can't see how to do that without knowing the org name too, which
1368          #I don't know at this point. (ensembl org name, not real org name)          #I don't know at this point. (ensembl org name, not real org name)
1369    
1370          return "<a href=http://www.ensembl.org/Homo_sapiens/textview?species=all&idx=$idx&q=$key>$ensembl</a>";          return "<a href='http://www.ensembl.org/Homo_sapiens/searchview?species=all&idx=$idx&q=$key' target=_blank>$ensembl</a>";
1371      }      }
1372      return $ensembl;      return $ensembl;
1373  }  }
# Line 1185  Line 1378 
1378    
1379      if ($entrezgene =~ /^EntrezGene:(\S+)$/)      if ($entrezgene =~ /^EntrezGene:(\S+)$/)
1380      {      {
1381          return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=gene&cmd=Retrieve&dopt=full_report&list_uids=$1>$entrezgene</a>";          return "<a href='http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=gene&cmd=Retrieve&dopt=full_report&list_uids=$1' target=_blank>$entrezgene</a>";
1382      }      }
1383      return $entrezgene;      return $entrezgene;
1384  }  }
# Line 1196  Line 1389 
1389    
1390      if ($mim =~ /^MIM:(\S+)$/)      if ($mim =~ /^MIM:(\S+)$/)
1391      {      {
1392          return "<a href=http://www3.ncbi.nlm.nih.gov/entrez/dispomim.cgi?id=$1>$mim</a>";          return "<a href='http://www3.ncbi.nlm.nih.gov/entrez/dispomim.cgi?id=$1' target=_blank>$mim</a>";
1393      }      }
1394      return $mim;      return $mim;
1395  }  }
1396    
1397    sub hgnc_link {
1398        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1399        my($cgi,$hgnc) = @_;
1400    
1401        if ($hgnc =~ /^HGNC:(\S+)$/)
1402        {
1403            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' target=_blank>$hgnc</a>";
1404        }
1405    
1406        return $hgnc;
1407    }
1408    
1409  sub unigene_link {  sub unigene_link {
1410      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1411      my($cgi,$unigene) = @_;      my($cgi,$unigene) = @_;
1412    
1413      if ($unigene =~ /^UniGene:(\S+)$/)      if ($unigene =~ /^UniGene:(\S+)$/)
1414      {      {
1415          return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=unigene&cmd=search&term=$1>$unigene</a>";          return "<a href='http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=unigene&cmd=search&term=$1' target=_blank>$unigene</a>";
1416      }      }
1417      return $unigene;      return $unigene;
1418  }  }
# Line 1218  Line 1423 
1423    
1424      if ($ipi =~ /^IPI:(\S+)$/)      if ($ipi =~ /^IPI:(\S+)$/)
1425      {      {
1426          return "<a href=http://srs.ebi.ac.uk/srsbin/cgi-bin/wgetz?-id+AEoS1R8Jnn+-e+[IPI:\'$1\']+-qnum+1+-enum+1>$ipi</a>";          return "<a href='http://srs.ebi.ac.uk/srsbin/cgi-bin/wgetz?-id+AEoS1R8Jnn+-e+[IPI:\'$1\']+-qnum+1+-enum+1' target=_blank>$ipi</a>";
1427      }      }
1428      return $ipi;      return $ipi;
1429  }  }
# Line 1231  Line 1436 
1436    
1437      if ($wp =~ /^WP:(\S+)$/)      if ($wp =~ /^WP:(\S+)$/)
1438      {      {
1439          return "<a href=http://www.wormbase.org/db/searches/basic?class=Any&query=$1&Search=Search>$wp</a>";          return "<a href='http://www.wormbase.org/db/searches/basic?class=Any&query=$1&Search=Search' target=_blank>$wp</a>";
1440      }      }
1441      return $wp;      return $wp;
1442  }  }
# Line 1244  Line 1449 
1449    
1450      if ($fb =~ /^FB:(\S+)$/)      if ($fb =~ /^FB:(\S+)$/)
1451      {      {
1452          return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";          return "<a href='http://flybase.bio.indiana.edu/.bin/fbidq.html?$1' target=_blank>$fb</a>";
1453      }      }
1454      return $fb;      return $fb;
1455  }  }
# Line 1257  Line 1462 
1462    
1463      if ($fb =~ /^FlyBaseORFNames:(\S+)$/)      if ($fb =~ /^FlyBaseORFNames:(\S+)$/)
1464      {      {
1465          return "<a href=http://flybase.bio.indiana.edu/.bin/fbidq.html?$1>$fb</a>";          return "<a href='http://flybase.bio.indiana.edu/.bin/fbidq.html?$1' target=_blank>$fb</a>";
1466      }      }
1467      return $fb;      return $fb;
1468  }  }
# Line 1270  Line 1475 
1475    
1476      if ($sgd =~ /^SGD_LOCUS:(\S+)$/)      if ($sgd =~ /^SGD_LOCUS:(\S+)$/)
1477      {      {
1478          return "<a href=http://db.yeastgenome.org/cgi-bin/locus.pl?locus=$1>$sgd</a>";          return "<a href='http://db.yeastgenome.org/cgi-bin/locus.pl?locus=$1' target=_blank>$sgd</a>";
1479      }      }
1480      return $sgd;      return $sgd;
1481  }  }
# Line 1301  Line 1506 
1506      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1507      my($cgi,$map,$org) = @_;      my($cgi,$map,$org) = @_;
1508    
1509      $user = $cgi->param('user');      my $user = $cgi->param('user');
1510      $user = $user ? $user : "";      $user = $user ? $user : "";
1511      $org = $org ? $org : "";      $org = $org ? $org : "";
1512    
# Line 1319  Line 1524 
1524    # -name => field and the checkbox name    # -name => field and the checkbox name
1525    my ($form, $button)=@_;    my ($form, $button)=@_;
1526    
1527    $java_script="<input type=\"button\" name=\"CheckAll\" value=\"Check All\"\nonClick=\"checkAll(document.$form.$button)\">\n";    my $java_script="<input type=\"button\" name=\"CheckAll\" value=\"Check All\"\nonClick=\"checkAll(document.$form.$button)\">\n";
1528    $java_script.="<input type=\"button\" name=\"CheckFirst\" value=\"Check First Half\"\nonClick=\"checkFirst(document.$form.$button)\">\n";    $java_script.="<input type=\"button\" name=\"CheckFirst\" value=\"Check First Half\"\nonClick=\"checkFirst(document.$form.$button)\">\n";
1529    $java_script.="<input type=\"button\" name=\"CheckSecond\" value=\"Check Second Half\"\nonClick=\"checkSecond(document.$form.$button)\">\n";    $java_script.="<input type=\"button\" name=\"CheckSecond\" value=\"Check Second Half\"\nonClick=\"checkSecond(document.$form.$button)\">\n";
1530    $java_script.="<input type=\"button\" name=\"UnCheckAll\" value=\"Uncheck All\"\nonClick=\"uncheckAll(document.$form.$button)\">\n";    $java_script.="<input type=\"button\" name=\"UnCheckAll\" value=\"Uncheck All\"\nonClick=\"uncheckAll(document.$form.$button)\">\n";
# Line 1333  Line 1538 
1538      my($sub_link);      my($sub_link);
1539    
1540      my $user = $cgi->param('user');      my $user = $cgi->param('user');
1541        my $esc_sub = uri_escape( $sub );
1542        $sub =~ s/\_/ /g;
1543      if ($user)      if ($user)
1544      {      {
         my $esc_sub = uri_escape( $sub );  
1545          $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>";
1546      }      }
1547      else      else
1548      {      {
1549          $sub_link = $sub;          $sub_link = "<a href=\"display_subsys.cgi?ssa_name=$esc_sub&request=show_ssa&sort=by_phylo\">$sub</a>";
1550      }      }
1551      return $sub_link;      return $sub_link;
1552  }  }
1553    
1554  sub reaction_link {  sub reaction_link {
1555      my($reaction) = @_;      my($reaction) = @_;
1556        if ($reaction =~ /^(\*)?(R\d+)/)
     if ($reaction =~ /^R\d+/)  
1557      {      {
1558          return "<a href=\"http://www.genome.ad.jp/dbget-bin/www_bget?rn+$reaction\" target=reaction$$>$reaction</a>";          return "<a href=\"http://www.genome.ad.jp/dbget-bin/www_bget?rn+$2\" target=reaction$$>$reaction</a>";
1559      }      }
1560      return $reaction;      return $reaction;
1561  }  }
1562    
1563    
1564  sub html_for_assignments {  sub html_for_assignments {
1565      my($fig,$user,$peg_sets) = @_;      my($fig,$user,$peg_sets) = @_;
1566      my $i;      my $i;
1567    
1568      my @vals = ();      my @vals = ();
1569      my $set = 1;      my $set = 1;
1570      foreach $peg_set (@$peg_sets)      foreach my $peg_set (@$peg_sets)
1571      {      {
1572          for ($i=0; ($i < @$peg_set); $i++)          for ($i=0; ($i < @$peg_set); $i++)
1573          {          {
1574              $peg = $peg_set->[$i];              my $peg = $peg_set->[$i];
1575              push(@vals,'show=' . join("@",($set,$i+1,$peg,&FIG::abbrev($fig->org_of($peg)),"")));              push(@vals,'show=' . join("@",($set,$i+1,$peg,&FIG::abbrev($fig->org_of($peg)),"")));
1576          }          }
1577          $set++;          $set++;
# Line 1476  Line 1682 
1682    
1683    
1684   my @files=("SEED.rss");   my @files=("SEED.rss");
1685   if ($args->{"type"}) {push @files, "SEED.$type.rss"}   if ($args->{"type"}) {
1686        my $type = $args->{type};
1687        push @files, "SEED.$type.rss"
1688    }
1689    
1690   foreach my $file ("SEED.rss", @$files)   foreach my $file ("SEED.rss", @$files)
1691   {   {

Legend:
Removed from v.1.75  
changed lines
  Added in v.1.101

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3