[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.36, Tue Mar 15 21:01:14 2005 UTC revision 1.43, Thu Jun 23 21:24:48 2005 UTC
# Line 5  Line 5 
5  use Data::Dumper;  use Data::Dumper;
6  use LWP::UserAgent;  use LWP::UserAgent;
7  use LWP::Simple;  use LWP::Simple;
8    use URI::Escape;  # uri_escape()
9  use URI::URL;  use URI::URL;
10  use HTTP::Request::Common;  use HTTP::Request::Common;
11  use POSIX;  use POSIX;
# Line 21  Line 22 
22  sub compute_html_header  sub compute_html_header
23  {  {
24      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
25      my($additional_insert,$user) = @_;      my($additional_insert, $user, %options ) = @_;
26      my $html_hdr_file = "./Html/html.hdr";  
27        my $header_name = $options{header_name} ? $options{header_name} : "html.hdr";
28        my $tail_name = $options{tail_name} ? $options{tail_name} : "html.tail";
29    
30        my $html_hdr_file = "./Html/$header_name";
31      if (! -f $html_hdr_file)      if (! -f $html_hdr_file)
32      {      {
33          $html_hdr_file = "$FIG_Config::fig/CGI/Html/html.hdr";          $html_hdr_file = "$FIG_Config::fig/CGI/Html/$header_name";
34      }      }
35      my @html_hdr = &FIG::file_read($html_hdr_file);      my @html_hdr = &FIG::file_read($html_hdr_file);
36      push( @html_hdr, "<br><a href=\"index.cgi?user=$user\">FIG search</a>\n" );  
37        $options{no_fig_search} or push( @html_hdr, "<br><a href=\"index.cgi?user=$user\">FIG search</a>\n" );
38    
39      if (@html_hdr)      if (@html_hdr)
40      {      {
41          my $insert_stuff;          my $insert_stuff;
42    
43            if (not $options{no_release_info})
44            {
45          my @ver = &FIG::file_head("$FIG_Config::fig_disk/CURRENT_RELEASE", 1);          my @ver = &FIG::file_head("$FIG_Config::fig_disk/CURRENT_RELEASE", 1);
46          my $ver = $ver[0];          my $ver = $ver[0];
47          chomp $ver;          chomp $ver;
# Line 44  Line 53 
53          }          }
54          my $host = &FIG::get_local_hostname();          my $host = &FIG::get_local_hostname();
55          $insert_stuff = "SEED version <b>$ver</b> on $host";          $insert_stuff = "SEED version <b>$ver</b> on $host";
56            }
57    
58          if ($additional_insert)          if ($additional_insert)
59          {          {
60              $insert_stuff .= "<br>" . $additional_insert;              $insert_stuff .= "<br>" . $additional_insert;
# Line 65  Line 76 
76  sub show_page {  sub show_page {
77      #warn "SHOWPAGE: cgi=", Dumper(@_);      #warn "SHOWPAGE: cgi=", Dumper(@_);
78      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
79      my($cgi,$html,$no_home, $alt_header, $css) = @_;      my($cgi,$html,$no_home, $alt_header, $css, $javasrc) = @_;
80      my $i;      my $i;
81    
   
82      # ARGUMENTS:      # ARGUMENTS:
83      #     $cgi is the CGI method      #     $cgi is the CGI method
84      #     $html is an array with all the html in it. It is just joined by "\n" (and not <br> or <p>      #     $html is an array with all the html in it. It is just joined by "\n" (and not <br> or <p>
# Line 77  Line 87 
87      #     $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      #     $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
88      #               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      #               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
89      #               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      #               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
90        #     $javasrc is a reference to an array of URLs to javascripts to be included (e.g. "/FIG/Html/css/styleswitcher.js")
91      #      #
92      # Find the HTML header      # Find the HTML header
93      #      #
94    
95      my $html_tail_file = "./Html/html.tail";      my $html_tail_file = "./Html/$tail_name";
96      if (! -f $html_tail_file)      if (! -f $html_tail_file)
97      {      {
98          $html_tail_file = "$FIG_Config::fig/CGI/Html/html.tail";          $html_tail_file = "$FIG_Config::fig/CGI/Html/$tail_name";
99      }      }
100    
101      my $user = $cgi->param('user') || "";      my $user = $cgi->param('user') || "";
102      my @html_hdr;      my @html_hdr;
103      if ($alt_header)      if ($alt_header && ref($alt_header) eq "ARRAY")
104      {      {
105         @html_hdr = @$alt_header;         @html_hdr = @$alt_header;
106      }      }
# Line 250  Line 260 
260    
261      # RAE:      # RAE:
262      # Add css here      # Add css here
263      # 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      # Note that at the moment I define these two sheets here. I think this should
264      # css has the format      # be moved out, but I want to try it and see what happens.  css has the format:
265        #
266      # <link rel='stylesheet' title='default' href='/css/default.css' type='text/css'>      # <link rel='stylesheet' title='default' href='/css/default.css' type='text/css'>
267    
268      # convert the default key to the right case. and eliminate dups      # convert the default key to the right case. and eliminate dups
# Line 271  Line 282 
282      foreach my $k (keys %$css)      foreach my $k (keys %$css)
283      {      {
284         next if (lc($k) eq "default" || lc($k) eq "sans serif");         next if (lc($k) eq "default" || lc($k) eq "sans serif");
285         $csstext .= "<link rel='stylesheet' title='$k' href='".$css->{$k}."' type='text/css'>\n";         $csstext .= "<link rel='alternate stylesheet' title='$k' href='".$css->{$k}."' type='text/css'>\n";
286      }      }
287    
288    
289        # RAE: also added support for external javascripts here.
290        # we are cluttering the HTML code with all the javascripts when they could easily be in external files
291        # this solution allows us to source other files
292    
293        # $javasrc must be a ref to an array with urls (absolute or relative) to the javascripts
294        if ($javasrc && ref($javasrc) eq "ARRAY") {
295         foreach my $script (@$javasrc) {
296          $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";
297         }
298        }
299    
300    
301    
302      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.      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.
303    
304      #      #
# Line 374  Line 400 
400          splice( @$html, $i, 0, @tags );          splice( @$html, $i, 0, @tags );
401      }      }
402    
403      # RAE the chomp will return any new lines at the ends of elements in the array, and then we can join  with a "\n"      # RAE the chomp will return any new lines at the ends of elements in the array,
404      # this is because somethings put newlines in, and others don't. This should make nicer looking html      # and then we can join  with a "\n". This is because somethings put newlines in,
405      chomp(@$html);      # and others don't. This should make nicer looking html
406      print join "\n", @$html;      #
407        # chomp(@$html);
408        # print join "\n", @$html;
409        #
410        # Apparently the above still breaks things. This is the correct code:
411    
412        foreach $_ (@$html)
413        {
414            print $_;
415        }
416  }  }
417    
418  sub make_table {  sub make_table {
# Line 411  Line 446 
446    
447      $tag = "td" unless $tag;      $tag = "td" unless $tag;
448      my $endtag=$tag;      my $endtag=$tag;
449      # RAE modified this so that you can pass in a reference to an array where the first element is the data to  
450      # display and the second element is optional things like colspan and align. Note that in this case you need to include the td      # RAE modified this so that you can pass in a reference to an array where
451        # the first element is the data to display and the second element is optional
452        # things like colspan and align. Note that in this case you need to include the td
453      # use something like ["some data to appear", "td colspan=4 bgcolor=gray"]      # use something like ["some data to appear", "td colspan=4 bgcolor=gray"]
454    
455      if (ref($x) eq "ARRAY") {($x, $tag)=@$x; if ($tag =~ /td/) {$endtag = "td"}}      if (ref($x) eq "ARRAY") {($x, $tag)=@$x; if ($tag =~ /td/) {$endtag = "td"}}
456    
457      if ($x =~ /^\@([^:]+)\:(.*)$/)      if ($x =~ /^\@([^:]+)\:(.*)$/)
# Line 524  Line 562 
562      return $family;      return $family;
563  }  }
564    
 use URI::Escape;  
565    
566  sub get_html {  sub get_html {
567      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
# Line 855  Line 892 
892      my $user = $cgi->param('user');      my $user = $cgi->param('user');
893      if ($user)      if ($user)
894      {      {
895          $sub_link = "<a href=./subsys.cgi?ssa_name=$sub&request=show_ssa&user=$user>$sub</a>";          my $esc_sub = uri_escape( $sub );
896            $sub_link = "<a href=./subsys.cgi?ssa_name=$esc_sub&request=show_ssa&user=$user>$sub</a>";
897      }      }
898      else      else
899      {      {

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3