[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.6, Sun Mar 21 02:20:55 2004 UTC revision 1.18, Wed Aug 4 12:30:40 2004 UTC
# Line 6  Line 6 
6  use LWP::Simple;  use LWP::Simple;
7  use URI::URL;  use URI::URL;
8  use HTTP::Request::Common;  use HTTP::Request::Common;
9    use POSIX;
10    
11  sub show_page {  sub show_page {
12      my($cgi,$html,$no_home) = @_;      my($cgi,$html,$no_home) = @_;
# Line 27  Line 28 
28          $html_tail_file = "$FIG_Config::fig/CGI/Html/html.tail";          $html_tail_file = "$FIG_Config::fig/CGI/Html/html.tail";
29      }      }
30    
31        my @html_hdr = &FIG::file_read($html_hdr_file);
32        my $user = $cgi->param('user') || "";
33        push( @html_hdr, "<br><a href=\"index.cgi?user=$user\">FIG search</a>\n" );
34    
35        if (@html_hdr)
36        {
37            my $insert_stuff;
38            my @ver = &FIG::file_head("$FIG_Config::fig_disk/CURRENT_RELEASE", 1);
39            my $ver = $ver[0];
40            chomp $ver;
41            if ($ver =~ /^cvs\.(\d+)$/)
42            {
43                my $d = asctime(localtime($1));
44                chomp($d);
45                $ver .=  " ($d)";
46            }
47            my $host = &FIG::get_local_hostname();
48            $insert_stuff = "SEED version <b>$ver</b> on $host";
49    
50            for $_ (@html_hdr)
51            {
52                s,(href|img\s+src)="/FIG/,\1="$FIG_Config::cgi_base,g;
53                if ($_ eq "<!-- HEADER_INSERT -->\n")
54                {
55                    $_ = $insert_stuff;
56                }
57            }
58        }
59    
60    
61      print $cgi->header;      print $cgi->header;
62    
# Line 156  Line 186 
186      #  Seed page header (if it exists) goes after <BODY>      #  Seed page header (if it exists) goes after <BODY>
187      #      #
188    
189      if ( -f $html_hdr_file )      if (@html_hdr)
190      {      {
191          splice( @$html, $body_line + 1, 0, `cat $html_hdr_file` );          splice( @$html, $body_line + 1, 0, @html_hdr );
192      }      }
193    
194      #      #
# Line 183  Line 213 
213          #  only, or every update?), I provide an alternative derivation          #  only, or every update?), I provide an alternative derivation
214          #  from $cgi_url. -- GJO          #  from $cgi_url. -- GJO
215          #          #
216            # BASE href needs to be absolute. RDO.
217          my $base_url = $FIG_Config::cgi_base;          #
218          if ( ! $base_url )                      # if cgi_base was not defined          #
219          {          $base_url = &FIG::cgi_url;
220              $base_url = $FIG_Config::cgi_url;   # get the full cgi url  #       my $base_url = $FIG_Config::cgi_base;
221              $base_url =~ s~^http://[^/]*~~;     # remove protocol and host  #       if ( ! $base_url )                      # if cgi_base was not defined
222              $base_url =~ m~/$~ || $base_url =~ s~$~/~; # check trailing slash  #       {
223          }  #           $base_url = $FIG_Config::cgi_url;   # get the full cgi url
224    #           $base_url =~ s~^http://[^/]*~~;     # remove protocol and host
225    #           $base_url =~ m~/$~ || $base_url =~ s~$~/~; # check trailing slash
226    #       }
227    
228          $base_line = $head_end_line;          $base_line = $head_end_line;
229          splice( @$html, $base_line, 0, "<BASE href=\"$base_url\">\n" );          splice( @$html, $base_line, 0, "<BASE href=\"$base_url/\">\n" );
230      }      }
231    
232      #      #
# Line 259  Line 292 
292  }  }
293    
294  sub make_table {  sub make_table {
295      my($col_hdrs,$tab,$title,$instr) = @_;      my($col_hdrs,$tab,$title, %options ) = @_;
296      my(@tab);      my(@tab);
297    
298      push( @tab, "\n<table border>\n",      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";
299        push( @tab, "\n<table $border>\n",
300                  "\t<caption><b>$title</b></caption>\n",                  "\t<caption><b>$title</b></caption>\n",
301                  "\t<tr>\n\t\t<th>"                  "\t<tr>\n\t\t<th>"
302                . join( "</th>\n\t\t<th>", @$col_hdrs )                . join( "</th>\n\t\t<th>", @$col_hdrs )
303                . "</th>\n\t</tr>\n"                . "</th>\n\t</tr>\n"
304          );          );
305      my($i,$nowrap);      my($i);
   
     for ($i=0; ($i < @$instr) && ($instr->[$i] !~ /nowrap/); $i++) {}  
     $nowrap = ($i == @$instr) ? "" : " nowrap";  
306    
307      my $row;      my $row;
308      foreach $row (@$tab)      foreach $row (@$tab)
309      {      {
310          push( @tab, "\t<tr>\n"          push( @tab, "\t<tr>\n"
311                    . join( "\n", map { &expand($_,$nowrap) } @$row )                    . join( "\n", map { &expand($_) } @$row )
312                    . "\n\t</tr>\n"                    . "\n\t</tr>\n"
313              );              );
314      }      }
# Line 286  Line 317 
317  }  }
318    
319  sub expand {  sub expand {
320      my($x,$nowrap) = @_;      my($x) = @_;
321    
322      if ($x =~ /^\@([^:]+)\:([^:]+)\:(.*)$/)      if ($x =~ /^\@([^:]+)\:(.*)$/)
323      {      {
324          return "\t\t<td$nowrap $1=\"$2\">$3</td>";          return "\t\t<td $1>$2</td>";
325      }      }
326      else      else
327      {      {
328          return "\t\t<td$nowrap>$x</td>";          return "\t\t<td>$x</td>";
329      }      }
330  }  }
331    
332    sub set_ec_links {
333        my($cgi,$x) = @_;
334        my($before,$match,$after);
335    
336        if ($x =~ /^(.*)(EC \d+\.\d+\.\d+\.\d+)(.*)/s)
337        {
338            $before = $1;
339            $match = $2;
340            $after = $3;
341            return &set_ec_links($cgi,$before) . &HTML::ec_link($match) . &set_ec_links($cgi,$after);
342        }
343        return $x;
344    }
345    
346  sub ec_link {  sub ec_link {
347      my($role) = @_;      my($role) = @_;
348    
# Line 322  Line 367 
367      return "<a href=$link>$role</a>";      return "<a href=$link>$role</a>";
368  }  }
369    
370    #
371    # Local means to eliminate the fig|org.peg from the
372    # text of the link.
373    #
374  sub fid_link {  sub fid_link {
375      my($cgi,$fid,$local,$just_url) = @_;      my($cgi,$fid,$local,$just_url) = @_;
376      my($n);      my($n);
# Line 348  Line 397 
397          if (! $user) { $user = "" }          if (! $user) { $user = "" }
398          my $trans = $cgi->param('translate') ? "&translate=1" : "";          my $trans = $cgi->param('translate') ? "&translate=1" : "";
399          my $link = $cgi->url() . "?prot=$fid&user=$user$trans";          my $link = $cgi->url() . "?prot=$fid&user=$user$trans";
400          $link =~ s/[a-z_A-Z]+\.cgi\?/protein.cgi?/;          $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;
401            #
402            # Elimin the p2p part if we're in that subdir. Ugh.
403            #
404            $link =~ s,p2p/protein.cgi,protein.cgi,;
405    
406          if ($just_url)          if ($just_url)
407          {          {
408              return $link;              return $link;
# Line 475  Line 529 
529      my($cgi,$x) = @_;      my($cgi,$x) = @_;
530      my($before,$match,$after);      my($before,$match,$after);
531    
532      if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)$/)      if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)/s)
533      {      {
534          $before = $1;          $before = $1;
535          $match = $2;          $match = $2;
536          $after = $3;          $after = $3;
537          return &set_prot_links($cgi,$before) . &HTML::fid_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n";          return &set_prot_links($cgi,$before) . &HTML::fid_link($cgi,$match) . &set_prot_links($cgi,$after);
538      }      }
539      elsif ($x =~ /^(.*)(gi\|\d+)(.*)$/)      elsif ($x =~ /^(.*)(gi\|\d+)(.*)/s)
540      {      {
541          $before = $1;          $before = $1;
542          $match = $2;          $match = $2;
543          $after = $3;          $after = $3;
544          return &set_prot_links($cgi,$before) . &HTML::gi_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n";          return &set_prot_links($cgi,$before) . &HTML::gi_link($cgi,$match) . &set_prot_links($cgi,$after);
545      }      }
546      elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)$/)      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)
547      {      {
548          $before = $1;          $before = $1;
549          $match = $2;          $match = $2;
550          $after = $3;          $after = $3;
551          return &set_prot_links($cgi,$before) . &HTML::sp_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n";          return &set_prot_links($cgi,$before) . &HTML::uni_link($cgi,$match) . &set_prot_links($cgi,$after);
552      }      }
553      elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)$/)      elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)/s)
554      {      {
555          $before = $1;          $before = $1;
556          $match = $2;          $match = $2;
557          $after = $3;          $after = $3;
558          return &set_prot_links($cgi,$before) . &HTML::pir_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n";          return &set_prot_links($cgi,$before) . &HTML::sp_link($cgi,$match) . &set_prot_links($cgi,$after);
559        }
560        elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)/s)
561        {
562            $before = $1;
563            $match = $2;
564            $after = $3;
565            return &set_prot_links($cgi,$before) . &HTML::pir_link($cgi,$match) . &set_prot_links($cgi,$after);
566        }
567        elsif ($x =~ /^(.*)(kegg\|[a-z]{2,4}:[a-zA-Z_0-9]+)(.*)/s)
568        {
569            $before = $1;
570            $match = $2;
571            $after = $3;
572            return &set_prot_links($cgi,$before) . &HTML::kegg_link($cgi,$match) . &set_prot_links($cgi,$after);
573      }      }
574      return $x;      return $x;
575  }  }
# Line 516  Line 584 
584      return $gi;      return $gi;
585  }  }
586    
587    sub uni_link {
588        my($cgi,$uni) = @_;
589    
590        if ($uni =~ /^uni\|(\S+)$/)
591        {
592            return "<a href=http://www.pir.uniprot.org/cgi-bin/upEntry?id=$1>$uni</a>";
593        }
594        return $uni;
595    }
596    
597  sub sp_link {  sub sp_link {
598      my($cgi,$sp) = @_;      my($cgi,$sp) = @_;
599    
# Line 536  Line 614 
614      return $pir;      return $pir;
615  }  }
616    
617    sub kegg_link {
618        my($cgi,$kegg) = @_;
619    
620        if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)
621        {
622            return "<a href=http://www.genome.ad.jp/dbget-bin/www_bget?$1+$2>$kegg</a>";
623        }
624        return $kegg;
625    }
626    
627    sub set_map_links {
628        my($cgi,$x) = @_;
629        my($before,$match,$after);
630    
631        my $org = ($cgi->param('org') || $cgi->param('genome') || "");
632    
633        if ($x =~ /^(.*)(MAP\d+)(.*)/s)
634        {
635            $before = $1;
636            $match = $2;
637            $after = $3;
638            return &set_map_links($cgi,$before) . &map_link($cgi,$match,$org) . &set_map_links($cgi,$after);
639        }
640        return $x;
641    }
642    
643    sub map_link {
644        my($cgi,$map,$org) = @_;
645    
646        $user = $cgi->param('user');
647        $user = $user ? $user : "";
648        $org = $org ? $org : "";
649        my $url = "$FIG_Config::cgi_url/show_kegg_map.cgi?user=$user&map=$map&org=$org";
650        my $link = "<a href=\"$url\">$map</a>";
651        return $link;
652    }
653    
654  1  1

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.18

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3