[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.4, Fri Mar 19 20:26:58 2004 UTC revision 1.6, Sun Mar 21 02:20:55 2004 UTC
# Line 29  Line 29 
29    
30    
31      print $cgi->header;      print $cgi->header;
32      print "<base href=\"" . &FIG::cgi_url . "/\">\n";  
33      for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<body\>/i); $i++) {}      #
34      if ($i < @$html)      #  The SEED header file goes immediately after <BODY>.  Figure out
35        #  what parts of the HTML document skeleton are there, and fill in
36        #  missing ones.
37        #
38        #  This list should be as comprehensive as feasible:
39        #
40    
41        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            #  Some special cases:
81    
82            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          splice(@$html,$i+1,0,`cat $html_hdr_file`);              $body_line = $i;
92                $last;
93      }      }
94      else  
95            #  Now the general case.
96            #  Analyze all the html tags on the line:
97    
98            foreach ( $html->[$i] =~ /\<\/?([0-9a-z]+)/ig )
99      {      {
100          for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<html\>/i); $i++) {}              #  At first body tag, we stop the search and put the text
101          if ($i < @$html)              #  after the last line with a head tag:
102    
103                if ( $body_tag{ lc $_ } )
104          {          {
105              splice(@$html,$i+1,0,`cat $html_hdr_file`);                  $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              splice(@$html,0,0,`cat $html_hdr_file`);                  $last_head_line = $i;
114                }
115          }          }
116            last if $done;      # When done, break loop to avoid increment
117      }      }
118    
119      @tail = `cat $html_tail_file`;      #  Some sanity checks on structure:
120      if (! $no_home)  
121        if ( 1 )
122      {      {
123          my $user = $cgi->param('user');          if ( $html_line >= 0 )
124          $user = $user ? $user : "";          {
125          my $link = $cgi->url();              if ( ( $head_line >= 0 ) && ( $html_line > $head_line ) )
126          $link =~ s/[a-zA-Z_]+\.cgi$/index.cgi/;              {
127          push(@tail,"<hr><a href=\"$link?user=$user\">FIG search</a>\n");                  print STDERR "<HTML> tag follows <HEAD> tag\n";
128                }
129                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                    print STDERR "<HEAD> tag follows </HEAD> tag\n";
139                }
140      }      }
141        }
142    
143        #
144        #  Okay.  Let's put in the html header file, and missing tags:
145        #
146        #  <BODY> goes after last head line
147        #
148    
149      if (@tail > 0)      if ( $body_line < 0 )
150      {      {
151          for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<\/body\>/i); $i++) {}          $body_line = $last_head_line + 1;
152          if ($i < @$html)          splice( @$html, $body_line, 0, "<BODY>\n" );
153        }
154    
155        #
156        #  Seed page header (if it exists) goes after <BODY>
157        #
158    
159        if ( -f $html_hdr_file )
160          {          {
161              splice(@$html,$i,0,@tail);          splice( @$html, $body_line + 1, 0, `cat $html_hdr_file` );
162          }          }
163          else  
164        #
165        #  </HEAD> goes before <BODY>
166        #
167    
168        if ( $head_end_line < 0 )
169          {          {
170              for ($i=0; ($i < @$html) && ($html->[$i] !~ /\<\/html\>/i); $i++) {}          $head_end_line = $body_line;
171              if ($i < @$html)          splice( @$html, $body_line, 0, "</HEAD>\n" );
172        }
173    
174        #
175        #  <BASE ...> goes before </HEAD>
176        #
177    
178        if ( $base_line < 0 )
179        {
180            #
181            #  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                  splice(@$html,$i,0,@tail);              $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              else  
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            $html_line = 0;
206            splice( @$html, $html_line, 0, "<HTML>\n" );
207        }
208    
209        #
210        #  <HEAD> goes after <HTML>
211        #
212    
213        if ( $head_line < 0 )
214              {              {
215                  push(@$html,@tail);          $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 @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 85  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 95  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 106  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.4  
changed lines
  Added in v.1.6

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3