[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.55, Fri Aug 19 15:47:54 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 616  Line 687 
687          {          {
688              $n = $fid;              $n = $fid;
689          }          }
690          if ($1 ne "peg") { return $n }  
691            my $link;
692            #added to format prophage and path island links to feature.cgi
693            if ($1 ne "peg")
694            {
695               my $user = $cgi->param('user');
696               if (! $user) { $user = "" }
697               my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";
698               $link = &FIG::cgi_url . "/feature.cgi?feature=$fid&user=$user$trans$sprout";
699               $link =~ s/[a-z_A-Z0-9]+\.cgi\?/feature.cgi?/;
700            }
701            else
702            {
703          my $user = $cgi->param('user');          my $user = $cgi->param('user');
704          if (! $user) { $user = "" }          if (! $user) { $user = "" }
705          my $trans = $cgi->param('translate') ? "&translate=1" : "";          my $trans = $cgi->param('translate') ? "&translate=1" : "";
706          my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";          my $sprout = $cgi->param('SPROUT') ? "&SPROUT=1" : "";
707          my $link = &FIG::cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";  ###a
708    
709    ### This used to be
710    ###     my $link = &FIG::cgi_url . "/protein.cgi?prot=$fid&user=$user$trans$sprout";
711    ###
712    ### The cost became prohibitive in the subsystem spreadsheets.  Hence, we cache the value
713    ###
714    ### RAO
715    
716                #if (! $cgi_url) { $cgi_url = &FIG::cgi_url }
717                #$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.
722          #          #
723          $link =~ s,p2p/protein.cgi,protein.cgi,;          $link =~ s,p2p/protein.cgi,protein.cgi,;
724            }
725          if ($just_url)          if ($just_url)
726          {          {
727              return $link;              return $link;
# Line 916  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 1133  Line 1228 
1228   }   }
1229  }  }
1230    
1231    
1232    
1233  1;  1;
1234    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3