[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.12, Fri May 14 18:06:51 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 {
316      my($role) = @_;      my($role) = @_;
317    
# Line 348  Line 362 
362          if (! $user) { $user = "" }          if (! $user) { $user = "" }
363          my $trans = $cgi->param('translate') ? "&translate=1" : "";          my $trans = $cgi->param('translate') ? "&translate=1" : "";
364          my $link = $cgi->url() . "?prot=$fid&user=$user$trans";          my $link = $cgi->url() . "?prot=$fid&user=$user$trans";
365          $link =~ s/[a-z_A-Z]+\.cgi\?/protein.cgi?/;          $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;
366          if ($just_url)          if ($just_url)
367          {          {
368              return $link;              return $link;
# Line 475  Line 489 
489      my($cgi,$x) = @_;      my($cgi,$x) = @_;
490      my($before,$match,$after);      my($before,$match,$after);
491    
492      if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)$/)      if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)/s)
493        {
494            $before = $1;
495            $match = $2;
496            $after = $3;
497            return &set_prot_links($cgi,$before) . &HTML::fid_link($cgi,$match) . &set_prot_links($cgi,$after);
498        }
499        elsif ($x =~ /^(.*)(gi\|\d+)(.*)/s)
500      {      {
501          $before = $1;          $before = $1;
502          $match = $2;          $match = $2;
503          $after = $3;          $after = $3;
504          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);
505      }      }
506      elsif ($x =~ /^(.*)(gi\|\d+)(.*)$/)      elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)/s)
507      {      {
508          $before = $1;          $before = $1;
509          $match = $2;          $match = $2;
510          $after = $3;          $after = $3;
511          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);
512      }      }
513      elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)$/)      elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)/s)
514      {      {
515          $before = $1;          $before = $1;
516          $match = $2;          $match = $2;
517          $after = $3;          $after = $3;
518          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);
519      }      }
520      elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)$/)      elsif ($x =~ /^(.*)(kegg\|[a-z]{2,4}:[a-zA-Z_0-9]+)(.*)/s)
521      {      {
522          $before = $1;          $before = $1;
523          $match = $2;          $match = $2;
524          $after = $3;          $after = $3;
525          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);
526      }      }
527      return $x;      return $x;
528  }  }
# Line 536  Line 557 
557      return $pir;      return $pir;
558  }  }
559    
560    sub kegg_link {
561        my($cgi,$kegg) = @_;
562    
563        if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)
564        {
565            return "<a href=http://www.genome.ad.jp/dbget-bin/www_bget?$1+$2>$kegg</a>";
566        }
567        return $kegg;
568    }
569    
570    sub set_map_links {
571        my($cgi,$x) = @_;
572        my($before,$match,$after);
573    
574        my $org = ($cgi->param('org') || $cgi->param('genome') || "");
575    
576        if ($x =~ /^(.*)(MAP\d+)(.*)/s)
577        {
578            $before = $1;
579            $match = $2;
580            $after = $3;
581            return &set_map_links($cgi,$before) . &map_link($cgi,$match,$org) . &set_map_links($cgi,$after);
582        }
583        return $x;
584    }
585    
586    sub map_link {
587        my($cgi,$map,$org) = @_;
588    
589        $user = $cgi->param('user');
590        $user = $user ? $user : "";
591        $org = $org ? $org : "";
592        my $url = "$FIG_Config::cgi_url/show_kegg_map.cgi?user=$user&map=$map&org=$org";
593        my $link = "<a href=\"$url\">$map</a>";
594        return $link;
595    }
596    
597  1  1

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3