6 use vars qw/%DB %OWNS %PARENT %CURR $last_field $debugmatch $debugparse $key $owner $parent $ref $note_rest $printdupl $maxsize $fileno $fileid $filename/;
27 my( @list )=("Genus","Species");
31 while ($item=shift @list)
32 { $r.=" ".$rec{$item} if exists $rec{$item}; }
51 my( $preinsert,$postinsert,%rec )=@_;
54 print OUT "<table border=\"1\" frame=\"border\" rules=\"none\"><col width=\"0*\" /><col width=\"1*\" />\n";
55 print OUT "<tr><th colspan=\"2\">".$preinsert.&rec_to_name(%rec).$postinsert."</th></tr>\n";
57 delete $rec{"Species"};
58 foreach $key (sort keys %rec)
59 { print OUT "<tr><td class=\"left\">".&htmlquote($key).":</td><td>".&htmlquote($rec{$key})."</td></tr>\n"; }
60 print OUT "</table>\n";
67 $key=&name_to_key(&rec_to_name(%CURR));
69 delete $CURR{"Family"};
71 { print STDERR "Key \"$key\" is duplicated!\n" if $printdupl; }
73 print STDERR "ADDKEY: $key\n" if $debugparse;
84 if (/^ *\304\301\304/) {
86 print STDERR "---\n" if $debugparse;
88 elsif (/^([^³]*[^ ]) *³ *(.*)$/) {
89 print STDERR "FIELD: $1, VALUE: $2\n" if $debugparse;
93 elsif (/^ *³ *(.*)$/) {
94 print STDERR "APPEND: $1\n" if $debugparse;
95 $CURR{$last_field}.=" ".$1;
98 print STDERR "DISCARD: $_\n" if $debugparse;
108 my( $reparent,$refkey );
110 $refkey=&name_to_key($ref);
111 return 0 if ($refkey eq "");
112 return 0 if ($parent eq $refkey);
113 return 0 if !exists $DB{$refkey};
114 print STDERR "try_reparent: SUCCESS: key=\"$key\", refkey=\"$refkey\"\n" if $debugmatch;
116 { $DB{$key}{"Notes"}=$note_rest; }
118 { delete $DB{$key}{"Notes"}; }
120 foreach $reparent (@{$OWNS{$parent}}) {
121 $PARENT{$reparent}=$refkey;
123 @{$OWNS{$parent}}=() if (!defined $OWNS{$parent});
124 @{$OWNS{$refkey}}=() if (!defined $OWNS{$refkey});
125 @{$OWNS{$refkey}}=(@{$OWNS{$refkey}},$parent,@{$OWNS{$parent}});
126 delete $OWNS{$parent};
131 MATCH: foreach $key (keys %DB) {
132 $parent=$PARENT{$key};
133 $parent=$key if (!defined $parent);
134 $ref=$DB{$key}{"Notes"};
135 next MATCH if (!defined $ref);
139 $ref=~s/^Orchidaceae *//i;
142 next MATCH if &try_reparent();
143 $ref=$DB{$key}{"Rank"}." $ref" if exists $DB{$key}{"Rank"};
144 next MATCH if &try_reparent();
145 $ref=$DB{$key}{"Genus"}." $ref" if exists $DB{$key}{"Genus"};
146 next MATCH if &try_reparent();
155 "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
156 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
157 <html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
158 <head><title>Kewensis $header</title>
159 <style type=\"text/css\"><!--
160 table { border: ridge; }
161 blockquote table { border: groove; }
163 td.left { white-space: nowrap; font-style: italic; }
173 print OUT "</body></html>\n";
178 foreach $owner (sort keys %OWNS) {
181 if ($fileno<0 || tell(OUT)>=$maxsize) {
182 &OUT_flush() if ($fileno>=0);
183 $fileid=sprintf("%04d",++$fileno);
184 $filename="kew-$fileid.html";
185 open(OUT,">$filename") or die "Cannot open \"$filename\": $!";
186 &print_header("chunk $fileid");
190 print STDERR "($owner):";
191 foreach $child (@{$OWNS{$owner}})
192 { print STDERR " ($child)"; }
195 &print_rec("<a name=\"".&htmlquote($owner)."\">","</a>",%{$DB{$owner}});
196 if (@{$OWNS{$owner}}) {
197 print OUT "<blockquote>\n";
198 foreach $child (reverse @{$OWNS{$owner}})
199 { &print_rec("","",%{$DB{$child}}); }
200 print OUT "</blockquote>\n";
203 $DB{$owner}{"_filename"}=$filename;
206 open(OUT,">kew-index.html") or die "Cannot open \"kew-index.html\": $!";
207 &print_header("Index");
212 my(%rec)=%{$DB{$owner}};
214 print OUT &htmlquote(&rec_to_name(%rec));
217 foreach $owner (sort keys %OWNS) {
220 print OUT "<p><a href=\"".$DB{$owner}{"_filename"}."#$owner\">";
222 print OUT "</a></p>";
223 if (@{$OWNS{$owner}}) {
225 foreach $child (reverse @{$OWNS{$owner}}) {