[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.99, Tue Sep 19 21:19:14 2006 UTC revision 1.107, Sun Nov 5 03:50:10 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!  #use raelib; # now used for the excel function, that should eventually end up in here. Way too experimental!
33  my $raelib=new raelib;  my $raelib;
34    
35    
36  my $top_link_cache;  my $top_link_cache;
# Line 56  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 181  Line 182 
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 415  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 537  Line 539 
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 558  Line 560 
560      push(@tab,"</table>\n");      push(@tab,"</table>\n");
561    
562      # excelfile should be appropriate for a filename (no spaces/special characters)      # excelfile should be appropriate for a filename (no spaces/special characters)
563      if (defined $options{"excelfile"}) {push @tab, $raelib->tab2excel($col_hdrs,$tab,$title,\%options,$options{"excelfile"})}      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  }  }
# Line 801  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 834  Line 856 
856          my $new_framework = $cgi->param('new_framework') ? 1 : 0;          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          my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";          my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";
859            Trace("Sprout mode is \"$sprout\".") if T(4);
860          if ($1 ne "peg" && ! $sprout)          if ($1 ne "peg" && ! $sprout)
861          {          {
862               Trace("Creating feature link for $fid.") if T(4);
863             my $user = $cgi->param('user');             my $user = $cgi->param('user');
864             if (! $user) { $user = "" }             if (! $user) { $user = "" }
865             $link = "$top/feature.cgi?feature=$fid&user=$user$sprout";             $link = "$top/feature.cgi?feature=$fid&user=$user$sprout";
# Line 843  Line 867 
867          }          }
868          else          else
869          {          {
870                Trace("Creating protein link for $fid.") if T(4);
871              my $user = $cgi->param('user');              my $user = $cgi->param('user');
872              if (! $user) { $user = "" }              if (! $user) { $user = "" }
873              my $trans = $cgi->param('translate') ? "&translate=1" : "";              my $trans = $cgi->param('translate') ? "&translate=1" : "";
# Line 912  Line 937 
937          {          {
938              $url .= "?" . join("&",@args);              $url .= "?" . join("&",@args);
939          }          }
940          $request = new HTTP::Request('GET', $url);          my $request = new HTTP::Request('GET', $url);
941          my $response = $ua->request($request);          my $response = $ua->request($request);
942    
943          if ($response->is_success)          if ($response->is_success)
# Line 930  Line 955 
955    
956  #   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
957  #   properly.  Remove the header.  #   properly.  Remove the header.
958        my $i;
959      for ($i=0; ($i < @output) && ($output[$i] !~ /^\s*\</); $i++) {}      for ($i=0; ($i < @output) && ($output[$i] !~ /^\s*\</); $i++) {}
960      if ($i < @output)      if ($i < @output) {
     {  
   
961          splice(@output,0,$i);          splice(@output,0,$i);
962      }      }
963    
# Line 950  Line 973 
973  sub trim_output {  sub trim_output {
974      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
975      my($out) = @_;      my($out) = @_;
976      my $i;      my ($i, $j);
977    
978      for ($i=0; ($i < @$out) && ($out->[$i] !~ /^\</); $i++) {}      for ($i=0; ($i < @$out) && ($out->[$i] !~ /^\</); $i++) {}
979      splice(@$out,0,$i);      splice(@$out,0,$i);
# Line 979  Line 1002 
1002      for ($j=$i-1; ($j > 0) && ($out->[$j] !~ /FIG search/); $j--) {}      for ($j=$i-1; ($j > 0) && ($out->[$j] !~ /FIG search/); $j--) {}
1003      if ($j > 0)      if ($j > 0)
1004      {      {
1005            #
1006            # Hm. We would have tried using the options here:
1007            # my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";
1008            # but they're not passed in. So use the default html.tail.
1009            #
1010            my $html_tail_file = "./Html/html.tail";
1011          my @tmp = `cat $html_tail_file`;          my @tmp = `cat $html_tail_file`;
1012          my $n = @tmp;          my $n = @tmp;
1013          splice(@$out,$j-$n,$n+1);          splice(@$out,$j-$n,$n+1);
# Line 1391  Line 1420 
1420      {      {
1421          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>";          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>";
1422      }      }
1423      return $mim;  
1424        return $hgnc;
1425  }  }
1426    
1427  sub unigene_link {  sub unigene_link {
# Line 1494  Line 1524 
1524      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1525      my($cgi,$map,$org) = @_;      my($cgi,$map,$org) = @_;
1526    
1527      $user = $cgi->param('user');      my $user = $cgi->param('user');
1528      $user = $user ? $user : "";      $user = $user ? $user : "";
1529      $org = $org ? $org : "";      $org = $org ? $org : "";
1530    
# Line 1512  Line 1542 
1542    # -name => field and the checkbox name    # -name => field and the checkbox name
1543    my ($form, $button)=@_;    my ($form, $button)=@_;
1544    
1545    $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";
1546    $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";
1547    $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";
1548    $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 1520  Line 1550 
1550    return $java_script;    return $java_script;
1551  }  }
1552    
1553    =head3 sub_link
1554    
1555    C<< my $htmlText = HTML::sub_link($cgi, $sub); >>
1556    
1557    Create a subsystem link. The link will be to the display page if there is no
1558    user or we are in SPROUT mode; otherwise it will be to the edit page.
1559    
1560    =over 4
1561    
1562    =item cgi
1563    
1564    CGI query object for the current web session. The parameters of special interest
1565    are C<SPROUT> and C<user>. If the user is non-blank and SPROUT mode is 0, then
1566    the subsystem's edit page will be shown rather than its display page.
1567    
1568    =item sub
1569    
1570    Name of the desired subsystem. It will be cleaned of underscores before the
1571    hyperlink is applied.
1572    
1573    =back
1574    
1575    =cut
1576    
1577  sub sub_link {  sub sub_link {
1578        # Allow call as an instance in addition to the authorized method.
1579      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
1580        # Get the parameters.
1581      my($cgi,$sub) = @_;      my($cgi,$sub) = @_;
1582      my($sub_link);      # Declare the return variable.
1583        my $retVal;
1584      my $user = $cgi->param('user');      # Clean the subsystem name for display purposes. This is a very
1585      my $esc_sub = uri_escape( $sub );      # different thing from URL-escaping.
1586      $sub =~ s/\_/ /g;      my $cleaned = CGI::escapeHTML($sub);
1587      if ($user)      $cleaned =~ s/_/ /g;
1588      {      # URL-escape the subsystem name for use in the link.
1589          $sub_link = "<a href=./subsys.cgi?ssa_name=$esc_sub&request=show_ssa&user=$user>$sub</a>";      my $linkable = uri_escape($sub);
1590      }      # Determine the mode. Note we use the little OR trick to insure that
1591      else      # we have the correct value for plugging into the output link.
1592      {      my $user = $cgi->param('user') || "";
1593          $sub_link = "<a href=\"display_subsys.cgi?ssa_name=$esc_sub&request=show_ssa&sort=by_phylo\">$sub</a>";      my $sproutMode = $cgi->param('SPROUT') || 0;
1594        if ($user && ! $sproutMode) {
1595            # A SEED user is calling, so we go to the edit page.
1596            $retVal = "<a href=\"subsys.cgi?ssa_name=$linkable&request=show_ssa&user=$user\">$cleaned</a>";
1597        } else {
1598            # A visitor or SPROUT user is calling, so we go to the display page.
1599            $retVal = "<a href=\"display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;SPROUT=$sproutMode\">$cleaned</a>";
1600      }      }
1601      return $sub_link;      # Return the result.
1602        return $retVal;
1603  }  }
1604    
1605    
1606  sub reaction_link {  sub reaction_link {
1607      my($reaction) = @_;      my($reaction) = @_;
1608      if ($reaction =~ /^(\*)?(R\d+)/)      if ($reaction =~ /^(\*)?(R\d+)/)
# Line 1555  Line 1619 
1619    
1620      my @vals = ();      my @vals = ();
1621      my $set = 1;      my $set = 1;
1622      foreach $peg_set (@$peg_sets)      foreach my $peg_set (@$peg_sets)
1623      {      {
1624          for ($i=0; ($i < @$peg_set); $i++)          for ($i=0; ($i < @$peg_set); $i++)
1625          {          {
1626              $peg = $peg_set->[$i];              my $peg = $peg_set->[$i];
1627              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)),"")));
1628          }          }
1629          $set++;          $set++;
# Line 1670  Line 1734 
1734    
1735    
1736   my @files=("SEED.rss");   my @files=("SEED.rss");
1737   if ($args->{"type"}) {push @files, "SEED.$type.rss"}   if ($args->{"type"}) {
1738        my $type = $args->{type};
1739        push @files, "SEED.$type.rss"
1740    }
1741    
1742   foreach my $file ("SEED.rss", @$files)   foreach my $file ("SEED.rss", @$files)
1743   {   {

Legend:
Removed from v.1.99  
changed lines
  Added in v.1.107

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3