[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.37, Tue Mar 15 22:29:27 2005 UTC revision 1.46, Wed Jun 29 04:33:02 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 221  Line 231 
231      #  Added the javascript for the buttons immediately after body.      #  Added the javascript for the buttons immediately after body.
232      #  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,
233      #  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!
234        #  RAE: This is now deprecated because everything is in an external file, FIG.js, included later
235    
236      if ( $body_line < 0 )      if ( $body_line < 0 )
237      {      {
         my $js=&javascript;  
238          $body_line = $last_head_line + 1;          $body_line = $last_head_line + 1;
239          splice( @$html, $body_line, 0, "<BODY>\n$js\n" );          splice( @$html, $body_line, 0, "<BODY>\n" );
240      }      }
241    
242      #      #
# 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        # the file FIG.js contains most of the java script we use routinely. Every browser will just cache this and so
294        # it will reduce our overhead.
295    
296        # $javasrc must be a ref to an array with urls (absolute or relative) to the javascripts
297        push @$javasrc, "/FIG/Html/css/FIG.js";
298        foreach my $script (@$javasrc) {
299         $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";
300      }      }
301    
302    
303    
304      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.
305    
306      #      #
# Line 374  Line 402 
402          splice( @$html, $i, 0, @tags );          splice( @$html, $i, 0, @tags );
403      }      }
404    
405      # 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,
406      # 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,
407        # and others don't. This should make nicer looking html
408        #
409      #chomp(@$html);      #chomp(@$html);
410      #print join "\n", @$html;      #print join "\n", @$html;
411        #
412      # Apparently the above still breaks things. This is the correct code:      # Apparently the above still breaks things. This is the correct code:
413      print @$html;  
414        foreach $_ (@$html)
415        {
416            print $_;
417        }
418  }  }
419    
420  sub make_table {  sub make_table {
# Line 414  Line 448 
448    
449      $tag = "td" unless $tag;      $tag = "td" unless $tag;
450      my $endtag=$tag;      my $endtag=$tag;
451      # RAE modified this so that you can pass in a reference to an array where the first element is the data to  
452      # 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
453        # the first element is the data to display and the second element is optional
454        # things like colspan and align. Note that in this case you need to include the td
455      # use something like ["some data to appear", "td colspan=4 bgcolor=gray"]      # use something like ["some data to appear", "td colspan=4 bgcolor=gray"]
456    
457      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"}}
458    
459      if ($x =~ /^\@([^:]+)\:(.*)$/)      if ($x =~ /^\@([^:]+)\:(.*)$/)
# Line 527  Line 564 
564      return $family;      return $family;
565  }  }
566    
 use URI::Escape;  
567    
568  sub get_html {  sub get_html {
569      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
# Line 658  Line 694 
694          $after = $3;          $after = $3;
695          return &set_prot_links($cgi,$before) . &HTML::gi_link($cgi,$match) . &set_prot_links($cgi,$after);          return &set_prot_links($cgi,$before) . &HTML::gi_link($cgi,$match) . &set_prot_links($cgi,$after);
696      }      }
697        elsif ($x =~ /^(.*)(tigr\|[0-9a-zA-Z]+)(.*)/s)
698        {
699            $before = $1;
700            $match = $2;
701            $after = $3;
702            return &set_prot_links($cgi,$before) . &HTML::tigr_link($cgi,$match) . &set_prot_links($cgi,$after);
703        }
704      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)
705      {      {
706          $before = $1;          $before = $1;
# Line 710  Line 753 
753      return $gi;      return $gi;
754  }  }
755    
756    sub tigr_link {
757        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
758        my($cgi,$tigr) = @_;
759    
760        if ($tigr =~ /^tigr\|([0-9a-zA-Z]+)$/)
761        {
762            return "<a href=\"http://pathema.tigr.org/tigr-scripts/CMR/GenePage.cgi?locus=$1\">$tigr</a>";
763        }
764        return $tigr;
765    }
766    
767  sub uni_link {  sub uni_link {
768      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
769      my($cgi,$uni) = @_;      my($cgi,$uni) = @_;
# Line 783  Line 837 
837      return $link;      return $link;
838  }  }
839    
 sub javascript {  
     shift if UNIVERSAL::isa($_[0],__PACKAGE__);  
         #### MODIFIED BY RAE TO ADD JAVA SUPPORT FOR CHECK ALL/UNCHECK ALL  
         # This routine takes three arguments, $html, $form, and $button  
         # $html is the ref to the array with the html in it  
         # $form is the name of the form. This must be added whenever start_form is called  
         # by including a -name entry. This is only used for the javascript  
         # $button is the name of the button that should be checked/unchecked.  
         #  
         # At the moment this add's four buttons:  
         # Check all, check's all  
         # Check first half will check the first 50% of the entries  
         # Check second half will check the second 50% of the entries  
         # Uncheck all will remove the checks.  
   
         # Note that the other change is I added a -name=>'fig_checked' to the start_form  
         # field. The name is needed for the java script.  
         #  
   
           $java_script=<<EOF;  
   <SCRIPT LANGUAGE="JavaScript">  
   <!-- Begin  
   function checkAll(field)  
   {  
    for (i = 0; i < field.length; i++)  
    field[i].checked = true ;  
   }  
   
   function checkFirst(field)  
   {  
    for (i = 0; i < field.length/2; i++)  
    field[i].checked = true;  
   }  
   
   function checkSecond(field)  
   {  
    for (i=Math.round(field.length/2); i < field.length; i++)  
    field[i].checked = true ;  
   }  
   
   function uncheckAll(field)  
   {  
    for (i = 0; i < field.length; i++)  
    field[i].checked = false ;  
   }  
   //  End -->  
   </script>  
 EOF  
         return $java_script;  
 }  
   
840  sub java_buttons {  sub java_buttons {
841      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
842    ## ADDED BY RAE    ## ADDED BY RAE
# Line 858  Line 861 
861      my $user = $cgi->param('user');      my $user = $cgi->param('user');
862      if ($user)      if ($user)
863      {      {
864          $sub_link = "<a href=./subsys.cgi?ssa_name=$sub&request=show_ssa&user=$user>$sub</a>";          my $esc_sub = uri_escape( $sub );
865            $sub_link = "<a href=./subsys.cgi?ssa_name=$esc_sub&request=show_ssa&user=$user>$sub</a>";
866      }      }
867      else      else
868      {      {

Legend:
Removed from v.1.37  
changed lines
  Added in v.1.46

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3