From: short <>
Date: Wed, 31 Oct 2001 21:40:25 +0000 (+0000)
Subject: Inside-equiv sorting implemented
X-Git-Url: http://git.jankratochvil.net/?p=kewensis.git;a=commitdiff_plain;h=cf0dae5bac9c0070c767b3b798a83f8e9f4acd04
Inside-equiv sorting implemented
Table converted to indented text output (upon request)
---
diff --git a/kewensis-collect.pl b/kewensis-collect.pl
index 6190153..c6f399b 100755
--- a/kewensis-collect.pl
+++ b/kewensis-collect.pl
@@ -5,7 +5,7 @@ use warnings;
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;
@@ -46,18 +46,29 @@ sub htmlquote
return $_;
}
-sub print_rec
+sub format_record
{
my( $preinsert,$postinsert,%rec )=@_;
- return if (!%rec);
- print OUT "\n";
- print OUT "| ".$preinsert.&rec_to_name(%rec).$postinsert." |
|---|
\n";
- delete $rec{"Genus"};
- delete $rec{"Species"};
- foreach $key (sort keys %rec)
- { print OUT "| ".&htmlquote($key).": | ".&htmlquote($rec{$key})." |
\n"; }
- print OUT "
\n";
+ my($r)="".$preinsert.&htmlquote(&rec_to_name(%rec)).$postinsert."";
+ $r.="\n".htmlquote($rec{"Publ. Author"}) if (exists($rec{"Publ. Author"}));
+ $r.="
\n".htmlquote($rec{"Publication"}) if (exists($rec{"Publication"}));
+ $r.="
\n".htmlquote($rec{"Notes"}) if (exists($rec{"Notes"}));
+ $r.="
\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
@@ -72,6 +83,8 @@ my( $key );
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}}=();
@@ -120,8 +133,8 @@ my( $reparent,$refkey );
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};
@@ -147,20 +160,31 @@ MATCH: foreach $key (keys %DB) {
}
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
"
-
-
+
+
Kewensis $header
\n";
@@ -192,11 +216,11 @@ my( $child );
{ print STDERR " ($child)"; }
print STDERR "\n";
}
- &print_rec("","",%{$DB{$owner}});
+ print OUT &format_record("","",%{$DB{$owner}});
if (@{$OWNS{$owner}}) {
print OUT "\n";
- foreach $child (reverse @{$OWNS{$owner}})
- { &print_rec("","",%{$DB{$child}}); }
+ foreach $child (@{$OWNS{$owner}})
+ { print OUT &format_record("","",%{$DB{$child}}); }
print OUT "
\n";
}
print OUT "\n";
@@ -222,7 +246,7 @@ my( $child );
print OUT "";
if (@{$OWNS{$owner}}) {
print OUT "\n";
- foreach $child (reverse @{$OWNS{$owner}}) {
+ foreach $child (@{$OWNS{$owner}}) {
print OUT "- ";
&print_href($child);
print OUT "
\n";