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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3