[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.41, Thu Apr 28 20:56:37 2005 UTC revision 1.47, Fri Jul 22 20:42:30 2005 UTC
# Line 22  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 45  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 69  Line 79 
79      my($cgi,$html,$no_home, $alt_header, $css, $javasrc) = @_;      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 83  Line 92 
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') || "";
# Line 222  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 261  Line 270 
270    
271      if (!$css || !$css->{'Default'})      if (!$css || !$css->{'Default'})
272      {      {
273         $css->{'Default'}="/FIG/Html/css/default.css";         $css->{'Default'}=$FIG_Config::cgi_url."/Html/css/default.css";
274      }      }
275      if (!$css->{"Sans Serif"})      if (!$css->{"Sans Serif"})
276      {      {
277         $css->{'Sans Serif'}="/FIG/Html/css/sanserif.css";         $css->{'Sans Serif'}=$FIG_Config::cgi_url."/Html/css/sanserif.css";
278      }      }
279      my $csstext = "<link rel='stylesheet' title='default' href='".$css->{'Default'}."' type='text/css'>\n";      my $csstext = "<link rel='stylesheet' title='default' href='".$css->{'Default'}."' type='text/css'>\n";
280      $csstext   .= "<link rel='alternate stylesheet' title='Sans Serif' href='".$css->{'Sans Serif'}."' type='text/css'>\n";      $csstext   .= "<link rel='alternate stylesheet' title='Sans Serif' href='".$css->{'Sans Serif'}."' type='text/css'>\n";
# Line 281  Line 290 
290      # we are cluttering the HTML code with all the javascripts when they could easily be in external files      # 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      # 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      # $javasrc must be a ref to an array with urls (absolute or relative) to the javascripts
297      if ($javasrc && ref($javasrc) eq "ARRAY") {      push @$javasrc, "/FIG/Html/css/FIG.js";
298       foreach my $script (@$javasrc) {       foreach my $script (@$javasrc) {
299        $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";        $csstext .= "<script src=\"$script\" type=\"text/javascript\"></script>\n";
300       }       }
     }  
301    
302    
303    
# Line 400  Line 411 
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    
414      print @$html;      foreach $_ (@$html)
415        {
416            print $_;
417        }
418  }  }
419    
420  sub make_table {  sub make_table {
# Line 440  Line 454 
454      # things like colspan and align. Note that in this case you need to include the td      # 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" } }      # per GJO's request modified this line so it can take any tag.
458        if ( ref($x) eq "ARRAY" ) { ($x, $tag) = @$x; $tag =~ /^(\S+)/; $endtag = $1 }
459    
460      if ( $x =~ /^\@([^:]+)\:(.*)$/ )      if ( $x =~ /^\@([^:]+)\:(.*)$/ )
461      {      {
# Line 452  Line 467 
467      }      }
468  }  }
469    
470    
471    sub merge_table_rows {
472     # RAE:
473     # Experimental piece of code. We often want to have rows or columns were cells are merged. It just looks so much nicer
474     # this block should merge adjacent rows that have the same text in them.
475     # use like this:
476     #      $tab=&HTML::merge_table_rows($tab);
477     # before you do a make_table call
478    
479     my $self=shift if UNIVERSAL::isa($_[0],__PACKAGE__);
480     my ($tab)=@_;
481    
482     my $newtable;
483     my $lastrow;
484     my $rowspan;
485     my $refs;
486    
487     for (my $y=0; $y <= $#$tab; $y++) {
488     #$y is the row in the table;
489      for (my $x=0; $x <= $#{$tab->[$y]}; $x++) {
490       #$x is the column in the table
491       # if the column in the row we are looking at is the same as the column in the previous row, we don't add
492       # this cell to $newtable. Instead we increment the rowspan of the previous row by one
493    
494       # handle cells that are references to arrays
495       if (ref($tab->[$y]->[$x]) eq "ARRAY") {$refs->[$y]->[$x]=$tab->[$y]->[$x]->[1]; $tab->[$y]->[$x]=$tab->[$y]->[$x]->[0]}
496    
497       # now we go back through the table looking where to draw the merge line:
498       my $lasty=$y;
499       while ($tab->[$y]->[$x] eq $tab->[$lasty]->[$x]) {$lasty--}
500       $lasty++; # this is the last identical cell. If lasty==y it is the current cell, so we just save the data. Otherwise we increment the rowspan
501       if ($lasty == $y) {
502        # we always want to have something in rows that may otherwise be empty but should be there (see below)
503        unless ($tab->[$y]->[$x]) {$tab->[$y]->[$x]=" &nbsp; "}
504        $newtable->[$y]->[$x] = $tab->[$y]->[$x];
505       }
506       else {$rowspan->[$lasty]->[$x]++}
507      }
508     }
509    
510     # now just join everything back together
511     for (my $y=0; $y <= $#$tab; $y++) {
512      for (my $x=0; $x <= $#{$tab->[$y]}; $x++) {
513       if ($rowspan->[$y]->[$x]) {
514        if ($refs->[$y]->[$x]) {$refs->[$y]->[$x] .= " rowspan=". ($rowspan->[$y]->[$x]+1)}
515        else {$refs->[$y]->[$x] = "td rowspan=". ($rowspan->[$y]->[$x]+1)}
516        $newtable->[$y]->[$x]=[$newtable->[$y]->[$x], $refs->[$y]->[$x]];
517       }
518       elsif ($newtable->[$y]->[$x] && $refs->[$y]->[$x]) {
519        $newtable->[$y]->[$x]=[$newtable->[$y]->[$x], $refs->[$y]->[$x]];
520       }
521      }
522     }
523    
524    
525     # finally we have to remove any completely empty cells that have been added by the array mechanism
526     # (e.g. if you define $a->[2] then $a->[0] and $a->[1] are now undef).
527     # that is why in the loop above I replace empty cells with nbsp. They are now not undef!
528     # I am sure that Gary can do this in one line, but I am hacking.
529     my @trimmed;
530     foreach my $a (@$newtable) {
531      my @row;
532      foreach my $b (@$a) {
533       push @row, $b if ($b);
534      }
535      push @trimmed, \@row;
536     }
537    
538     return \@trimmed;
539    }
540    
541    
542    
543    
544  sub set_ec_links {  sub set_ec_links {
545      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
546      my($cgi,$x) = @_;      my($cgi,$x) = @_;
# Line 680  Line 769 
769          $after = $3;          $after = $3;
770          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);
771      }      }
772        elsif ($x =~ /^(.*)(tigr\|[0-9a-zA-Z]+)(.*)/s)
773        {
774            $before = $1;
775            $match = $2;
776            $after = $3;
777            return &set_prot_links($cgi,$before) . &HTML::tigr_link($cgi,$match) . &set_prot_links($cgi,$after);
778        }
779      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)      elsif ($x =~  /^(.*)(uni\|[A-Z0-9]{6})(.*)/s)
780      {      {
781          $before = $1;          $before = $1;
# Line 732  Line 828 
828      return $gi;      return $gi;
829  }  }
830    
831    sub tigr_link {
832        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
833        my($cgi,$tigr) = @_;
834    
835        if ($tigr =~ /^tigr\|([0-9a-zA-Z]+)$/)
836        {
837            return "<a href=\"http://pathema.tigr.org/tigr-scripts/CMR/GenePage.cgi?locus=$1\">$tigr</a>";
838        }
839        return $tigr;
840    }
841    
842  sub uni_link {  sub uni_link {
843      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
844      my($cgi,$uni) = @_;      my($cgi,$uni) = @_;
# Line 805  Line 912 
912      return $link;      return $link;
913  }  }
914    
 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;  
 }  
   
915  sub java_buttons {  sub java_buttons {
916      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
917    ## ADDED BY RAE    ## ADDED BY RAE

Legend:
Removed from v.1.41  
changed lines
  Added in v.1.47

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3