[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.13, Tue Jun 8 21:32:56 2004 UTC
# Line 183  Line 183 
183          #  only, or every update?), I provide an alternative derivation          #  only, or every update?), I provide an alternative derivation
184          #  from $cgi_url. -- GJO          #  from $cgi_url. -- GJO
185          #          #
186            # BASE href needs to be absolute. RDO.
187          my $base_url = $FIG_Config::cgi_base;          #
188          if ( ! $base_url )                      # if cgi_base was not defined          #
189          {          $base_url = &FIG::cgi_url;
190              $base_url = $FIG_Config::cgi_url;   # get the full cgi url  #       my $base_url = $FIG_Config::cgi_base;
191              $base_url =~ s~^http://[^/]*~~;     # remove protocol and host  #       if ( ! $base_url )                      # if cgi_base was not defined
192              $base_url =~ m~/$~ || $base_url =~ s~$~/~; # check trailing slash  #       {
193          }  #           $base_url = $FIG_Config::cgi_url;   # get the full cgi url
194    #           $base_url =~ s~^http://[^/]*~~;     # remove protocol and host
195    #           $base_url =~ m~/$~ || $base_url =~ s~$~/~; # check trailing slash
196    #       }
197    
198          $base_line = $head_end_line;          $base_line = $head_end_line;
199          splice( @$html, $base_line, 0, "<BASE href=\"$base_url\">\n" );          splice( @$html, $base_line, 0, "<BASE href=\"$base_url/\">\n" );
200      }      }
201    
202      #      #
# Line 259  Line 262 
262  }  }
263    
264  sub make_table {  sub make_table {
265      my($col_hdrs,$tab,$title,$instr) = @_;      my($col_hdrs,$tab,$title) = @_;
266      my(@tab);      my(@tab);
267    
268      push( @tab, "\n<table border>\n",      push( @tab, "\n<table border>\n",
# Line 268  Line 271 
271                . join( "</th>\n\t\t<th>", @$col_hdrs )                . join( "</th>\n\t\t<th>", @$col_hdrs )
272                . "</th>\n\t</tr>\n"                . "</th>\n\t</tr>\n"
273          );          );
274      my($i,$nowrap);      my($i);
   
     for ($i=0; ($i < @$instr) && ($instr->[$i] !~ /nowrap/); $i++) {}  
     $nowrap = ($i == @$instr) ? "" : " nowrap";  
275    
276      my $row;      my $row;
277      foreach $row (@$tab)      foreach $row (@$tab)
278      {      {
279          push( @tab, "\t<tr>\n"          push( @tab, "\t<tr>\n"
280                    . join( "\n", map { &expand($_,$nowrap) } @$row )                    . join( "\n", map { &expand($_) } @$row )
281                    . "\n\t</tr>\n"                    . "\n\t</tr>\n"
282              );              );
283      }      }
# Line 286  Line 286 
286  }  }
287    
288  sub expand {  sub expand {
289      my($x,$nowrap) = @_;      my($x) = @_;
290    
291      if ($x =~ /^\@([^:]+)\:([^:]+)\:(.*)$/)      if ($x =~ /^\@([^:]+)\:(.*)$/)
292      {      {
293          return "\t\t<td$nowrap $1=\"$2\">$3</td>";          return "\t\t<td $1>$2</td>";
294      }      }
295      else      else
296      {      {
297          return "\t\t<td$nowrap>$x</td>";          return "\t\t<td>$x</td>";
298        }
299    }
300    
301    sub set_ec_links {
302        my($cgi,$x) = @_;
303        my($before,$match,$after);
304    
305        if ($x =~ /^(.*)(EC \d+\.\d+\.\d+\.\d+)(.*)/s)
306        {
307            $before = $1;
308            $match = $2;
309            $after = $3;
310            return &set_ec_links($cgi,$before) . &HTML::ec_link($match) . &set_ec_links($cgi,$after);
311      }      }
312        return $x;
313  }  }
314    
315  sub ec_link {  sub ec_link {
# Line 322  Line 336 
336      return "<a href=$link>$role</a>";      return "<a href=$link>$role</a>";
337  }  }
338    
339    #
340    # Local means to eliminate the fig|org.peg from the
341    # text of the link.
342    #
343  sub fid_link {  sub fid_link {
344      my($cgi,$fid,$local,$just_url) = @_;      my($cgi,$fid,$local,$just_url) = @_;
345      my($n);      my($n);
# Line 348  Line 366 
366          if (! $user) { $user = "" }          if (! $user) { $user = "" }
367          my $trans = $cgi->param('translate') ? "&translate=1" : "";          my $trans = $cgi->param('translate') ? "&translate=1" : "";
368          my $link = $cgi->url() . "?prot=$fid&user=$user$trans";          my $link = $cgi->url() . "?prot=$fid&user=$user$trans";
369          $link =~ s/[a-z_A-Z]+\.cgi\?/protein.cgi?/;          $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;
370          if ($just_url)          if ($just_url)
371          {          {
372              return $link;              return $link;
# Line 475  Line 493 
493      my($cgi,$x) = @_;      my($cgi,$x) = @_;
494      my($before,$match,$after);      my($before,$match,$after);
495    
496      if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)$/)      if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)/s)
497        {
498            $before = $1;
499            $match = $2;
500            $after = $3;
501            return &set_prot_links($cgi,$before) . &HTML::fid_link($cgi,$match) . &set_prot_links($cgi,$after);
502        }
503        elsif ($x =~ /^(.*)(gi\|\d+)(.*)/s)
504      {      {
505          $before = $1;          $before = $1;
506          $match = $2;          $match = $2;
507          $after = $3;          $after = $3;
508          return &set_prot_links($cgi,$before) . &HTML::fid_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);
509      }      }
510      elsif ($x =~ /^(.*)(gi\|\d+)(.*)$/)      elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)/s)
511      {      {
512          $before = $1;          $before = $1;
513          $match = $2;          $match = $2;
514          $after = $3;          $after = $3;
515          return &set_prot_links($cgi,$before) . &HTML::gi_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);
516      }      }
517      elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)$/)      elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)/s)
518      {      {
519          $before = $1;          $before = $1;
520          $match = $2;          $match = $2;
521          $after = $3;          $after = $3;
522          return &set_prot_links($cgi,$before) . &HTML::sp_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n";          return &set_prot_links($cgi,$before) . &HTML::pir_link($cgi,$match) . &set_prot_links($cgi,$after);
523      }      }
524      elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)$/)      elsif ($x =~ /^(.*)(kegg\|[a-z]{2,4}:[a-zA-Z_0-9]+)(.*)/s)
525      {      {
526          $before = $1;          $before = $1;
527          $match = $2;          $match = $2;
528          $after = $3;          $after = $3;
529          return &set_prot_links($cgi,$before) . &HTML::pir_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n";          return &set_prot_links($cgi,$before) . &HTML::kegg_link($cgi,$match) . &set_prot_links($cgi,$after);
530      }      }
531      return $x;      return $x;
532  }  }
# Line 536  Line 561 
561      return $pir;      return $pir;
562  }  }
563    
564    sub kegg_link {
565        my($cgi,$kegg) = @_;
566    
567        if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)
568        {
569            return "<a href=http://www.genome.ad.jp/dbget-bin/www_bget?$1+$2>$kegg</a>";
570        }
571        return $kegg;
572    }
573    
574    sub set_map_links {
575        my($cgi,$x) = @_;
576        my($before,$match,$after);
577    
578        my $org = ($cgi->param('org') || $cgi->param('genome') || "");
579    
580        if ($x =~ /^(.*)(MAP\d+)(.*)/s)
581        {
582            $before = $1;
583            $match = $2;
584            $after = $3;
585            return &set_map_links($cgi,$before) . &map_link($cgi,$match,$org) . &set_map_links($cgi,$after);
586        }
587        return $x;
588    }
589    
590    sub map_link {
591        my($cgi,$map,$org) = @_;
592    
593        $user = $cgi->param('user');
594        $user = $user ? $user : "";
595        $org = $org ? $org : "";
596        my $url = "$FIG_Config::cgi_url/show_kegg_map.cgi?user=$user&map=$map&org=$org";
597        my $link = "<a href=\"$url\">$map</a>";
598        return $link;
599    }
600    
601  1  1

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3