[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.60, Fri Sep 16 20:00:12 2005 UTC revision 1.64, Sat Oct 8 14:14:47 2005 UTC
# Line 11  Line 11 
11  use HTTP::Request::Common;  use HTTP::Request::Common;
12  use POSIX;  use POSIX;
13    
14    
15  sub new  sub new
16  {  {
17      my($class) = @_;      my($class) = @_;
# Line 78  Line 79 
79  sub show_page {  sub show_page {
80      #warn "SHOWPAGE: cgi=", Dumper(@_);      #warn "SHOWPAGE: cgi=", Dumper(@_);
81      shift if UNIVERSAL::isa($_[0],__PACKAGE__);      shift if UNIVERSAL::isa($_[0],__PACKAGE__);
82      my($cgi,$html,$no_home, $alt_header, $css, $javasrc) = @_;      my($cgi,$html,$no_home, $alt_header, $css, $javasrc, $cookie) = @_;
83      my $i;      my $i;
84    
85      # ARGUMENTS:      # ARGUMENTS:
# Line 90  Line 91 
91      #               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
92      #               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
93      #     $javasrc is a reference to an array of URLs to javascripts to be included (e.g. "/FIG/Html/css/styleswitcher.js")      #     $javasrc is a reference to an array of URLs to javascripts to be included (e.g. "/FIG/Html/css/styleswitcher.js")
94        #     $cookie is the name and value of the cookie to set. Note that you should probably use raelib->cookie to get/set your cookies
95      #      #
96      # Find the HTML header      # Find the HTML header
97      #      #
# Line 111  Line 113 
113          @html_hdr = compute_html_header(undef,$user);          @html_hdr = compute_html_header(undef,$user);
114      }      }
115    
116        # RAE: I am offloading the handling of cookies to CGI.pm since I don't know how they are set up.
117        # This modification adds the cookies if necessary
118    
119        # Note: 3/10/05 commented this line out pending the discussion of adding cookies into the seed that we are waiting to see about
120        # to add cookies back in replace these two header lines with each other
121    
122      print $cgi->header;      #print $cgi->header(-cookie=>$cookie);
123        print $cgi->header();
124    
125      #      #
126      #  The SEED header file goes immediately after <BODY>.  Figure out      #  The SEED header file goes immediately after <BODY>.  Figure out
# Line 130  Line 138 
138                       meta     => 1,                       meta     => 1,
139                       nextid   => 1,                       nextid   => 1,
140                       style    => 1,                       style    => 1,
141                       title    => 1                       title    => 1,
142                     );                     );
143    
144      #      #
# Line 332  Line 340 
340  #       }  #       }
341    
342          $base_line = $head_end_line;          $base_line = $head_end_line;
343          splice( @$html, $base_line, 0, "<BASE href=\"$base_url/\">\n" );          #
344            # RDO 2005-1006. Remove this so proxying works better.
345            #
346    #        splice( @$html, $base_line, 0, "<BASE href=\"$base_url/\">\n" );
347      }      }
348    
349      #      #
# Line 430  Line 441 
441      my(@tab);      my(@tab);
442    
443      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";      my $border = defined $options{border} ? "border=\"$options{border}\"" : "border";
444      push( @tab, "\n<table $border>\n",      my $width = defined $options{width} ? "width=\"$options{width}\"" : undef;
445        push( @tab, "\n<table $border $width>\n",
446                  "\t<caption><b>$title</b></caption>\n",                  "\t<caption><b>$title</b></caption>\n",
447                  "\t<tr>\n\t\t"                  "\t<tr>\n\t\t"
448                . join( "\n", map { &expand($_, "th") } @$col_hdrs )                . join( "\n", map { &expand($_, "th") } @$col_hdrs )
# Line 476  Line 488 
488  }  }
489    
490    
491    =head2 merge_table_rows()
492    
493    Merge table rows together. This will merge a table so that adjacent cells with the same content will only be shown once.
494    
495    Something like this:
496    
497        -----------------------
498        |    1     |    a     |
499        -----------------------
500        |    1     |    b     |
501        -----------------------
502        |    2     |    c     |
503        -----------------------
504        |    3     |    d     |
505        -----------------------
506        |    4     |    d     |
507        -----------------------
508        |    5     |    d     |
509        -----------------------
510    
511    Will become:
512    
513        -----------------------
514        |          |    a     |
515        |    1     |-----------
516        |          |    b     |
517        -----------------------
518        |    2     |    c     |
519        -----------------------
520        |    3     |          |
521        ------------          |
522        |    4     |    5     |
523        ------------          |
524        |    5     |          |
525        -----------------------
526    
527    
528    The method takes two arguments. The reference to the array that is the table ($tab). This is the standard table that is created for HTML.pm to draw, and a reference to a hash of columns that you don't want to merge together. The reference to the hash is optional, and if not included, everything will be merged.
529    
530     $tab=&HTML::merge_table_rows($tab);
531    
532     or
533    
534     $skip=(1=>1, 3=>1, 5=>1);
535     $tab=&HTML::merge_table_rows($tab, $skip);  # will merge all columns except 1, 3 and 5. Note the first column in the table is #0
536    
537    
538    =cut
539    
540    
541    
542    
543  sub merge_table_rows {  sub merge_table_rows {
544   # RAE:   # RAE:
545   # Experimental piece of code. We often want to have rows or columns were cells are merged. It just looks so much nicer   # Experimental piece of code. We often want to have rows or columns were cells are merged. It just looks so much nicer
# Line 485  Line 549 
549   # before you do a make_table call   # before you do a make_table call
550    
551   my $self=shift if UNIVERSAL::isa($_[0],__PACKAGE__);   my $self=shift if UNIVERSAL::isa($_[0],__PACKAGE__);
552   my ($tab)=@_;   my ($tab, $skip)=@_;
553    
554   my $newtable;   my $newtable;
555   my $lastrow;   my $lastrow;
# Line 495  Line 559 
559   for (my $y=0; $y <= $#$tab; $y++) {   for (my $y=0; $y <= $#$tab; $y++) {
560   #$y is the row in the table;   #$y is the row in the table;
561    for (my $x=0; $x <= $#{$tab->[$y]}; $x++) {    for (my $x=0; $x <= $#{$tab->[$y]}; $x++) {
562       # this is the user definable columns not to merge
563       if ($skip->{$x})
564       {
565        $newtable->[$y]->[$x] = $tab->[$y]->[$x];
566        next;
567       }
568    
569     #$x is the column in the table     #$x is the column in the table
570     # if the column in the row we are looking at is the same as the column in the previous row, we don't add     # if the column in the row we are looking at is the same as the column in the previous row, we don't add
571     # this cell to $newtable. Instead we increment the rowspan of the previous row by one     # this cell to $newtable. Instead we increment the rowspan of the previous row by one
# Line 642  Line 713 
713  ###  ###
714  ### RAO  ### RAO
715    
716              if (! $cgi_url) { $cgi_url = &FIG::cgi_url }              #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }
717              $link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";              #$link = $cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";
718                $link = "protein.cgi?prot=$fid&user=$user$trans$sprout";
719              $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;              $link =~ s/[a-z_A-Z0-9]+\.cgi\?/protein.cgi?/;
720              #              #
721              # Elimin the p2p part if we're in that subdir. Ugh.              # Elimin the p2p part if we're in that subdir. Ugh.
# Line 938  Line 1010 
1010      $user = $user ? $user : "";      $user = $user ? $user : "";
1011      $org = $org ? $org : "";      $org = $org ? $org : "";
1012    
1013      my $url = &FIG::cgi_url() . "/show_kegg_map.cgi?user=$user&map=$map&org=$org";      my $url = "show_kegg_map.cgi?user=$user&map=$map&org=$org";
1014    #rel    my $url = &FIG::cgi_url() . "/show_kegg_map.cgi?user=$user&map=$map&org=$org";
1015      my $link = "<a href=\"$url\">$map</a>";      my $link = "<a href=\"$url\">$map</a>";
1016      return $link;      return $link;
1017  }  }
# Line 1155  Line 1228 
1228   }   }
1229  }  }
1230    
1231    
1232    
1233  1;  1;
1234    

Legend:
Removed from v.1.60  
changed lines
  Added in v.1.64

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3