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 )=@_;
53 my($r)="<p><span class=\"name\">".$preinsert.&htmlquote(&rec_to_name(%rec)).$postinsert."</span>";
54 $r.="\n".htmlquote($rec{"Publ. Author"}) if (exists($rec{"Publ. Author"}));
55 $r.="<br />\n".htmlquote($rec{"Publication"}) if (exists($rec{"Publication"}));
56 $r.="<br />\n".htmlquote($rec{"Notes"}) if (exists($rec{"Notes"}));
65 s/\(([0-9]{4}) publ. [0-9]{4}\)/($1)/g;
66 while (/\(([0-9]{4})(-[0-9]+)?\)/) {
67 return $1 if ($1>=1700 && $1<=2010);
78 $key=&name_to_key(&rec_to_name(%CURR));
80 delete $CURR{"Family"};
82 { print STDERR "Key \"$key\" is duplicated!\n" if $printdupl; }
84 print STDERR "ADDKEY: $key\n" if $debugparse;
86 # my($year)=&extract_year($CURR{"Notes"});
87 # %{$DB{$key}}{"year"}=$year if (defined($year));
97 if (/^ *\304\301\304/) {
99 print STDERR "---\n" if $debugparse;
101 elsif (/^([^³]*[^ ]) *³ *(.*)$/) {
102 print STDERR "FIELD: $1, VALUE: $2\n" if $debugparse;
106 elsif (/^ *³ *(.*)$/) {
107 print STDERR "APPEND: $1\n" if $debugparse;
108 $CURR{$last_field}.=" ".$1;
111 print STDERR "DISCARD: $_\n" if $debugparse;
121 my( $reparent,$refkey );
123 $refkey=&name_to_key($ref);
124 return 0 if ($refkey eq "");
125 return 0 if ($parent eq $refkey);
126 return 0 if !exists $DB{$refkey};
127 print STDERR "try_reparent: SUCCESS: key=\"$key\", refkey=\"$refkey\"\n" if $debugmatch;
129 { $DB{$key}{"Notes"}=$note_rest; }
131 { delete $DB{$key}{"Notes"}; }
133 foreach $reparent (@{$OWNS{$parent}}) {
134 $PARENT{$reparent}=$refkey;
136 @{$OWNS{$parent}}=() if (!exists $OWNS{$parent});
137 @{$OWNS{$refkey}}=() if (!exists $OWNS{$refkey});
138 @{$OWNS{$refkey}}=(@{$OWNS{$refkey}},$parent,@{$OWNS{$parent}});
139 delete $OWNS{$parent};
144 MATCH: foreach $key (keys %DB) {
145 $parent=$PARENT{$key};
146 $parent=$key if (!defined $parent);
147 $ref=$DB{$key}{"Notes"};
148 next MATCH if (!defined $ref);
152 $ref=~s/^Orchidaceae *//i;
155 next MATCH if &try_reparent();
156 $ref=$DB{$key}{"Rank"}." $ref" if exists $DB{$key}{"Rank"};
157 next MATCH if &try_reparent();
158 $ref=$DB{$key}{"Genus"}." $ref" if exists $DB{$key}{"Genus"};
159 next MATCH if &try_reparent();
163 #foreach $key (keys %DB) {
164 # $DB{$key}{"Publication"}=&extract_year($DB{$key}{"Publication"})." ::: ".$DB{$key}{"Publication"}
165 # if (exists($DB{$key}{"Publication"}));
168 foreach $key (keys %OWNS) {
169 my(@keys)=@{$OWNS{$key}};
172 @keys=sort { &extract_year($DB{$b}{"Publication"}) <=> &extract_year($DB{$a}{"Publication"}); } @keys;
173 my($pkey)=shift(@keys);
174 @{$OWNS{$pkey}}=@keys;
182 "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
183 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
184 <html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\">
185 <head><title>Kewensis $header</title>
186 <style type=\"text/css\"><!--
187 .name { font-weight: bold; }
197 print OUT "</body></html>\n";
202 foreach $owner (sort keys %OWNS) {
205 if ($fileno<0 || tell(OUT)>=$maxsize) {
206 &OUT_flush() if ($fileno>=0);
207 $fileid=sprintf("%04d",++$fileno);
208 $filename="kew-$fileid.html";
209 open(OUT,">$filename") or die "Cannot open \"$filename\": $!";
210 &print_header("chunk $fileid");
214 print STDERR "($owner):";
215 foreach $child (@{$OWNS{$owner}})
216 { print STDERR " ($child)"; }
219 print OUT &format_record("<a id=\"".&htmlquote($owner)."\">","</a>",%{$DB{$owner}});
220 if (@{$OWNS{$owner}}) {
221 print OUT "<blockquote>\n";
222 foreach $child (@{$OWNS{$owner}})
223 { print OUT &format_record("","",%{$DB{$child}}); }
224 print OUT "</blockquote>\n";
227 $DB{$owner}{"_filename"}=$filename;
230 open(OUT,">kew-index.html") or die "Cannot open \"kew-index.html\": $!";
231 &print_header("Index");
236 my(%rec)=%{$DB{$owner}};
238 print OUT &htmlquote(&rec_to_name(%rec));
241 foreach $owner (sort keys %OWNS) {
244 print OUT "<p><a href=\"".$DB{$owner}{"_filename"}."#$owner\">";
246 print OUT "</a></p>";
247 if (@{$OWNS{$owner}}) {
249 foreach $child (@{$OWNS{$owner}}) {