[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.17, Mon Jun 28 19:37:31 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, %options ) = @_;
293      my(@tab);      my(@tab);
294    
295      push( @tab, "\n<table border>\n",      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";
296        push( @tab, "\n<table $border>\n",
297                  "\t<caption><b>$title</b></caption>\n",                  "\t<caption><b>$title</b></caption>\n",
298                  "\t<tr>\n\t\t<th>"                  "\t<tr>\n\t\t<th>"
299                . join( "</th>\n\t\t<th>", @$col_hdrs )                . join( "</th>\n\t\t<th>", @$col_hdrs )
300                . "</th>\n\t</tr>\n"                . "</th>\n\t</tr>\n"
301          );          );
302      my($i,$nowrap);      my($i);
   
     for ($i=0; ($i < @$instr) && ($instr->[$i] !~ /nowrap/); $i++) {}  
     $nowrap = ($i == @$instr) ? "" : " nowrap";  
303    
304      my $row;      my $row;
305      foreach $row (@$tab)      foreach $row (@$tab)
306      {      {
307          push( @tab, "\t<tr>\n"          push( @tab, "\t<tr>\n"
308                    . join( "\n", map { &expand($_,$nowrap) } @$row )                    . join( "\n", map { &expand($_) } @$row )
309                    . "\n\t</tr>\n"                    . "\n\t</tr>\n"
310              );              );
311      }      }
# Line 286  Line 314 
314  }  }
315    
316  sub expand {  sub expand {
317      my($x,$nowrap) = @_;      my($x) = @_;
318    
319      if ($x =~ /^\@([^:]+)\:([^:]+)\:(.*)$/)      if ($x =~ /^\@([^:]+)\:(.*)$/)
320      {      {
321          return "\t\t<td$nowrap $1=\"$2\">$3</td>";          return "\t\t<td $1>$2</td>";
322      }      }
323      else      else
324      {      {
325          return "\t\t<td$nowrap>$x</td>";          return "\t\t<td>$x</td>";
326        }
327    }
328    
329    sub set_ec_links {
330        my($cgi,$x) = @_;
331        my($before,$match,$after);
332    
333        if ($x =~ /^(.*)(EC \d+\.\d+\.\d+\.\d+)(.*)/s)
334        {
335            $before = $1;
336            $match = $2;
337            $after = $3;
338            return &set_ec_links($cgi,$before) . &HTML::ec_link($match) . &set_ec_links($cgi,$after);
339      }      }
340        return $x;
341  }  }
342    
343  sub ec_link {  sub ec_link {
# Line 322  Line 364 
364      return "<a href=$link>$role</a>";      return "<a href=$link>$role</a>";
365  }  }
366    
367    #
368    # Local means to eliminate the fig|org.peg from the
369    # text of the link.
370    #
371  sub fid_link {  sub fid_link {
372      my($cgi,$fid,$local,$just_url) = @_;      my($cgi,$fid,$local,$just_url) = @_;
373      my($n);      my($n);
# Line 348  Line 394 
394          if (! $user) { $user = "" }          if (! $user) { $user = "" }
395          my $trans = $cgi->param('translate') ? "&translate=1" : "";          my $trans = $cgi->param('translate') ? "&translate=1" : "";
396          my $link = $cgi->url() . "?prot=$fid&user=$user$trans";          my $link = $cgi->url() . "?prot=$fid&user=$user$trans";
397          $link =~ s/[a-z_A-Z]+\.cgi\?/protein.cgi?/;          $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;
398            #
399            # Elimin the p2p part if we're in that subdir. Ugh.
400            #
401            $link =~ s,p2p/protein.cgi,protein.cgi,;
402    
403          if ($just_url)          if ($just_url)
404          {          {
405              return $link;              return $link;
# Line 475  Line 526 
526      my($cgi,$x) = @_;      my($cgi,$x) = @_;
527      my($before,$match,$after);      my($before,$match,$after);
528    
529      if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)$/)      if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)/s)
530      {      {
531          $before = $1;          $before = $1;
532          $match = $2;          $match = $2;
533          $after = $3;          $after = $3;
534          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);
535      }      }
536      elsif ($x =~ /^(.*)(gi\|\d+)(.*)$/)      elsif ($x =~ /^(.*)(gi\|\d+)(.*)/s)
537      {      {
538          $before = $1;          $before = $1;
539          $match = $2;          $match = $2;
540          $after = $3;          $after = $3;
541          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);
542      }      }
543      elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)$/)      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)
544      {      {
545          $before = $1;          $before = $1;
546          $match = $2;          $match = $2;
547          $after = $3;          $after = $3;
548          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);
549      }      }
550      elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)$/)      elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)/s)
551      {      {
552          $before = $1;          $before = $1;
553          $match = $2;          $match = $2;
554          $after = $3;          $after = $3;
555          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);
556        }
557        elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)/s)
558        {
559            $before = $1;
560            $match = $2;
561            $after = $3;
562            return &set_prot_links($cgi,$before) . &HTML::pir_link($cgi,$match) . &set_prot_links($cgi,$after);
563        }
564        elsif ($x =~ /^(.*)(kegg\|[a-z]{2,4}:[a-zA-Z_0-9]+)(.*)/s)
565        {
566            $before = $1;
567            $match = $2;
568            $after = $3;
569            return &set_prot_links($cgi,$before) . &HTML::kegg_link($cgi,$match) . &set_prot_links($cgi,$after);
570      }      }
571      return $x;      return $x;
572  }  }
# Line 516  Line 581 
581      return $gi;      return $gi;
582  }  }
583    
584    sub uni_link {
585        my($cgi,$uni) = @_;
586    
587        if ($uni =~ /^uni\|(\S+)$/)
588        {
589            return "<a href=http://www.pir.uniprot.org/cgi-bin/upEntry?id=$1>$uni</a>";
590        }
591        return $uni;
592    }
593    
594  sub sp_link {  sub sp_link {
595      my($cgi,$sp) = @_;      my($cgi,$sp) = @_;
596    
# Line 536  Line 611 
611      return $pir;      return $pir;
612  }  }
613    
614    sub kegg_link {
615        my($cgi,$kegg) = @_;
616    
617        if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)
618        {
619            return "<a href=http://www.genome.ad.jp/dbget-bin/www_bget?$1+$2>$kegg</a>";
620        }
621        return $kegg;
622    }
623    
624    sub set_map_links {
625        my($cgi,$x) = @_;
626        my($before,$match,$after);
627    
628        my $org = ($cgi->param('org') || $cgi->param('genome') || "");
629    
630        if ($x =~ /^(.*)(MAP\d+)(.*)/s)
631        {
632            $before = $1;
633            $match = $2;
634            $after = $3;
635            return &set_map_links($cgi,$before) . &map_link($cgi,$match,$org) . &set_map_links($cgi,$after);
636        }
637        return $x;
638    }
639    
640    sub map_link {
641        my($cgi,$map,$org) = @_;
642    
643        $user = $cgi->param('user');
644        $user = $user ? $user : "";
645        $org = $org ? $org : "";
646        my $url = "$FIG_Config::cgi_url/show_kegg_map.cgi?user=$user&map=$map&org=$org";
647        my $link = "<a href=\"$url\">$map</a>";
648        return $link;
649    }
650    
651  1  1

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3