[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.22, Thu Nov 4 16:13:35 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        my $user = $cgi->param('user') || "";
33        push( @html_hdr, "<br><a href=\"index.cgi?user=$user\">FIG search</a>\n" );
34    
35        if (@html_hdr)
36        {
37            my $insert_stuff;
38            my @ver = &FIG::file_head("$FIG_Config::fig_disk/CURRENT_RELEASE", 1);
39            my $ver = $ver[0];
40            chomp $ver;
41            if ($ver =~ /^cvs\.(\d+)$/)
42            {
43                my $d = asctime(localtime($1));
44                chomp($d);
45                $ver .=  " ($d)";
46            }
47            my $host = &FIG::get_local_hostname();
48            $insert_stuff = "SEED version <b>$ver</b> on $host";
49    
50            for $_ (@html_hdr)
51            {
52                s,(href|img\s+src)="/FIG/,\1="$FIG_Config::cgi_base,g;
53                if ($_ eq "<!-- HEADER_INSERT -->\n")
54                {
55                    $_ = $insert_stuff;
56                }
57            }
58        }
59    
60    
61      print $cgi->header;      print $cgi->header;
62    
# Line 145  Line 175 
175      #      #
176      #  <BODY> goes after last head line      #  <BODY> goes after last head line
177      #      #
178        #  RAE: Added the javascript for the buttons immediately after body.
179        #  Note if no buttons are added we still (at the moment) add the script,
180        #  but it only adds a little text (495 characters) to the html and noone will notice!
181    
182      if ( $body_line < 0 )      if ( $body_line < 0 )
183      {      {
184            my $js=&javascript;
185          $body_line = $last_head_line + 1;          $body_line = $last_head_line + 1;
186          splice( @$html, $body_line, 0, "<BODY>\n" );          splice( @$html, $body_line, 0, "<BODY>\n$js\n" );
187      }      }
188    
189      #      #
190      #  Seed page header (if it exists) goes after <BODY>      #  Seed page header (if it exists) goes after <BODY>
191      #      #
192    
193      if ( -f $html_hdr_file )      if (@html_hdr)
194      {      {
195          splice( @$html, $body_line + 1, 0, `cat $html_hdr_file` );          splice( @$html, $body_line + 1, 0, @html_hdr );
196      }      }
197    
198      #      #
# Line 183  Line 217 
217          #  only, or every update?), I provide an alternative derivation          #  only, or every update?), I provide an alternative derivation
218          #  from $cgi_url. -- GJO          #  from $cgi_url. -- GJO
219          #          #
220            # BASE href needs to be absolute. RDO.
221          my $base_url = $FIG_Config::cgi_base;          #
222          if ( ! $base_url )                      # if cgi_base was not defined          #
223          {          $base_url = &FIG::cgi_url;
224              $base_url = $FIG_Config::cgi_url;   # get the full cgi url  #       my $base_url = $FIG_Config::cgi_base;
225              $base_url =~ s~^http://[^/]*~~;     # remove protocol and host  #       if ( ! $base_url )                      # if cgi_base was not defined
226              $base_url =~ m~/$~ || $base_url =~ s~$~/~; # check trailing slash  #       {
227          }  #           $base_url = $FIG_Config::cgi_url;   # get the full cgi url
228    #           $base_url =~ s~^http://[^/]*~~;     # remove protocol and host
229    #           $base_url =~ m~/$~ || $base_url =~ s~$~/~; # check trailing slash
230    #       }
231    
232          $base_line = $head_end_line;          $base_line = $head_end_line;
233          splice( @$html, $base_line, 0, "<BASE href=\"$base_url\">\n" );          splice( @$html, $base_line, 0, "<BASE href=\"$base_url/\">\n" );
234      }      }
235    
236      #      #
# Line 228  Line 265 
265      }      }
266    
267      #      #
268        # See if we have a site-specific tail (for disclaimers, etc).
269        #
270    
271        my $site_tail = "$FIG_Config::fig_disk/config/site_tail.html";
272        my $site_fh;
273        if (open($site_fh, "<$site_tail"))
274        {
275            push(@tail, <$site_fh>);
276            close($site_fh);
277        }
278    
279        #
280      #  Figure out where to insert The SEED tail.  Before </body>,      #  Figure out where to insert The SEED tail.  Before </body>,
281      #  or before </html>, or at end of page.      #  or before </html>, or at end of page.
282      #      #
# Line 259  Line 308 
308  }  }
309    
310  sub make_table {  sub make_table {
311      my($col_hdrs,$tab,$title,$instr) = @_;      my($col_hdrs,$tab,$title, %options ) = @_;
312      my(@tab);      my(@tab);
313    
314      push( @tab, "\n<table border>\n",      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";
315        push( @tab, "\n<table $border>\n",
316                  "\t<caption><b>$title</b></caption>\n",                  "\t<caption><b>$title</b></caption>\n",
317                  "\t<tr>\n\t\t<th>"                  "\t<tr>\n\t\t<th>"
318                . join( "</th>\n\t\t<th>", @$col_hdrs )                . join( "</th>\n\t\t<th>", @$col_hdrs )
319                . "</th>\n\t</tr>\n"                . "</th>\n\t</tr>\n"
320          );          );
321      my($i,$nowrap);      my($i);
   
     for ($i=0; ($i < @$instr) && ($instr->[$i] !~ /nowrap/); $i++) {}  
     $nowrap = ($i == @$instr) ? "" : " nowrap";  
322    
323      my $row;      my $row;
324      foreach $row (@$tab)      foreach $row (@$tab)
325      {      {
326          push( @tab, "\t<tr>\n"          push( @tab, "\t<tr>\n"
327                    . join( "\n", map { &expand($_,$nowrap) } @$row )                    . join( "\n", map { &expand($_) } @$row )
328                    . "\n\t</tr>\n"                    . "\n\t</tr>\n"
329              );              );
330      }      }
# Line 286  Line 333 
333  }  }
334    
335  sub expand {  sub expand {
336      my($x,$nowrap) = @_;      my($x) = @_;
337    
338      if ($x =~ /^\@([^:]+)\:([^:]+)\:(.*)$/)      if ($x =~ /^\@([^:]+)\:(.*)$/)
339      {      {
340          return "\t\t<td$nowrap $1=\"$2\">$3</td>";          return "\t\t<td $1>$2</td>";
341      }      }
342      else      else
343      {      {
344          return "\t\t<td$nowrap>$x</td>";          return "\t\t<td>$x</td>";
345        }
346    }
347    
348    sub set_ec_links {
349        my($cgi,$x) = @_;
350        my($before,$match,$after);
351    
352        if ($x =~ /^(.*)(EC \d+\.\d+\.\d+\.\d+)(.*)/s)
353        {
354            $before = $1;
355            $match = $2;
356            $after = $3;
357            return &set_ec_links($cgi,$before) . &HTML::ec_link($match) . &set_ec_links($cgi,$after);
358      }      }
359        return $x;
360  }  }
361    
362  sub ec_link {  sub ec_link {
# Line 322  Line 383 
383      return "<a href=$link>$role</a>";      return "<a href=$link>$role</a>";
384  }  }
385    
386    #
387    # Local means to eliminate the fig|org.peg from the
388    # text of the link.
389    #
390  sub fid_link {  sub fid_link {
391      my($cgi,$fid,$local,$just_url) = @_;      my($cgi,$fid,$local,$just_url) = @_;
392      my($n);      my($n);
# Line 348  Line 413 
413          if (! $user) { $user = "" }          if (! $user) { $user = "" }
414          my $trans = $cgi->param('translate') ? "&translate=1" : "";          my $trans = $cgi->param('translate') ? "&translate=1" : "";
415          my $link = $cgi->url() . "?prot=$fid&user=$user$trans";          my $link = $cgi->url() . "?prot=$fid&user=$user$trans";
416          $link =~ s/[a-z_A-Z]+\.cgi\?/protein.cgi?/;          $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;
417            #
418            # Elimin the p2p part if we're in that subdir. Ugh.
419            #
420            $link =~ s,p2p/protein.cgi,protein.cgi,;
421    
422          if ($just_url)          if ($just_url)
423          {          {
424              return $link;              return $link;
# Line 475  Line 545 
545      my($cgi,$x) = @_;      my($cgi,$x) = @_;
546      my($before,$match,$after);      my($before,$match,$after);
547    
548      if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)$/)      if ($x =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)/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::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);
554      }      }
555      elsif ($x =~ /^(.*)(gi\|\d+)(.*)$/)      elsif ($x =~ /^(.*)\b([NXYZA]P_[0-9\.]+)\b(.*)/s)
556      {      {
557          $before = $1;          $before = $1;
558          $match = $2;          $match = $2;
559          $after = $3;          $after = $3;
560          return &set_prot_links($cgi,$before) . &HTML::gi_link($cgi,$match) . &set_prot_links($cgi,$after) . "\n";          return &set_prot_links($cgi,$before) . &HTML::refseq_link($cgi,$match) . &set_prot_links($cgi,$after);
561      }      }
562      elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)$/)      elsif ($x =~ /^(.*)(gi\|\d+)(.*)/s)
563      {      {
564          $before = $1;          $before = $1;
565          $match = $2;          $match = $2;
566          $after = $3;          $after = $3;
567          return &set_prot_links($cgi,$before) . &HTML::sp_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);
568      }      }
569      elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)$/)      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)
570      {      {
571          $before = $1;          $before = $1;
572          $match = $2;          $match = $2;
573          $after = $3;          $after = $3;
574          return &set_prot_links($cgi,$before) . &HTML::pir_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);
575        }
576        elsif ($x =~ /^(.*)(sp\|[A-Z0-9]{6})(.*)/s)
577        {
578            $before = $1;
579            $match = $2;
580            $after = $3;
581            return &set_prot_links($cgi,$before) . &HTML::sp_link($cgi,$match) . &set_prot_links($cgi,$after);
582        }
583        elsif ($x =~ /^(.*)(pirnr\|NF\d+)(.*)/s)
584        {
585            $before = $1;
586            $match = $2;
587            $after = $3;
588            return &set_prot_links($cgi,$before) . &HTML::pir_link($cgi,$match) . &set_prot_links($cgi,$after);
589        }
590        elsif ($x =~ /^(.*)(kegg\|[a-z]{2,4}:[a-zA-Z_0-9]+)(.*)/s)
591        {
592            $before = $1;
593            $match = $2;
594            $after = $3;
595            return &set_prot_links($cgi,$before) . &HTML::kegg_link($cgi,$match) . &set_prot_links($cgi,$after);
596      }      }
597      return $x;      return $x;
598  }  }
599    
600    sub refseq_link {
601        my($cgi,$id) = @_;
602    
603        if ($id =~ /^[NXYZA]P_/)
604        {
605            return "<a href=http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=protein&cmd=search&term=$id>$id</a>";
606        }
607    }
608    
609  sub gi_link {  sub gi_link {
610      my($cgi,$gi) = @_;      my($cgi,$gi) = @_;
611    
# Line 516  Line 616 
616      return $gi;      return $gi;
617  }  }
618    
619    sub uni_link {
620        my($cgi,$uni) = @_;
621    
622        if ($uni =~ /^uni\|(\S+)$/)
623        {
624            return "<a href=http://www.pir.uniprot.org/cgi-bin/upEntry?id=$1>$uni</a>";
625        }
626        return $uni;
627    }
628    
629  sub sp_link {  sub sp_link {
630      my($cgi,$sp) = @_;      my($cgi,$sp) = @_;
631    
# Line 536  Line 646 
646      return $pir;      return $pir;
647  }  }
648    
649    sub kegg_link {
650        my($cgi,$kegg) = @_;
651    
652        if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)
653        {
654            return "<a href=http://www.genome.ad.jp/dbget-bin/www_bget?$1+$2>$kegg</a>";
655        }
656        return $kegg;
657    }
658    
659    sub set_map_links {
660        my($cgi,$x) = @_;
661        my($before,$match,$after);
662    
663        my $org = ($cgi->param('org') || $cgi->param('genome') || "");
664    
665        if ($x =~ /^(.*)(MAP\d+)(.*)/s)
666        {
667            $before = $1;
668            $match = $2;
669            $after = $3;
670            return &set_map_links($cgi,$before) . &map_link($cgi,$match,$org) . &set_map_links($cgi,$after);
671        }
672        return $x;
673    }
674    
675    sub map_link {
676        my($cgi,$map,$org) = @_;
677    
678        $user = $cgi->param('user');
679        $user = $user ? $user : "";
680        $org = $org ? $org : "";
681        my $url = "$FIG_Config::cgi_url/show_kegg_map.cgi?user=$user&map=$map&org=$org";
682        my $link = "<a href=\"$url\">$map</a>";
683        return $link;
684    }
685    
686    sub javascript {
687            #### MODIFIED BY RAE TO ADD JAVA SUPPORT FOR CHECK ALL/UNCHECK ALL
688            # This routine takes three arguments, $html, $form, and $button
689            # $html is the ref to the array with the html in it
690            # $form is the name of the form. This must be added whenever start_form is called
691            # by including a -name entry. This is only used for the javascript
692            # $button is the name of the button that should be checked/unchecked.
693            #
694            # At the moment this add's four buttons:
695            # Check all, check's all
696            # Check first half will check the first 50% of the entries
697            # Check second half will check the second 50% of the entries
698            # Uncheck all will remove the checks.
699    
700            # Note that the other change is I added a -name=>'fig_checked' to the start_form
701            # field. The name is needed for the java script.
702            #
703    
704              $java_script=<<EOF;
705      <SCRIPT LANGUAGE="JavaScript">
706      <!-- Begin
707      function checkAll(field)
708      {
709       for (i = 0; i < field.length; i++)
710       field[i].checked = true ;
711      }
712    
713      function checkFirst(field)
714      {
715       for (i = 0; i < field.length/2; i++)
716       field[i].checked = true;
717      }
718    
719      function checkSecond(field)
720      {
721       for (i=Math.round(field.length/2); i < field.length; i++)
722       field[i].checked = true ;
723      }
724    
725      function uncheckAll(field)
726      {
727       for (i = 0; i < field.length; i++)
728       field[i].checked = false ;
729      }
730      //  End -->
731      </script>
732    EOF
733            return $java_script;
734    }
735    
736    sub java_buttons {
737      ## ADDED BY RAE
738      # Provides code to include check all/first half/second half/none for javascrspt
739      # this takes two variables - the form name provided in start_form with the
740      # -name => field and the checkbox name
741      my ($form, $button)=@_;
742    
743      $java_script="<input type=\"button\" name=\"CheckAll\" value=\"Check All\"\nonClick=\"checkAll(document.$form.$button)\">\n";
744      $java_script.="<input type=\"button\" name=\"CheckFirst\" value=\"Check First Half\"\nonClick=\"checkFirst(document.$form.$button)\">\n";
745      $java_script.="<input type=\"button\" name=\"CheckSecond\" value=\"Check Second Half\"\nonClick=\"checkSecond(document.$form.$button)\">\n";
746      $java_script.="<input type=\"button\" name=\"UnCheckAll\" value=\"Uncheck All\"\nonClick=\"uncheckAll(document.$form.$button)\">\n";
747    
748      return $java_script;
749    }
750    
751    sub sub_link {
752        my($cgi,$sub) = @_;
753        my($sub_link);
754    
755        my $user = $cgi->param('user');
756        if ($user)
757        {
758            $sub_link = "<a href=./subsys.cgi?ssa_name=$sub&request=show_ssa&user=$user>$sub</a>";
759        }
760        else
761        {
762            $sub_link = $sub;
763        }
764        return $sub_link;
765    }
766    
767  1  1

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3