[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.16, Mon Jun 28 19:16:47 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        if (@html_hdr)
33        {
34            my $insert_stuff;
35            my @ver = &FIG::file_head("$FIG_Config::fig_disk/CURRENT_RELEASE", 1);
36            my $ver = $ver[0];
37            chomp $ver;
38            if ($ver =~ /^cvs\.(\d+)$/)
39            {
40                my $d = asctime(localtime($1));
41                chomp($d);
42                $ver .=  " ($d)";
43            }
44            my $host = &FIG::get_local_hostname();
45            $insert_stuff = "SEED version <b>$ver</b> on $host";
46    
47            for $_ (@html_hdr)
48            {
49                s,(href|img\s+src)="/FIG/,\1="$FIG_Config::cgi_base,g;
50                if ($_ eq "<!-- HEADER_INSERT -->\n")
51                {
52                    $_ = $insert_stuff;
53                }
54            }
55        }
56    
57    
58      print $cgi->header;      print $cgi->header;
59    
# Line 156  Line 183 
183      #  Seed page header (if it exists) goes after <BODY>      #  Seed page header (if it exists) goes after <BODY>
184      #      #
185    
186      if ( -f $html_hdr_file )      if (@html_hdr)
187      {      {
188          splice( @$html, $body_line + 1, 0, `cat $html_hdr_file` );          splice( @$html, $body_line + 1, 0, @html_hdr );
189      }      }
190    
191      #      #
# Line 183  Line 210 
210          #  only, or every update?), I provide an alternative derivation          #  only, or every update?), I provide an alternative derivation
211          #  from $cgi_url. -- GJO          #  from $cgi_url. -- GJO
212          #          #
213            # BASE href needs to be absolute. RDO.
214          my $base_url = $FIG_Config::cgi_base;          #
215          if ( ! $base_url )                      # if cgi_base was not defined          #
216          {          $base_url = &FIG::cgi_url;
217              $base_url = $FIG_Config::cgi_url;   # get the full cgi url  #       my $base_url = $FIG_Config::cgi_base;
218              $base_url =~ s~^http://[^/]*~~;     # remove protocol and host  #       if ( ! $base_url )                      # if cgi_base was not defined
219              $base_url =~ m~/$~ || $base_url =~ s~$~/~; # check trailing slash  #       {
220          }  #           $base_url = $FIG_Config::cgi_url;   # get the full cgi url
221    #           $base_url =~ s~^http://[^/]*~~;     # remove protocol and host
222    #           $base_url =~ m~/$~ || $base_url =~ s~$~/~; # check trailing slash
223    #       }
224    
225          $base_line = $head_end_line;          $base_line = $head_end_line;
226          splice( @$html, $base_line, 0, "<BASE href=\"$base_url\">\n" );          splice( @$html, $base_line, 0, "<BASE href=\"$base_url/\">\n" );
227      }      }
228    
229      #      #
# Line 259  Line 289 
289  }  }
290    
291  sub make_table {  sub make_table {
292      my($col_hdrs,$tab,$title,$instr) = @_;      my($col_hdrs,$tab,$title) = @_;
293      my(@tab);      my(@tab);
294    
295      push( @tab, "\n<table border>\n",      push( @tab, "\n<table border>\n",
# Line 268  Line 298 
298                . join( "</th>\n\t\t<th>", @$col_hdrs )                . join( "</th>\n\t\t<th>", @$col_hdrs )
299                . "</th>\n\t</tr>\n"                . "</th>\n\t</tr>\n"
300          );          );
301      my($i,$nowrap);      my($i);
   
     for ($i=0; ($i < @$instr) && ($instr->[$i] !~ /nowrap/); $i++) {}  
     $nowrap = ($i == @$instr) ? "" : " nowrap";  
302    
303      my $row;      my $row;
304      foreach $row (@$tab)      foreach $row (@$tab)
305      {      {
306          push( @tab, "\t<tr>\n"          push( @tab, "\t<tr>\n"
307                    . join( "\n", map { &expand($_,$nowrap) } @$row )                    . join( "\n", map { &expand($_) } @$row )
308                    . "\n\t</tr>\n"                    . "\n\t</tr>\n"
309              );              );
310      }      }
# Line 286  Line 313 
313  }  }
314    
315  sub expand {  sub expand {
316      my($x,$nowrap) = @_;      my($x) = @_;
317    
318      if ($x =~ /^\@([^:]+)\:([^:]+)\:(.*)$/)      if ($x =~ /^\@([^:]+)\:(.*)$/)
319      {      {
320          return "\t\t<td$nowrap $1=\"$2\">$3</td>";          return "\t\t<td $1>$2</td>";
321      }      }
322      else      else
323      {      {
324          return "\t\t<td$nowrap>$x</td>";          return "\t\t<td>$x</td>";
325        }
326    }
327    
328    sub set_ec_links {
329        my($cgi,$x) = @_;
330        my($before,$match,$after);
331    
332        if ($x =~ /^(.*)(EC \d+\.\d+\.\d+\.\d+)(.*)/s)
333        {
334            $before = $1;
335            $match = $2;
336            $after = $3;
337            return &set_ec_links($cgi,$before) . &HTML::ec_link($match) . &set_ec_links($cgi,$after);
338      }      }
339        return $x;
340  }  }
341    
342  sub ec_link {  sub ec_link {
# Line 322  Line 363 
363      return "<a href=$link>$role</a>";      return "<a href=$link>$role</a>";
364  }  }
365    
366    #
367    # Local means to eliminate the fig|org.peg from the
368    # text of the link.
369    #
370  sub fid_link {  sub fid_link {
371      my($cgi,$fid,$local,$just_url) = @_;      my($cgi,$fid,$local,$just_url) = @_;
372      my($n);      my($n);
# Line 348  Line 393 
393          if (! $user) { $user = "" }          if (! $user) { $user = "" }
394          my $trans = $cgi->param('translate') ? "&translate=1" : "";          my $trans = $cgi->param('translate') ? "&translate=1" : "";
395          my $link = $cgi->url() . "?prot=$fid&user=$user$trans";          my $link = $cgi->url() . "?prot=$fid&user=$user$trans";
396          $link =~ s/[a-z_A-Z]+\.cgi\?/protein.cgi?/;          $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;
397            #
398            # Elimin the p2p part if we're in that subdir. Ugh.
399            #
400            $link =~ s,p2p/protein.cgi,protein.cgi,;
401    
402          if ($just_url)          if ($just_url)
403          {          {
404              return $link;              return $link;
# Line 475  Line 525 
525      my($cgi,$x) = @_;      my($cgi,$x) = @_;
526      my($before,$match,$after);      my($before,$match,$after);
527    
528      if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)$/)      if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)/s)
529      {      {
530          $before = $1;          $before = $1;
531          $match = $2;          $match = $2;
532          $after = $3;          $after = $3;
533          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);
534      }      }
535      elsif ($x =~ /^(.*)(gi\|\d+)(.*)$/)      elsif ($x =~ /^(.*)(gi\|\d+)(.*)/s)
536      {      {
537          $before = $1;          $before = $1;
538          $match = $2;          $match = $2;
539          $after = $3;          $after = $3;
540          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);
541      }      }
542      elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)$/)      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)
543      {      {
544          $before = $1;          $before = $1;
545          $match = $2;          $match = $2;
546          $after = $3;          $after = $3;
547          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);
548      }      }
549      elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)$/)      elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)/s)
550      {      {
551          $before = $1;          $before = $1;
552          $match = $2;          $match = $2;
553          $after = $3;          $after = $3;
554          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);
555        }
556        elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)/s)
557        {
558            $before = $1;
559            $match = $2;
560            $after = $3;
561            return &set_prot_links($cgi,$before) . &HTML::pir_link($cgi,$match) . &set_prot_links($cgi,$after);
562        }
563        elsif ($x =~ /^(.*)(kegg\|[a-z]{2,4}:[a-zA-Z_0-9]+)(.*)/s)
564        {
565            $before = $1;
566            $match = $2;
567            $after = $3;
568            return &set_prot_links($cgi,$before) . &HTML::kegg_link($cgi,$match) . &set_prot_links($cgi,$after);
569      }      }
570      return $x;      return $x;
571  }  }
# Line 516  Line 580 
580      return $gi;      return $gi;
581  }  }
582    
583    sub uni_link {
584        my($cgi,$uni) = @_;
585    
586        if ($uni =~ /^uni\|(\S+)$/)
587        {
588            return "<a href=http://www.pir.uniprot.org/cgi-bin/upEntry?id=$1>$uni</a>";
589        }
590        return $uni;
591    }
592    
593  sub sp_link {  sub sp_link {
594      my($cgi,$sp) = @_;      my($cgi,$sp) = @_;
595    
# Line 536  Line 610 
610      return $pir;      return $pir;
611  }  }
612    
613    sub kegg_link {
614        my($cgi,$kegg) = @_;
615    
616        if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)
617        {
618            return "<a href=http://www.genome.ad.jp/dbget-bin/www_bget?$1+$2>$kegg</a>";
619        }
620        return $kegg;
621    }
622    
623    sub set_map_links {
624        my($cgi,$x) = @_;
625        my($before,$match,$after);
626    
627        my $org = ($cgi->param('org') || $cgi->param('genome') || "");
628    
629        if ($x =~ /^(.*)(MAP\d+)(.*)/s)
630        {
631            $before = $1;
632            $match = $2;
633            $after = $3;
634            return &set_map_links($cgi,$before) . &map_link($cgi,$match,$org) . &set_map_links($cgi,$after);
635        }
636        return $x;
637    }
638    
639    sub map_link {
640        my($cgi,$map,$org) = @_;
641    
642        $user = $cgi->param('user');
643        $user = $user ? $user : "";
644        $org = $org ? $org : "";
645        my $url = "$FIG_Config::cgi_url/show_kegg_map.cgi?user=$user&map=$map&org=$org";
646        my $link = "<a href=\"$url\">$map</a>";
647        return $link;
648    }
649    
650  1  1

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3