9 my(%DB,%OWNS,$debugmatch,$D,$key,$owner,$ref,$maxsize,$filename,$doimport,$import_xlate);
35 return "<span class=\"$class\">$_</span>" if defined $class;
41 my( $preinsert,$postinsert,%rec )=@_;
43 my($r)=$preinsert.htmlquote(rec_to_name(%rec),"name").$postinsert;
44 $r.="\n".htmlquote($rec{"Publ. Author"},"author") if (exists($rec{"Publ. Author"}));
45 $r.="<br />\n".htmlquote($rec{"Publication"},"publication") if (exists($rec{"Publication"}));
46 $r.="<br />\n".htmlquote($rec{"Notes"},"notes") if (exists($rec{"Notes"}));
47 if ($doimport && exists($rec{"html"})) {
48 my($import)="import: [".$rec{"id"}."]";
49 $r.="<br />\n<blockquote><!-- BEGIN $import -->\n".$rec{"html"}."\n<!-- END $import --></blockquote>\n";
58 s/\(([0-9]{4}) publ. [0-9]{4}\)/($1)/g;
59 while (/\(([0-9]{4})(-[0-9]+)?\)/) {
60 return $1 if ($1>=1700 && $1<=2010);
71 print("-$file----------------$'--------------\n");
72 warn "Unable to match file \"".getcwd()."/$file\".";
79 if (!open(FI,$file)) {
80 warn("Unable to open file \"$file\" in dir \"".getcwd()."\": $!");
87 my($bigword)='[^<]*(?:<IT>)?[^<]*(?:<RO>)?[^<]*(?:<1000 m)?[^<]*';
90 my($any)='[\x00-\xFF]*';
91 my($ipniservletword)="<a href=\"\\./IpniServlet\\?id=($id)&query_type=by_id\">($word)</a>";
92 my($idquoted)=$id; $idquoted=~s%\W%\\$&%g;
93 my($ipniservletwordthree)=$ipniservletword; $ipniservletwordthree=~s%\($idquoted\)%((?:$idone){3})$&%os or die;
94 my($attrpat)="<p>nomenclatural synonym(\\(Main Record\\))?:$ipniservletword</p>|<p>basionym(\\(\\d+\\))?:$ipniservletword</p>|<p>basionym:($word)|<p>replaced synonym:$ipniservletword</p>|<p>replaced synonym:($word)|<p>Is a replaced synonym of:$ipniservletword</p>|<p>Is a basionym of:$ipniservletword</p>|<p>later publication of(\\(\\d+\\))?:$ipniservletword</p>|<p>Is a later publication of of:$ipniservletword</p>";
99 <title>IPNI Query Results</title>
101 <body bgcolor="#ffffff" text="#000000" link="#006666" vlink="#008080" alink="#008080">
102 <HR><b><i>Orchidaceae</i> ($word)</b> ($word) <br>
103 ((?:<a href="\./PublicationServlet\?id=($id)&query_type=by_id"> ($word)</a> ($word)|$bigword(?:<br>\n$word)*)?<p>($bigword)?</p><p>($word)?</p>(?:
104 remarks: .*)?(<HR><h4>Type</h4>)?(<table $any</table>)?(?:
105 <h4>Linked Records</h2>
106 ((?:$attrpat)*))?(<br>
108 <h4>Original Data</h2>
109 (?:basionym: ($word)<br>
110 )?(?:hybrid parentage: ($word)<br>
111 )?(?:replaced synonym: ($word)<br>
112 )?(?:distribution: ($word)<br>
113 )?(?:Notes: ($word))?)?)(?:<p><a href="\./query_ipni.html">Back to Search Page</a></p>
121 $rec{"Publ. Author"}=$2;
122 $rec{"Publication"}="$5 $6" if defined($5) && defined($6);
123 $rec{"html"}=$3 if defined $3;
125 ($rec{"id"}=$file)=~s#^($id)\.html$#$1#os or failed($file);
126 $rec{"html"}=~s#$ipniservletwordthree#<a href="$1/$1$2.html">$3</a>#osg if $import_xlate && exists $rec{"html"};
127 while (defined($attrsbody) && $attrsbody=~s%^(?:$attrpat)%%os) {
128 # nomenclatural synonym: id=$2
130 # replaced synonym: id=$8
131 # Is a replaced synonym: id=$11
132 # Is a basionym: id=$13
133 # later publication: id=$16
134 # Is a later publication: id=$18
135 my(@refs)=($2,$5,$8,$11,$13,$16,$18);
138 push(@{$rec{"refs"}},$_) if defined ($_=shift @refs);
145 $DB{$rec{"id"}}=\%rec;
155 warn("Unable to change to dir \"$dir\" from dir \"$old\": $!");
158 opendir(DIR,".") or die("Cannot open . in \"".getcwd()."\": $!");
159 foreach (sort readdir(DIR)) {
160 process_entry($_) if ($_!~/^\./);
163 chdir($old) or warn("Unable to retreat to dir \"$old\": $!");
170 process_dir ($entry) if -d $entry;
171 process_file($entry) if -f $entry;
177 { process_entry($_); }
183 for $refid (@{$DB{$id}{"refs"}}) {
184 if (!exists $DB{$refid}) {
185 warn "Undefined ref id \"$refid\" from id \"$id\"" if $D;
188 next if $id eq $refid; # self-ref
189 # push(@refs,$DB{$refid});
192 $DB{$id}{"refs"}=\@refs;
195 print Data::Dumper->Dump([\%DB],["%DB"]) if $D;
197 %OWNS=map { $_=>[] } keys(%DB);
199 for $id (keys %OWNS) {
201 for $refid (@{$DB{$id}{"refs"}}) {
202 next if !exists $OWNS{$refid};
203 push(@{$OWNS{$id}},$refid,@{$OWNS{$refid}});
204 delete $OWNS{$refid};
208 print Data::Dumper->Dump([\%OWNS],["%OWNS"]) if $D;
210 #foreach $key (keys %DB) {
211 # $DB{$key}{"Publication"}=extract_year($DB{$key}{"Publication"})." ::: ".$DB{$key}{"Publication"}
212 # if (exists($DB{$key}{"Publication"}));
215 foreach $key (keys %OWNS) {
216 my(@keys)=@{$OWNS{$key}};
219 @keys=sort { extract_year($DB{$b}{"Publication"}) <=> extract_year($DB{$a}{"Publication"}); } @keys;
220 my($pkey)=shift(@keys);
229 "<?xml version=\"1.0\" encoding=\"utf-8\"?>
230 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">
231 <html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\">
232 <head><title>Kewensis $header</title>
233 <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />
234 <base href=\"".($import_xlate ? "data/" : "http://www.ipni.org/ipni/")."\" />
235 <style type=\"text/css\"><!--
236 .name { font-weight: bold; }
237 .author { font-variant: small-caps; }
247 print OUT "</body></html>\n";
251 if (defined $maxsize) {
253 my($filename,$fileid);
254 foreach $owner (sort { $DB{$b}{"name"} cmp $DB{$a}{"name"}; } keys %OWNS) {
257 if ($fileno<0 || tell(OUT)>=$maxsize) {
258 OUT_flush() if ($fileno>=0);
259 $fileid=sprintf("%04d",++$fileno);
260 $filename="kew-$fileid.html";
261 open(OUT,">$filename") or die "Cannot open \"$filename\": $!";
262 print_header("chunk $fileid");
266 print STDERR "($owner):";
267 foreach $child (@{$OWNS{$owner}})
268 { print STDERR " ($child)"; }
271 print OUT format_record("<p><a id=\"".htmlquote($owner)."\">","</a></p>\n",%{$DB{$owner}});
272 if (@{$OWNS{$owner}}) {
273 print OUT "<blockquote>\n";
274 foreach $child (@{$OWNS{$owner}})
275 { print OUT format_record("<p>","</p>\n",%{$DB{$child}}); }
276 print OUT "</blockquote>\n";
279 $DB{$owner}{"_filename"}=$filename;
282 open(OUT,">kew-index.html") or die "Cannot open \"kew-index.html\": $!";
283 print_header("Index");
286 open(OUT,">kewensis.html") or die "Cannot open \"kewensis.html\": $!";
287 print_header("Full");
292 my($preinsert,$postinsert,%rec)=@_;
294 return htmlquote(rec_to_name(%rec));
297 my($printrecref)=(defined $maxsize ? \&format_href : \&format_record );
299 foreach $owner (sort { $DB{$b}{"name"} cmp $DB{$a}{"name"}; } keys %OWNS) {
303 print OUT "<a href=\"".$DB{$owner}{"_filename"}."#$owner\">" if defined $maxsize;
304 print OUT &{$printrecref}("","",%{$DB{$owner}});
305 print OUT "</a>" if defined $maxsize;
307 if (@{$OWNS{$owner}}) {
309 foreach $child (@{$OWNS{$owner}}) {
311 print OUT &{$printrecref}("","",%{$DB{$child}});