[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.30, Wed Feb 16 18:59:21 2005 UTC revision 1.36, Tue Mar 15 21:01:14 2005 UTC
# Line 9  Line 9 
9  use HTTP::Request::Common;  use HTTP::Request::Common;
10  use POSIX;  use POSIX;
11    
12    sub new
13    {
14        my($class) = @_;
15    
16        my $self = {};
17    
18        return bless $self, $class;
19    }
20    
21  sub compute_html_header  sub compute_html_header
22  {  {
23      my($additional_insert) = @_;      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
24        my($additional_insert,$user) = @_;
25      my $html_hdr_file = "./Html/html.hdr";      my $html_hdr_file = "./Html/html.hdr";
26      if (! -f $html_hdr_file)      if (! -f $html_hdr_file)
27      {      {
# Line 53  Line 63 
63  }  }
64    
65  sub show_page {  sub show_page {
66      my($cgi,$html,$no_home) = @_;      #warn "SHOWPAGE: cgi=", Dumper(@_);
67        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
68        my($cgi,$html,$no_home, $alt_header, $css) = @_;
69      my $i;      my $i;
70    
71    
72        # ARGUMENTS:
73        #     $cgi is the CGI method
74        #     $html is an array with all the html in it. It is just joined by "\n" (and not <br> or <p>
75        #     $no_home eliminates ONLY the bottom FIG search link in a page
76        #     $alt_header is a reference to an array for an alternate header banner that you can replace the standard one with
77        #     $css is a reference to a hash. The key is the name of the CSS sheet and the value is the URL of that sheet. Note the usual rules about relative css urls
78        #               the sheet named "Default" is considered to be the default style sheet, and if this is not set it points at $FIG_Config::HTML/css/default.css
79        #               the sheet named "Sans Serif" is considered to the the first alternate, and if this is not set it points at $FIG_Config::HTML/css/sanserif.css
80    
81      #      #
82      # Find the HTML header      # Find the HTML header
83      #      #
# Line 66  Line 88 
88          $html_tail_file = "$FIG_Config::fig/CGI/Html/html.tail";          $html_tail_file = "$FIG_Config::fig/CGI/Html/html.tail";
89      }      }
90    
     my @html_hdr = compute_html_header();  
   
91      my $user = $cgi->param('user') || "";      my $user = $cgi->param('user') || "";
92        my @html_hdr;
93        if ($alt_header)
94        {
95           @html_hdr = @$alt_header;
96        }
97        else
98        {
99            @html_hdr = compute_html_header(undef,$user);
100        }
101    
102    
103      print $cgi->header;      print $cgi->header;
104    
# Line 187  Line 217 
217      #      #
218      #  <BODY> goes after last head line      #  <BODY> goes after last head line
219      #      #
220      #  RAE: Added the javascript for the buttons immediately after body.      #  RAE:
221        #  Added the javascript for the buttons immediately after body.
222      #  Note if no buttons are added we still (at the moment) add the script,      #  Note if no buttons are added we still (at the moment) add the script,
223      #  but it only adds a little text (495 characters) to the html and noone will notice!      #  but it only adds a little text (495 characters) to the html and noone will notice!
224    
# Line 217  Line 248 
248          splice( @$html, $body_line, 0, "</HEAD>\n" );          splice( @$html, $body_line, 0, "</HEAD>\n" );
249      }      }
250    
251        # RAE:
252        # Add css here
253        # Note that at the moment I define these two sheets here. I think this should be moved out, but I want to try it and see what happens
254        # css has the format
255        # <link rel='stylesheet' title='default' href='/css/default.css' type='text/css'>
256    
257        # convert the default key to the right case. and eliminate dups
258        foreach my $k (keys %$css) {if (lc($k) eq "default") {$css->{'Default'}=$css->{$k}}}
259    
260        if (!$css || !$css->{'Default'})
261        {
262           $css->{'Default'}="/FIG/Html/css/default.css";
263        }
264        if (!$css->{"Sans Serif"})
265        {
266           $css->{'Sans Serif'}="/FIG/Html/css/sanserif.css";
267        }
268        my $csstext = "<link rel='stylesheet' title='default' href='".$css->{'Default'}."' type='text/css'>\n";
269        $csstext   .= "<link rel='alternate stylesheet' title='Sans Serif' href='".$css->{'Sans Serif'}."' type='text/css'>\n";
270    
271        foreach my $k (keys %$css)
272        {
273           next if (lc($k) eq "default" || lc($k) eq "sans serif");
274           $csstext .= "<link rel='stylesheet' title='$k' href='".$css->{$k}."' type='text/css'>\n";
275        }
276        splice( @$html, $head_end_line, 1, "$csstext</HEAD>\n" );  # note here I am replacing the </head> line. Could be bad...? But it doesn't increment everything else.
277    
278      #      #
279      #  <BASE ...> goes before </HEAD>      #  <BASE ...> goes before </HEAD>
280      #      #
# Line 316  Line 374 
374          splice( @$html, $i, 0, @tags );          splice( @$html, $i, 0, @tags );
375      }      }
376    
377      print @$html;      # RAE the chomp will return any new lines at the ends of elements in the array, and then we can join  with a "\n"
378        # this is because somethings put newlines in, and others don't. This should make nicer looking html
379        chomp(@$html);
380        print join "\n", @$html;
381  }  }
382    
383  sub make_table {  sub make_table {
# Line 345  Line 406 
406  }  }
407    
408  sub expand {  sub expand {
409        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
410      my($x, $tag) = @_;      my($x, $tag) = @_;
411    
412      $tag = "td" unless $tag;      $tag = "td" unless $tag;
# Line 365  Line 427 
427  }  }
428    
429  sub set_ec_links {  sub set_ec_links {
430        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
431      my($cgi,$x) = @_;      my($cgi,$x) = @_;
432      my($before,$match,$after);      my($before,$match,$after);
433    
# Line 379  Line 442 
442  }  }
443    
444  sub ec_link {  sub ec_link {
445        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
446      my($role) = @_;      my($role) = @_;
447    
448      if ($role =~ /(\d+\.\d+\.\d+\.\d+)/)      if ($role =~ /(\d+\.\d+\.\d+\.\d+)/)
# Line 392  Line 456 
456  }  }
457    
458  sub role_link {  sub role_link {
459        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
460      my($cgi,$role) = @_;      my($cgi,$role) = @_;
461    
462      my $roleR = ($role =~ /^(\d+\.\d+\.\d+\.\d+)\s+-\s+/) ? $1 : $role;      my $roleR = ($role =~ /^(\d+\.\d+\.\d+\.\d+)\s+-\s+/) ? $1 : $role;
# Line 407  Line 472 
472  # text of the link.  # text of the link.
473  #  #
474  sub fid_link {  sub fid_link {
475        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
476      my($cgi,$fid,$local,$just_url) = @_;      my($cgi,$fid,$local,$just_url) = @_;
477      my($n);      my($n);
478    
# Line 452  Line 518 
518  }  }
519    
520  sub family_link {  sub family_link {
521        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
522      my($family,$user) = @_;      my($family,$user) = @_;
523    
524      return $family;      return $family;
# Line 460  Line 527 
527  use URI::Escape;  use URI::Escape;
528    
529  sub get_html {  sub get_html {
530        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
531      my( $url, $type, $kv_pairs) = @_;      my( $url, $type, $kv_pairs) = @_;
532      my( $encoded, $ua, $args, @args, $out, @output, $x );      my( $encoded, $ua, $args, @args, $out, @output, $x );
533    
# Line 524  Line 592 
592  }  }
593    
594  sub trim_output {  sub trim_output {
595        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
596      my($out) = @_;      my($out) = @_;
597      my $i;      my $i;
598    
# Line 561  Line 630 
630  }  }
631    
632  sub set_prot_links {  sub set_prot_links {
633        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
634      my($cgi,$x) = @_;      my($cgi,$x) = @_;
635      my($before,$match,$after);      my($before,$match,$after);
636    
# Line 617  Line 687 
687  }  }
688    
689  sub refseq_link {  sub refseq_link {
690        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
691      my($cgi,$id) = @_;      my($cgi,$id) = @_;
692    
693      if ($id =~ /^[NXYZA]P_/)      if ($id =~ /^[NXYZA]P_/)
# Line 626  Line 697 
697  }  }
698    
699  sub gi_link {  sub gi_link {
700        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
701      my($cgi,$gi) = @_;      my($cgi,$gi) = @_;
702    
703      if ($gi =~ /^gi\|(\d+)$/)      if ($gi =~ /^gi\|(\d+)$/)
# Line 636  Line 708 
708  }  }
709    
710  sub uni_link {  sub uni_link {
711        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
712      my($cgi,$uni) = @_;      my($cgi,$uni) = @_;
713    
714      if ($uni =~ /^uni\|(\S+)$/)      if ($uni =~ /^uni\|(\S+)$/)
# Line 646  Line 719 
719  }  }
720    
721  sub sp_link {  sub sp_link {
722        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
723      my($cgi,$sp) = @_;      my($cgi,$sp) = @_;
724    
725      if ($sp =~ /^sp\|(\S+)$/)      if ($sp =~ /^sp\|(\S+)$/)
# Line 656  Line 730 
730  }  }
731    
732  sub pir_link {  sub pir_link {
733        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
734      my($cgi,$pir) = @_;      my($cgi,$pir) = @_;
735    
736      if ($pir =~ /^pirnr\|(NF\d+)$/)      if ($pir =~ /^pirnr\|(NF\d+)$/)
# Line 666  Line 741 
741  }  }
742    
743  sub kegg_link {  sub kegg_link {
744        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
745      my($cgi,$kegg) = @_;      my($cgi,$kegg) = @_;
746    
747      if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)      if ($kegg =~ /^kegg\|([^:]+):(\S+)$/)
# Line 676  Line 752 
752  }  }
753    
754  sub set_map_links {  sub set_map_links {
755        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
756      my($cgi,$x) = @_;      my($cgi,$x) = @_;
757      my($before,$match,$after);      my($before,$match,$after);
758    
# Line 692  Line 769 
769  }  }
770    
771  sub map_link {  sub map_link {
772        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
773      my($cgi,$map,$org) = @_;      my($cgi,$map,$org) = @_;
774    
775      $user = $cgi->param('user');      $user = $cgi->param('user');
# Line 703  Line 781 
781  }  }
782    
783  sub javascript {  sub javascript {
784        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
785          #### MODIFIED BY RAE TO ADD JAVA SUPPORT FOR CHECK ALL/UNCHECK ALL          #### MODIFIED BY RAE TO ADD JAVA SUPPORT FOR CHECK ALL/UNCHECK ALL
786          # This routine takes three arguments, $html, $form, and $button          # This routine takes three arguments, $html, $form, and $button
787          # $html is the ref to the array with the html in it          # $html is the ref to the array with the html in it
# Line 753  Line 832 
832  }  }
833    
834  sub java_buttons {  sub java_buttons {
835        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
836    ## ADDED BY RAE    ## ADDED BY RAE
837    # Provides code to include check all/first half/second half/none for javascrspt    # Provides code to include check all/first half/second half/none for javascrspt
838    # this takes two variables - the form name provided in start_form with the    # this takes two variables - the form name provided in start_form with the
# Line 768  Line 848 
848  }  }
849    
850  sub sub_link {  sub sub_link {
851        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
852      my($cgi,$sub) = @_;      my($cgi,$sub) = @_;
853      my($sub_link);      my($sub_link);
854    

Legend:
Removed from v.1.30  
changed lines
  Added in v.1.36

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3