use vars qw/%DB %OWNS %PARENT %CURR $last_field $debugmatch $debugparse $key $owner $parent $ref $note_rest $printdupl $maxsize $fileno $fileid $filename/;
-$maxsize=0x20000;
+$maxsize=0x40000;
%DB=();
%CURR=();
$debugparse=0;
return $_;
}
-sub print_rec
+sub format_record
{
my( $preinsert,$postinsert,%rec )=@_;
- return if (!%rec);
- print OUT "<table border=\"1\" frame=\"border\" rules=\"none\"><col width=\"0*\" /><col width=\"1*\" />\n";
- print OUT "<tr><th colspan=\"2\">".$preinsert.&rec_to_name(%rec).$postinsert."</th></tr>\n";
- delete $rec{"Genus"};
- delete $rec{"Species"};
- foreach $key (sort keys %rec)
- { print OUT "<tr><td class=\"left\">".&htmlquote($key).":</td><td>".&htmlquote($rec{$key})."</td></tr>\n"; }
- print OUT "</table>\n";
+ my($r)="<p><span class=\"name\">".$preinsert.&htmlquote(&rec_to_name(%rec)).$postinsert."</span>";
+ $r.="\n".htmlquote($rec{"Publ. Author"}) if (exists($rec{"Publ. Author"}));
+ $r.="<br />\n".htmlquote($rec{"Publication"}) if (exists($rec{"Publication"}));
+ $r.="<br />\n".htmlquote($rec{"Notes"}) if (exists($rec{"Notes"}));
+ $r.="</p>\n";
+ return($r);
+}
+
+sub extract_year
+{
+ ($_)=@_;
+ if (defined($_)) {
+ s/\(([0-9]{4}) publ. [0-9]{4}\)/($1)/g;
+ while (/\(([0-9]{4})(-[0-9]+)?\)/) {
+ return $1 if ($1>=1700 && $1<=2010);
+ $_=$';
+ }
+ }
+ return(-1);
}
sub flush_CURR
else {
print STDERR "ADDKEY: $key\n" if $debugparse;
%{$DB{$key}}=%CURR;
+# my($year)=&extract_year($CURR{"Notes"});
+# %{$DB{$key}}{"year"}=$year if (defined($year));
}
%CURR=();
@{$OWNS{$key}}=();
foreach $reparent (@{$OWNS{$parent}}) {
$PARENT{$reparent}=$refkey;
}
- @{$OWNS{$parent}}=() if (!defined $OWNS{$parent});
- @{$OWNS{$refkey}}=() if (!defined $OWNS{$refkey});
+ @{$OWNS{$parent}}=() if (!exists $OWNS{$parent});
+ @{$OWNS{$refkey}}=() if (!exists $OWNS{$refkey});
@{$OWNS{$refkey}}=(@{$OWNS{$refkey}},$parent,@{$OWNS{$parent}});
delete $OWNS{$parent};
}
undef %PARENT;
+#foreach $key (keys %DB) {
+# $DB{$key}{"Publication"}=&extract_year($DB{$key}{"Publication"})." ::: ".$DB{$key}{"Publication"}
+# if (exists($DB{$key}{"Publication"}));
+# }
+
+foreach $key (keys %OWNS) {
+ my(@keys)=@{$OWNS{$key}};
+ delete($OWNS{$key});
+ unshift(@keys,$key);
+ @keys=sort { &extract_year($DB{$b}{"Publication"}) <=> &extract_year($DB{$a}{"Publication"}); } @keys;
+ my($pkey)=shift(@keys);
+ @{$OWNS{$pkey}}=@keys;
+ }
+
sub print_header
{
my($header)=@_;
print OUT
"<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
-<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
-<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
+<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\">
<head><title>Kewensis $header</title>
<style type=\"text/css\"><!--
-table { border: ridge; }
-blockquote table { border: groove; }
-td { border: none; }
-td.left { white-space: nowrap; font-style: italic; }
+.name { font-weight: bold; }
--></style>
</head><body>
\n";
{ print STDERR " ($child)"; }
print STDERR "\n";
}
- &print_rec("<a name=\"".&htmlquote($owner)."\">","</a>",%{$DB{$owner}});
+ print OUT &format_record("<a id=\"".&htmlquote($owner)."\">","</a>",%{$DB{$owner}});
if (@{$OWNS{$owner}}) {
print OUT "<blockquote>\n";
- foreach $child (reverse @{$OWNS{$owner}})
- { &print_rec("","",%{$DB{$child}}); }
+ foreach $child (@{$OWNS{$owner}})
+ { print OUT &format_record("","",%{$DB{$child}}); }
print OUT "</blockquote>\n";
}
print OUT "\n";
print OUT "</a></p>";
if (@{$OWNS{$owner}}) {
print OUT "<ul>\n";
- foreach $child (reverse @{$OWNS{$owner}}) {
+ foreach $child (@{$OWNS{$owner}}) {
print OUT "<li>";
&print_href($child);
print OUT "</li>\n";