#! /usr/bin/perl -w

use vars qw/%DB %OWNS %PARENT %CURR $last_field $debugmatch $debugparse $key $owner $parent $ref/;

%DB=();
%CURR=();
$debugparse=0;
$printdupl=0;
$debugmatch=0;

sub name_to_key
{
my( $r )=@_;

	$r=~tr/A-Z/a-z/;
	$r=~tr/a-z0-9//cd;
	return $r;
}

sub rec_to_name
{
my( %rec )=@_;
my( @list )=("Rank","Infrafam.","Genus","Species");
my( $item,$r );

	$r="";
	while ($item=shift @list)
		{ $r.=" ".$rec{$item} if exists $rec{$item}; }
	$r=~s/^ //;
	return $r;
}

sub flush_CURR
{
my( $key );

	$key=&name_to_key(&rec_to_name(%CURR));
	return if (!defined $key);
	if (exists $DB{$key})
		{ print STDERR "Key \"$key\" is duplicated!\n" if $printdupl; }
	else {
		print STDERR "ADDKEY: $key\n" if $debugparse;
		%{$DB{$key}}=%CURR;
		}
	%CURR=();
}

while (<>) {
	tr/\r\n//d;
	if (/^ *\304\301\304/) {
		&flush_CURR();
		print STDERR "---\n" if $debugparse;
		}
	elsif (/^([^ł]*[^ ]) *ł *(.*)$/) {
		print STDERR "FIELD: $1, VALUE: $2\n" if $debugparse;
		$last_field=$1;
		$CURR{$1}=$2;
		}
	elsif (/^ *ł *(.*)$/) {
		print STDERR "APPEND: $1\n" if $debugparse;
		$CURR{$last_field}.=" ".$1;
		}
	else {
		print STDERR "DISCARD: $_\n" if $debugparse;
		}
	}
&flush_CURR();
undef %CURR;

%OWNS=();
%PARENT=();

sub try_reparent
{
my( $reparent,$refkey );

	$refkey=&name_to_key($ref);
	return 0 if ($refkey eq "");
	return 0 if ($parent eq $refkey);
	return 0 if !exists $DB{$refkey};
	print STDERR "try_reparent: SUCCESS: key=\"$key\", refkey=\"$refkey\"\n" if $debugmatch;

	foreach $reparent (@{$OWNS{$parent}}) {
		$PARENT{$reparent}=$refkey;
		}
	@{$OWNS{$parent}}=() if (!defined $OWNS{$parent});
	@{$OWNS{$refkey}}=() if (!defined $OWNS{$refkey});
	@{$OWNS{$refkey}}=(@{$OWNS{$refkey}},$parent,@{$OWNS{$parent}});
	delete $OWNS{$parent};

	return 1;
}

MATCH: foreach $key (keys %DB) {
	$parent=$PARENT{$key};
	$parent=$key if (!defined $parent); 
	$ref=$DB{$key}{"Notes"};
	next MATCH if (!defined $ref);
	$ref=~tr/()//d;
	$ref=~s/^=//;
	$ref=~s/^O\. *//i;
	$ref=~s/^Orchidaceae *//i;
	$ref=~s/\..*$//;
	next MATCH if &try_reparent();
	$ref=$DB{$key}{"Rank"}." $ref" if exists $DB{$key}{"Rank"};
	next MATCH if &try_reparent();
	$ref=$DB{$key}{"Genus"}." $ref" if exists $DB{$key}{"Genus"};
	next MATCH if &try_reparent();
	}
undef %PARENT;

foreach $owner (keys %OWNS) {
my( $child );

	if ($debugmatch) {
		print STDERR "($owner):";
		foreach $child (@{$OWNS{$owner}})
			{ print STDERR " ($child)"; }
		print STDERR "\n";
		}
	print "(".&rec_to_name(%{$DB{$owner}}).")";
	foreach $child (@{$OWNS{$owner}})
		{ print " (".&rec_to_name(%{$DB{$child}}).")"; }
	print "\n";
	}
