[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.5, Fri Mar 19 21:58:31 2004 UTC revision 1.6, Sun Mar 21 02:20:55 2004 UTC
# Line 31  Line 31 
31      print $cgi->header;      print $cgi->header;
32    
33      #      #
34      #  Use a relative base address for pages.  Also, because I am worried      #  The SEED header file goes immediately after <BODY>.  Figure out
35      #  about when FIG_config.pm gets updated (clean installs only, or every      #  what parts of the HTML document skeleton are there, and fill in
36      #  update?), I provide an alternative derivation from $cgi_url. -- GJO      #  missing ones.
37      #      #
38      #  print "<base href=\"" . &FIG::cgi_url . "/\">\n";      #  This list should be as comprehensive as feasible:
39      #      #
40      my $base_url = $FIG_Config::cgi_base;  
41      if ( ! $base_url )                      # if cgi_base was not defined      my %head_tag = ( base     => 1,
42                         basefont => 1,
43                         html     => 1,
44                         isindex  => 1,
45                         link     => 1,
46                         meta     => 1,
47                         nextid   => 1,
48                         style    => 1,
49                         title    => 1
50                       );
51    
52        #
53        #  This list need not be comprehensive; it is just stopping conditions:
54        #
55    
56        my %body_tag = ( a      => 1,
57                         br     => 1,
58                         center => 1,
59                         form   => 1,
60                         h1     => 1,
61                         h2     => 1,
62                         h3     => 1,
63                         hr     => 1,
64                         img    => 1,
65                         p      => 1,
66                         pre    => 1,
67                         table  => 1
68                       );
69    
70        my $html_line = -1;
71        my $head_line = -1;
72        my $base_line = -1;
73        my $head_end_line = -1;
74        my $body_line = -1;
75        my $last_head_line = -1;  #  If no head tags are found, text goes at top.
76        my $done = 0;
77    
78        for ( $i = 0; $i < @$html; $i++ )
79      {      {
80          $base_url = $FIG_Config::cgi_url;   # get the full cgi url          #  Some special cases:
81          $base_url =~ s~^http://[^/]*~~;     # remove protocol and host  
82          $base_url =~ m~/$~ || $base_url =~ s~$~/~;  # and add trailing slash?          if ( $html->[$i] =~ /\<html[^0-9a-z]/i ) { $html_line = $i }
83            if ( $html->[$i] =~ /\<head[^0-9a-z]/i ) { $head_line = $i }
84            if ( $html->[$i] =~ /\<base[^0-9a-z]/i ) { $base_line = $i }
85            if ( $html->[$i] =~ /\<\/head\>/i )      { $head_end_line = $i }
86    
87            #  The content goes after this line:
88    
89            if ( $html->[$i] =~ /\<body[^0-9a-z]/i )
90            {
91                $body_line = $i;
92                $last;
93      }      }
     print "<base href=\"$base_url\">\n";  
94    
95      for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<body\>/i); $i++) {}          #  Now the general case.
96      if ($i < @$html)          #  Analyze all the html tags on the line:
97    
98            foreach ( $html->[$i] =~ /\<\/?([0-9a-z]+)/ig )
99      {      {
100          splice(@$html,$i+1,0,`cat $html_hdr_file`);              #  At first body tag, we stop the search and put the text
101                #  after the last line with a head tag:
102    
103                if ( $body_tag{ lc $_ } )
104                {
105                    $done = 1;
106                    last;
107      }      }
108      else  
109                #  If this is a head tag, then move the marker forward
110    
111                elsif ( $head_tag{ lc $_ } )
112      {      {
113          for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<html\>/i); $i++) {}                  $last_head_line = $i;
114          if ($i < @$html)              }
115            }
116            last if $done;      # When done, break loop to avoid increment
117        }
118    
119        #  Some sanity checks on structure:
120    
121        if ( 1 )
122        {
123            if ( $html_line >= 0 )
124            {
125                if ( ( $head_line >= 0 ) && ( $html_line > $head_line ) )
126          {          {
127              splice(@$html,$i+1,0,`cat $html_hdr_file`);                  print STDERR "<HTML> tag follows <HEAD> tag\n";
128          }          }
129          else              if ( ( $head_end_line >= 0 ) && ( $html_line > $head_end_line ) )
130                {
131                    print STDERR "<HTML> tag follows </HEAD> tag\n";
132                }
133            }
134            if ( $head_line >= 0 )
135            {
136                if ( ( $head_end_line >= 0 ) && ( $head_line > $head_end_line ) )
137          {          {
138              splice(@$html,0,0,`cat $html_hdr_file`);                  print STDERR "<HEAD> tag follows </HEAD> tag\n";
139                }
140          }          }
141      }      }
142    
143      @tail = `cat $html_tail_file`;      #
144      if (! $no_home)      #  Okay.  Let's put in the html header file, and missing tags:
145        #
146        #  <BODY> goes after last head line
147        #
148    
149        if ( $body_line < 0 )
150      {      {
151          my $user = $cgi->param('user');          $body_line = $last_head_line + 1;
152          $user = $user ? $user : "";          splice( @$html, $body_line, 0, "<BODY>\n" );
         my $link = $cgi->url();  
         $link =~ s/[a-zA-Z_]+\.cgi$/index.cgi/;  
         push(@tail,"<hr><a href=\"$link?user=$user\">FIG search</a>\n");  
153      }      }
154    
155      if (@tail > 0)      #
156        #  Seed page header (if it exists) goes after <BODY>
157        #
158    
159        if ( -f $html_hdr_file )
160      {      {
161          for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<\/body\>/i); $i++) {}          splice( @$html, $body_line + 1, 0, `cat $html_hdr_file` );
162          if ($i < @$html)      }
163    
164        #
165        #  </HEAD> goes before <BODY>
166        #
167    
168        if ( $head_end_line < 0 )
169          {          {
170              splice(@$html,$i,0,@tail);          $head_end_line = $body_line;
171            splice( @$html, $body_line, 0, "</HEAD>\n" );
172          }          }
173          else  
174        #
175        #  <BASE ...> goes before </HEAD>
176        #
177    
178        if ( $base_line < 0 )
179          {          {
180              for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<\/html\>/i); $i++) {}          #
181              if ($i < @$html)          #  Use a relative base address for pages.  Also, because I am
182            #  worried about when FIG_config.pm gets updated (clean installs
183            #  only, or every update?), I provide an alternative derivation
184            #  from $cgi_url. -- GJO
185            #
186    
187            my $base_url = $FIG_Config::cgi_base;
188            if ( ! $base_url )                      # if cgi_base was not defined
189            {
190                $base_url = $FIG_Config::cgi_url;   # get the full cgi url
191                $base_url =~ s~^http://[^/]*~~;     # remove protocol and host
192                $base_url =~ m~/$~ || $base_url =~ s~$~/~; # check trailing slash
193            }
194    
195            $base_line = $head_end_line;
196            splice( @$html, $base_line, 0, "<BASE href=\"$base_url\">\n" );
197        }
198    
199        #
200        #  <HTML> goes at the top of the output
201        #
202    
203        if ( $html_line < 0 )
204              {              {
205                  splice(@$html,$i,0,@tail);          $html_line = 0;
206            splice( @$html, $html_line, 0, "<HTML>\n" );
207              }              }
208              else  
209        #
210        #  <HEAD> goes after <HTML>
211        #
212    
213        if ( $head_line < 0 )
214        {
215            $head_line = $html_line + 1;
216            splice( @$html, $head_line, 0, "<HEAD>\n" );
217        }
218    
219        #
220        #  Place FIG search link at bottom of page
221        #
222    
223        my @tail = -f $html_tail_file ? `cat $html_tail_file` : ();
224        if (! $no_home)
225        {
226            my $user = $cgi->param('user') || "";
227            push( @tail, "<hr><a href=\"index.cgi?user=$user\">FIG search</a>\n" );
228        }
229    
230        #
231        #  Figure out where to insert The SEED tail.  Before </body>,
232        #  or before </html>, or at end of page.
233        #
234    
235        my @tags = ();
236    
237        for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<\/body\>/i); $i++) {}
238        if ($i >= @$html)        # </body> not found; look for </html>
239        {
240            push @tags, "\n</BODY>\n";
241            # Even if tag is not found, index points to correct place for splice
242            for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<\/html\>/i); $i++) {}
243            if ($i >= @$html)    # </html> not found; add it
244              {              {
245                  push(@$html,@tail);              push @tags, "</HTML>\n";
246            }
247              }              }
248    
249        if ( @tail )
250        {
251            splice( @$html, $i, 0, @tail, @tags );
252          }          }
253        elsif ( @tags )
254        {
255            splice( @$html, $i, 0, @tags );
256      }      }
257    
258      print @$html;      print @$html;
259  }  }
260    
# Line 101  Line 262 
262      my($col_hdrs,$tab,$title,$instr) = @_;      my($col_hdrs,$tab,$title,$instr) = @_;
263      my(@tab);      my(@tab);
264    
265      push(@tab,"<table border><caption><b>$title</b></caption>\n");      push( @tab, "\n<table border>\n",
266      push(@tab,"<tr><th>" . join("</th><th>",@$col_hdrs) . "</th></tr>\n");                  "\t<caption><b>$title</b></caption>\n",
267                    "\t<tr>\n\t\t<th>"
268                  . join( "</th>\n\t\t<th>", @$col_hdrs )
269                  . "</th>\n\t</tr>\n"
270            );
271      my($i,$nowrap);      my($i,$nowrap);
272    
273      for ($i=0; ($i < @$instr) && ($instr->[$i] !~ /nowrap/); $i++) {}      for ($i=0; ($i < @$instr) && ($instr->[$i] !~ /nowrap/); $i++) {}
# Line 111  Line 276 
276      my $row;      my $row;
277      foreach $row (@$tab)      foreach $row (@$tab)
278      {      {
279          push(@tab,"<tr>" . join("</td>",map { &expand($_,$nowrap) } @$row) . "</td></tr>\n");          push( @tab, "\t<tr>\n"
280                      . join( "\n", map { &expand($_,$nowrap) } @$row )
281                      . "\n\t</tr>\n"
282                );
283      }      }
284      push(@tab,"</table>\n");      push(@tab,"</table>\n");
285      return join("",@tab);      return join("",@tab);
# Line 122  Line 290 
290    
291      if ($x =~ /^\@([^:]+)\:([^:]+)\:(.*)$/)      if ($x =~ /^\@([^:]+)\:([^:]+)\:(.*)$/)
292      {      {
293          return "<td$nowrap $1=\"$2\">$3";          return "\t\t<td$nowrap $1=\"$2\">$3</td>";
294      }      }
295      else      else
296      {      {
297          return "<td$nowrap>$x";          return "\t\t<td$nowrap>$x</td>";
298      }      }
299  }  }
300    

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3