[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.81, Tue Jan 24 23:51:22 2006 UTC revision 1.109, Wed Nov 29 15:19:19 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 53  Line 57 
57    
58      my @parts = split(/\//, $ENV{SCRIPT_NAME});      my @parts = split(/\//, $ENV{SCRIPT_NAME});
59      my $top;      my $top;
60      if ($parts[-2] eq 'FIG')      if (defined $parts[-2] && $parts[-2] eq 'FIG')
61      {      {
62          $top = '.';          $top = '.';
63  #       warn "toplevel @parts\n";  #       warn "toplevel @parts\n";
64      }      }
65      elsif ($parts[-3] eq 'FIG')      elsif (defined $parts[-3] && $parts[-3] eq 'FIG')
66      {      {
67          $top = '..';          $top = '..';
68  #       warn "subdir @parts\n";  #       warn "subdir @parts\n";
# 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 171  Line 177 
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 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);
540    
541      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";
542      my $width = defined $options{width} ? "width=\"$options{width}\"" : undef;      my $width = defined $options{width} ? "width=\"$options{width}\"" : "";
543      my $class = defined $options{class} ? "class=\"$options{class}\"" : undef;      my $class = defined $options{class} ? "class=\"$options{class}\"" : "";
544      push( @tab, "\n<table $border $width $class>\n",      push( @tab, "\n<table $border $width $class>\n",
545                  "\t<caption><b>$title</b></caption>\n",                  "\t<caption><b>$title</b></caption>\n",
546                  "\t<tr>\n\t\t"                  "\t<tr>\n\t\t"
# 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    
# Line 780  Line 808 
808      return "<a href=$link>$role</a>";      return "<a href=$link>$role</a>";
809  }  }
810    
811  #  =head2 fid_link
812  # Local means to eliminate the fig|org.peg from the  
813  # text of the link.  Get a link to a fid.
814  #  
815    use: my $html=&HTML::fid_link($cgi, $fid, Local, Just_URL, Full_Path);
816    
817    Local is a boolean means to eliminate the fig|org.peg from the text of the link.
818    
819    Just_URL will only return the URL and not the HTML code. The default is to return the full code.
820    
821    Full_Path is a boolean that will get the full path to the URL not just a relative path. This is required in pages where the base href changes (e.g. if an image is imported like on the metabolic pages).
822    
823    =cut
824    
825    
826  sub fid_link {  sub fid_link {
827      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
828      my($cgi,$fid,$local,$just_url) = @_;      my($cgi,$fid,$local,$just_url,$fullpath) = @_;
829        Trace("Creating link for feature $fid.") if T(4);
830        my $err=join(" ", $cgi,$fid,$local,$just_url,$fullpath);
831    
832      my($n);      my($n);
833    
834      my $top = top_link();      my $top = top_link();
835        if ($fullpath) {$top=$FIG_Config::cgi_url}
836    
837      if ($fid =~ /^fig\|\d+\.\d+\.([a-z]+)\.(\d+)/)      if ($fid =~ /^fig\|\d+\.\d+\.([a-z]+)\.(\d+)/)
838      {      {
# Line 810  Line 853 
853          }          }
854    
855          my $link;          my $link;
856            my $new_framework = $cgi->param('new_framework') ? 1 : 0;
857          #added to format prophage and path island links to feature.cgi          #added to format prophage and path island links to feature.cgi
858          if ($1 ne "peg")          my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";
859            my $virt = "&48hr_job=" . $cgi->param("48hr_job");
860            Trace("Sprout mode is \"$sprout\".") if T(4);
861            if ($1 ne "peg" && ! $sprout)
862          {          {
863               Trace("Creating feature link for $fid.") if T(4);
864             my $user = $cgi->param('user');             my $user = $cgi->param('user');
865             if (! $user) { $user = "" }             if (! $user) { $user = "" }
866             my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";             $link = "$top/feature.cgi?feature=$fid&user=$user$sprout$virt";
            $link = "$top/feature.cgi?feature=$fid&user=$user$trans$sprout";  
867             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;             $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;
868          }          }
869          else          else
870          {          {
871                Trace("Creating protein link for $fid.") if T(4);
872              my $user = $cgi->param('user');              my $user = $cgi->param('user');
873              if (! $user) { $user = "" }              if (! $user) { $user = "" }
874              my $trans = $cgi->param('translate') ? "&translate=1" : "";              my $trans = $cgi->param('translate') ? "&translate=1" : "";
# Line 836  Line 884 
884    
885              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }
886              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";
887              $link = "$top/protein.cgi?prot=$fid&user=$user$trans$sprout";              $link = "$top/protein.cgi?prot=$fid&user=$user$trans$sprout$virt\&new_framework=$new_framework";
888              $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;              $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;
889          }          }
890          if ($just_url)          if ($just_url)
# Line 845  Line 893 
893          }          }
894          else          else
895          {          {
896              return "<a href=$link>$n</a>";              return "<a href='$link'>$n</a>";
897          }          }
898      }      }
899      return $fid;      return $fid;
# Line 858  Line 906 
906      return $family;      return $family;
907  }  }
908    
909    =head2 evidence_codes_explain
910    
911    Given an evidence code, returns a string that explains this eveidence code.
912    
913    =cut
914    
915    sub evidence_codes_explain {
916     my($ec)=@_;
917     return unless ($ec);
918    
919     $ec=uc($ec);
920     return "IDA: Inferred from Direct Assay" if ($ec =~ /IDA/);
921     return "IGI: Inferred from Genetic Interaction" if ($ec =~ /IGI/);
922     return "TAS: Traceable Author Statement" if ($ec =~ /TAS/);
923     return "ISU: in subsystem unique" if ($ec =~ /ISU/);
924     return "$ec: in subsystem duplicates" if ($ec =~ /IDU/);
925     return "$ec: in cluster with" if ($ec =~ /ICW/);
926     return "$ec: unknown!";
927     return "FF: in FIGfam" if ($ec =~ /FF/);
928     return "CWN: clustered with nonhypothetical" if ($ec =~ /CWN/);
929     return "CWH: clustered, but only with hypotheticals" if ($ec =~ /CWH/);
930     return "DLIT: literature references to this gene exist" if ($ec =~ /DLIT/);
931     return "ILIT: no references to this gene exist, but they do to other genes with the same functional role" if ($ec =~ /ILIT/);
932    }
933    
934  sub get_html {  sub get_html {
935      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
# Line 877  Line 949 
949          my $response = $ua->request($request);          my $response = $ua->request($request);
950          $out = $response->content;          $out = $response->content;
951      }      }
952      else  
953        if ($type =~/get/i)
954      {      {
955          @args = ();          @args = ();
956          foreach $x (@$kv_pairs)          foreach $x (@$kv_pairs)
# Line 889  Line 962 
962          {          {
963              $url .= "?" . join("&",@args);              $url .= "?" . join("&",@args);
964          }          }
965          $request = new HTTP::Request('GET', $url);          my $request = new HTTP::Request('GET', $url);
966          my $response = $ua->request($request);          my $response = $ua->request($request);
967    
968          if ($response->is_success)          if ($response->is_success)
# Line 907  Line 980 
980    
981  #   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
982  #   properly.  Remove the header.  #   properly.  Remove the header.
983        my $i;
984      for ($i=0; ($i < @output) && ($output[$i] !~ /^\s*\</); $i++) {}      for ($i=0; ($i < @output) && ($output[$i] !~ /^\s*\</); $i++) {}
985      if ($i < @output)      if ($i < @output) {
     {  
   
986          splice(@output,0,$i);          splice(@output,0,$i);
987      }      }
988    
# Line 927  Line 998 
998  sub trim_output {  sub trim_output {
999      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1000      my($out) = @_;      my($out) = @_;
1001      my $i;      my ($i, $j);
1002    
1003      for ($i=0; ($i < @$out) && ($out->[$i] !~ /^\</); $i++) {}      for ($i=0; ($i < @$out) && ($out->[$i] !~ /^\</); $i++) {}
1004      splice(@$out,0,$i);      splice(@$out,0,$i);
# Line 956  Line 1027 
1027      for ($j=$i-1; ($j > 0) && ($out->[$j] !~ /FIG search/); $j--) {}      for ($j=$i-1; ($j > 0) && ($out->[$j] !~ /FIG search/); $j--) {}
1028      if ($j > 0)      if ($j > 0)
1029      {      {
1030            #
1031            # Hm. We would have tried using the options here:
1032            # my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";
1033            # but they're not passed in. So use the default html.tail.
1034            #
1035            my $html_tail_file = "./Html/html.tail";
1036          my @tmp = `cat $html_tail_file`;          my @tmp = `cat $html_tail_file`;
1037          my $n = @tmp;          my $n = @tmp;
1038          splice(@$out,$j-$n,$n+1);          splice(@$out,$j-$n,$n+1);
# Line 988  Line 1065 
1065          $after = $3;          $after = $3;
1066          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);
1067      }      }
1068      elsif ($x =~ /^(.*)(tigr\|[0-9a-zA-Z]+)(.*)/s)      elsif ($x =~ /^(.*)(tigr\|\w+)(.*)/s)
1069      {      {
1070          $before = $1;          $before = $1;
1071          $match = $2;          $match = $2;
1072          $after = $3;          $after = $3;
1073          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);
1074      }      }
1075      elsif ($x =~ /^(.*)\beric\|\w+\b(.*)/s)      elsif ($x =~ /^(.*)\b(eric\|\S+)\b(.*)/s)
1076      {      {
1077          $before = $1;          $before = $1;
1078          $match = $2;          $match = $2;
# Line 1003  Line 1080 
1080          return &set_prot_links($cgi,$before) . &HTML::eric_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::eric_link($cgi,$match) . &set_prot_links($cgi,$after);
1081      }      }
1082    
1083      elsif ($x =~ /^(.*)\bbhb\|.*?\b(.*)/s)      elsif ($x =~ /^(.*)\b(bhb\|.*?)\b(.*)/s)
1084      {      {
1085          $before = $1;          $before = $1;
1086          $match = $2;          $match = $2;
# Line 1011  Line 1088 
1088          return &set_prot_links($cgi,$before) . &HTML::bhb_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::bhb_link($cgi,$match) . &set_prot_links($cgi,$after);
1089      }      }
1090    
1091      elsif ($x =~ /^(.*)\bapidb\|.*?\..*\b(.*)/s)      elsif ($x =~ /^(.*)\b(apidb\|[0-9\.a-z_]+)\b(.*)/s)
1092      {      {
1093          $before = $1;          $before = $1;
1094          $match = $2;          $match = $2;
# Line 1019  Line 1096 
1096          return &set_prot_links($cgi,$before) . &HTML::apidb_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::apidb_link($cgi,$match) . &set_prot_links($cgi,$after);
1097      }      }
1098    
1099      elsif ($x =~ /^(.*)\bpatric\|.*?\b(.*)/s)      elsif ($x =~ /^(.*)\b(patric\|.*?)\b(.*)/s)
1100      {      {
1101          $before = $1;          $before = $1;
1102          $match = $2;          $match = $2;
# Line 1027  Line 1104 
1104          return &set_prot_links($cgi,$before) . &HTML::patric_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::patric_link($cgi,$match) . &set_prot_links($cgi,$after);
1105      }      }
1106    
1107      elsif ($x =~ /^(.*)\bvbrc\|.*?\b(.*)/s)      elsif ($x =~ /^(.*)\b(vbrc\|.*?)\b(.*)/s)
1108      {      {
1109          $before = $1;          $before = $1;
1110          $match = $2;          $match = $2;
# Line 1035  Line 1112 
1112          return &set_prot_links($cgi,$before) . &HTML::vbrc_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::vbrc_link($cgi,$match) . &set_prot_links($cgi,$after);
1113      }      }
1114    
1115      elsif ($x =~ /^(.*)\bvectorbase\|.*?\b(.*)/s)      elsif ($x =~ /^(.*)\b(vectorbase\|.*?)\b(.*)/s)
1116      {      {
1117          $before = $1;          $before = $1;
1118          $match = $2;          $match = $2;
# Line 1091  Line 1168 
1168          $after = $3;          $after = $3;
1169          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);
1170      }      }
1171      elsif ($x =~ /^(.*)(UniGene:[a-zA-Z_0-9\.]+)(.*)/s)      elsif ($x =~ /^(.*)(HGNC:[a-zA-Z_0-9\.]+)(.*)/s)
1172      {      {
1173          $before = $1;          $before = $1;
1174          $match = $2;          $match = $2;
1175          $after = $3;          $after = $3;
1176          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);
1177      }      }
1178      elsif ($x =~ /^(.*)(IPI:[a-zA-Z_0-9\.]+)(.*)/s)      elsif ($x =~ /^(.*)(UniGene:[a-zA-Z_0-9\.]+)(.*)/s)
1179      {      {
1180          $before = $1;          $before = $1;
1181          $match = $2;          $match = $2;
1182          $after = $3;          $after = $3;
1183          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);
1184      }      }
1185    # IPI stopped working. turn off for now.
1186    #    elsif ($x =~ /^(.*)(IPI:[a-zA-Z_0-9\.]+)(.*)/s)
1187    #    {
1188    #        $before = $1;
1189    #        $match = $2;
1190    #        $after = $3;
1191    #        return &set_prot_links($cgi,$before) . &HTML::ipi_link($cgi,$match) . &set_prot_links($cgi,$after);
1192    #    }
1193      elsif ($x =~ /^(.*)(WP:[a-zA-Z_0-9\.]+)(.*)/s)      elsif ($x =~ /^(.*)(WP:[a-zA-Z_0-9\.]+)(.*)/s)
1194      {      {
1195          #wormbase          #wormbase
# Line 1141  Line 1226 
1226          $after = $3;          $after = $3;
1227          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);
1228      }      }
1229        elsif ($x =~ /^(.*)(tr\|[a-zA-Z0-9]+)(.*)/s)
1230        {
1231    
1232          $before = $1;
1233          $match = $2;
1234          $after = $3;
1235    
1236          return &set_prot_links($cgi,$before) .  &HTML::trembl_link($cgi,$match) . &set_prot_links($cgi,$after);
1237        }
1238      return $x;      return $x;
1239  }  }
1240    
1241    sub trembl_link {
1242        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1243        my($cgi,$id) = @_;
1244    
1245        if ($id =~ /^tr\|(.*)/) {
1246          return "<a href='http://ca.expasy.org/uniprot/$1' target=_blank>$id</a>";
1247        } else {
1248          return "invalid call to trembl link";
1249        }
1250    }
1251    
1252  sub refseq_link {  sub refseq_link {
1253      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1254      my($cgi,$id) = @_;      my($cgi,$id) = @_;
1255    
1256      if ($id =~ /^[NXYZA]P_/)      if ($id =~ /^[NXYZA]P_/)
1257      {      {
1258          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>";
1259      }      }
1260      elsif ($id =~ /^[NXYZA]M_/)      elsif ($id =~ /^[NXYZA]M_/)
1261      {      {
1262          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>";
1263      }      }
1264  }  }
1265    
# Line 1164  Line 1269 
1269    
1270      if ($gi =~ /^gi\|(\d+)$/)      if ($gi =~ /^gi\|(\d+)$/)
1271      {      {
1272          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>";
1273      }      }
1274      return $gi;      return $gi;
1275  }  }
# Line 1173  Line 1278 
1278      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1279      my($cgi,$tigr) = @_;      my($cgi,$tigr) = @_;
1280    
1281      if ($tigr =~ /^tigr\|(NT|ntbp|ntbpA|BA|BMAA|BXB|GBA)([0-9a-zA-Z]+)$/)      if ($tigr =~ /^tigr\|(NT|ntbp|ntbpA|BA|BMAA|BXB|GBA)(\w+)$/)
1282      {      {
1283          my $id=$1.$2;          my $id=$1.$2;
1284          return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\">$tigr</a> (Pathema)";          return "<a href=\"http://pathema.tigr.org/tigr-scripts/pathema/shared/GenePage.cgi?locus=$id\" target=_blank>$tigr</a> (Pathema)";
1285      }      }
1286      elsif ($tigr =~ /^tigr\|([0-9a-zA-Z]+)$/)      elsif ($tigr =~ /^tigr\|(\S+)$/)
1287      {      {
1288          return "<a href=\"http://www.tigr.org/tigr-scripts/CMR2/GenePage.spl?locus=$1\">$?tigr</a>";          return "<a href=\"http://www.tigr.org/tigr-scripts/CMR2/GenePage.spl?locus=$1\" target=_blank>$tigr</a>";
1289      }      }
1290      return $tigr;      return $tigr;
1291  }  }
# Line 1189  Line 1294 
1294      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1295      my($cgi,$eric) = @_;      my($cgi,$eric) = @_;
1296    
1297      if ($eric =~ /^eric\|(\w+)$/)      if ($eric =~ /^eric\|(\S+)/)
1298      {      {
1299          return "<a href=\"https://asap.ahabs.wisc.edu/asap/feature_info.php?FeatureID=$1\">$eric</a>";          return "<a href=\"https://asap.ahabs.wisc.edu/asap/feature_info.php?FeatureID=$1\" target=_blank>$eric</a>";
1300      }      }
1301      return $eric;      return $eric;
1302  }  }
# Line 1200  Line 1305 
1305      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1306      my($cgi,$bhb) = @_;      my($cgi,$bhb) = @_;
1307    
1308      return "<a href=\"http://www.biohealthbase.org\">$bhb</a>";      return "<a href=\"http://www.biohealthbase.org\" target=_blank>$bhb</a>";
1309  }  }
1310    
1311  sub apidb_link {  sub apidb_link {
# Line 1209  Line 1314 
1314    
1315      if ($api =~ /apidb\|(.*?)\.(.*)$/)      if ($api =~ /apidb\|(.*?)\.(.*)$/)
1316      {      {
1317          return "<a href=\"http://www.apidb.org/cgi-bin/redirect.cgi?taxon_id=$1&source_id=$2\">$api</a>";          return "<a href=\"http://www.apidb.org/cgi-bin/redirect.cgi?taxon_id=$1&source_id=$2\" target=_blank>$api</a>";
1318      }      }
1319      return $api;      return $api;
1320  }  }
# Line 1220  Line 1325 
1325    
1326      if ($patric =~ /patric\|(.*)/)      if ($patric =~ /patric\|(.*)/)
1327      {      {
1328          return "<a href=\"https://patric.vbi.vt.edu/software/curationTool/gep/pgiCuration.php?locus_name=$1\">$patric</a>";          return "<a href=\"https://patric.vbi.vt.edu/software/curationTool/gep/pgiCuration.php?locus_name=$1\" target=_blank>$patric</a>";
1329      }      }
1330      return $patric;      return $patric;
1331  }  }
# Line 1231  Line 1336 
1336    
1337      if ($vbrc =~ /vbrc\|(.*)/)      if ($vbrc =~ /vbrc\|(.*)/)
1338      {      {
1339          return "<a href=\"http://www.biovirus.org/gene_detail.asp?name=$1\">$vbrc</a>";          return "<a href=\"http://www.biovirus.org/gene_detail.asp?name=$1\" target=_blank>$vbrc</a>";
1340      }      }
1341      return $vbrc;      return $vbrc;
1342  }  }
# Line 1239  Line 1344 
1344  sub vectorbase_link {  sub vectorbase_link {
1345      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1346      my($cgi,$vec) = @_;      my($cgi,$vec) = @_;
1347      return "<a href=\"http://www.vectorbase.org\">$vec</a>";      return "<a href=\"http://www.vectorbase.org\" target=_blank>$vec</a>";
1348  }  }
1349    
1350    
# Line 1249  Line 1354 
1354    
1355      if ($uni =~ /^uni\|(\S+)$/)      if ($uni =~ /^uni\|(\S+)$/)
1356      {      {
1357          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>";
1358            return "<a href='http://www.ebi.uniprot.org/uniprot-srv/uniProtView.do?proteinAc=$1' target=_blank>$uni</a>";
1359      }      }
1360      return $uni;      return $uni;
1361  }  }
# Line 1260  Line 1366 
1366    
1367      if ($sp =~ /^sp\|(\S+)$/)      if ($sp =~ /^sp\|(\S+)$/)
1368      {      {
1369          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>";
1370      }      }
1371      return $sp;      return $sp;
1372  }  }
# Line 1271  Line 1377 
1377    
1378      if ($pir =~ /^pirnr\|(NF\d+)$/)      if ($pir =~ /^pirnr\|(NF\d+)$/)
1379      {      {
1380          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>";
1381      }      }
1382      return $pir;      return $pir;
1383  }  }
# Line 1282  Line 1388 
1388    
1389      if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)      if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)
1390      {      {
1391          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>";
1392      }      }
1393      return $kegg;      return $kegg;
1394  }  }
# Line 1295  Line 1401 
1401      {      {
1402          my $what=$1;          my $what=$1;
1403          my $key=$2;          my $key=$2;
1404          my $idx="all";          my $idx="All";
1405          if ($what eq "EnsemblGene") { $idx = "Gene" }          if ($what eq "EnsemblGene") { $idx = "Gene" }
1406          if ($what eq "EnsemblTranscript") { $idx = "all" }          if ($what eq "EnsemblTranscript") { $idx = "All" }
1407          if ($what eq "EnsemblProtein") { $idx = "all" }          if ($what eq "EnsemblProtein") { $idx = "All" }
1408    
1409          #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
1410          #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
1411          #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)
1412    
1413          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>";
1414      }      }
1415      return $ensembl;      return $ensembl;
1416  }  }
# Line 1315  Line 1421 
1421    
1422      if ($entrezgene =~ /^EntrezGene:(\S+)$/)      if ($entrezgene =~ /^EntrezGene:(\S+)$/)
1423      {      {
1424          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>";
1425      }      }
1426      return $entrezgene;      return $entrezgene;
1427  }  }
# Line 1326  Line 1432 
1432    
1433      if ($mim =~ /^MIM:(\S+)$/)      if ($mim =~ /^MIM:(\S+)$/)
1434      {      {
1435          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>";
1436      }      }
1437      return $mim;      return $mim;
1438  }  }
1439    
1440    sub hgnc_link {
1441        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1442        my($cgi,$hgnc) = @_;
1443    
1444        if ($hgnc =~ /^HGNC:(\S+)$/)
1445        {
1446            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>";
1447        }
1448    
1449        return $hgnc;
1450    }
1451    
1452  sub unigene_link {  sub unigene_link {
1453      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1454      my($cgi,$unigene) = @_;      my($cgi,$unigene) = @_;
1455    
1456      if ($unigene =~ /^UniGene:(\S+)$/)      if ($unigene =~ /^UniGene:(\S+)$/)
1457      {      {
1458          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>";
1459      }      }
1460      return $unigene;      return $unigene;
1461  }  }
# Line 1348  Line 1466 
1466    
1467      if ($ipi =~ /^IPI:(\S+)$/)      if ($ipi =~ /^IPI:(\S+)$/)
1468      {      {
1469          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>";
1470      }      }
1471      return $ipi;      return $ipi;
1472  }  }
# Line 1361  Line 1479 
1479    
1480      if ($wp =~ /^WP:(\S+)$/)      if ($wp =~ /^WP:(\S+)$/)
1481      {      {
1482          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>";
1483      }      }
1484      return $wp;      return $wp;
1485  }  }
# Line 1374  Line 1492 
1492    
1493      if ($fb =~ /^FB:(\S+)$/)      if ($fb =~ /^FB:(\S+)$/)
1494      {      {
1495          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>";
1496      }      }
1497      return $fb;      return $fb;
1498  }  }
# Line 1387  Line 1505 
1505    
1506      if ($fb =~ /^FlyBaseORFNames:(\S+)$/)      if ($fb =~ /^FlyBaseORFNames:(\S+)$/)
1507      {      {
1508          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>";
1509      }      }
1510      return $fb;      return $fb;
1511  }  }
# Line 1400  Line 1518 
1518    
1519      if ($sgd =~ /^SGD_LOCUS:(\S+)$/)      if ($sgd =~ /^SGD_LOCUS:(\S+)$/)
1520      {      {
1521          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>";
1522      }      }
1523      return $sgd;      return $sgd;
1524  }  }
# Line 1431  Line 1549 
1549      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1550      my($cgi,$map,$org) = @_;      my($cgi,$map,$org) = @_;
1551    
1552      $user = $cgi->param('user');      my $user = $cgi->param('user');
1553      $user = $user ? $user : "";      $user = $user ? $user : "";
1554      $org = $org ? $org : "";      $org = $org ? $org : "";
1555    
# Line 1449  Line 1567 
1567    # -name => field and the checkbox name    # -name => field and the checkbox name
1568    my ($form, $button)=@_;    my ($form, $button)=@_;
1569    
1570    $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";
1571    $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";
1572    $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";
1573    $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 1457  Line 1575 
1575    return $java_script;    return $java_script;
1576  }  }
1577    
1578    =head3 sub_link
1579    
1580    C<< my $htmlText = HTML::sub_link($cgi, $sub); >>
1581    
1582    Create a subsystem link. The link will be to the display page if there is no
1583    user or we are in SPROUT mode; otherwise it will be to the edit page.
1584    
1585    =over 4
1586    
1587    =item cgi
1588    
1589    CGI query object for the current web session. The parameters of special interest
1590    are C<SPROUT> and C<user>. If the user is non-blank and SPROUT mode is 0, then
1591    the subsystem's edit page will be shown rather than its display page.
1592    
1593    =item sub
1594    
1595    Name of the desired subsystem. It will be cleaned of underscores before the
1596    hyperlink is applied.
1597    
1598    =back
1599    
1600    =cut
1601    
1602  sub sub_link {  sub sub_link {
1603        # Allow call as an instance in addition to the authorized method.
1604      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1605        # Get the parameters.
1606      my($cgi,$sub) = @_;      my($cgi,$sub) = @_;
1607      my($sub_link);      # Declare the return variable.
1608        my $retVal;
1609      my $user = $cgi->param('user');      # Clean the subsystem name for display purposes. This is a very
1610      if ($user)      # different thing from URL-escaping.
1611      {      my $cleaned = CGI::escapeHTML($sub);
1612          my $esc_sub = uri_escape( $sub );      $cleaned =~ s/_/ /g;
1613          $sub =~ s/\_/ /g;      # URL-escape the subsystem name for use in the link.
1614          $sub_link = "<a href=./subsys.cgi?ssa_name=$esc_sub&request=show_ssa&user=$user>$sub</a>";      my $linkable = uri_escape($sub);
1615      }      # Determine the mode. Note we use the little OR trick to insure that
1616      else      # we have the correct value for plugging into the output link.
1617      {      my $user = $cgi->param('user') || "";
1618          $sub_link = $sub;      my $sproutMode = $cgi->param('SPROUT') || 0;
1619        if ($user && ! $sproutMode) {
1620            # A SEED user is calling, so we go to the edit page.
1621            $retVal = "<a href=\"subsys.cgi?ssa_name=$linkable&request=show_ssa&user=$user\">$cleaned</a>";
1622        } else {
1623            # A visitor or SPROUT user is calling, so we go to the display page.
1624            $retVal = "<a href=\"display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;SPROUT=$sproutMode\">$cleaned</a>";
1625      }      }
1626      return $sub_link;      # Return the result.
1627        return $retVal;
1628  }  }
1629    
1630    
1631  sub reaction_link {  sub reaction_link {
1632      my($reaction) = @_;      my($reaction) = @_;
1633        if ($reaction =~ /^(\*)?(R\d+)/)
     if ($reaction =~ /^R\d+/)  
1634      {      {
1635          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>";
1636      }      }
1637      return $reaction;      return $reaction;
1638  }  }
1639    
1640    
1641  sub html_for_assignments {  sub html_for_assignments {
1642      my($fig,$user,$peg_sets) = @_;      my($fig,$user,$peg_sets) = @_;
1643      my $i;      my $i;
1644    
1645      my @vals = ();      my @vals = ();
1646      my $set = 1;      my $set = 1;
1647      foreach $peg_set (@$peg_sets)      foreach my $peg_set (@$peg_sets)
1648      {      {
1649          for ($i=0; ($i < @$peg_set); $i++)          for ($i=0; ($i < @$peg_set); $i++)
1650          {          {
1651              $peg = $peg_set->[$i];              my $peg = $peg_set->[$i];
1652              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)),"")));
1653          }          }
1654          $set++;          $set++;
# Line 1607  Line 1759 
1759    
1760    
1761   my @files=("SEED.rss");   my @files=("SEED.rss");
1762   if ($args->{"type"}) {push @files, "SEED.$type.rss"}   if ($args->{"type"}) {
1763        my $type = $args->{type};
1764        push @files, "SEED.$type.rss"
1765    }
1766    
1767   foreach my $file ("SEED.rss", @$files)   foreach my $file ("SEED.rss", @$files)
1768   {   {

Legend:
Removed from v.1.81  
changed lines
  Added in v.1.109

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3