wernermisc/m1r4/dsv/bomshelf

#!/usr/bin/perl

sub csv
{
	my $s = $_[0];
	my @a = ();

	while (1) {
		if ($s =~ /^"/) {
			die unless $s =~ /^"([^"]*)"(,\s*)?/;
			push(@a, $1);
			$s = $';
			return @a unless length $2;
			
		} elsif ($s =~ /,\s*/) {
			push(@a, $`);
			$s = $';
		} else {
			push(@a, $s);
			return @a;
		}
	}
	
}


sub lookup
{
	my $p = $_[0];
	my $add = $_[1];
	my @a;

	return $p if defined $cr{$p};
	@a = grep { $_ =~ /^$p/ } keys %cr;
	die "key $p* is ambiguous" if scalar @a > 1;
	if (!@a) {
		@a = grep { $_ =~ /$p/ } keys %cr;
		die "key *$p* is ambiguous" if scalar @a > 1;
		if (!@a) {
			die "key $p matches nothing" unless $add;
			warn "adding $p as supplement";
			return $p;
		}
	}
	return $a[0];
}


while (<>) {
	chop;
	@f = &csv($_);
	next unless $f[0] =~ /^[0-9]+$/;
	die "duplicate part $f[3]" if defined $cr{$f[3]};
	$f[1] =~ s/\(DNP\)//g;
	$cr{$f[3]} = $f[1];
	$url{$f[3]} = $f[4];
	$dsc{$f[3]} = $f[6];
	for (&csv($f[1])) {
		warn "\"$_\" used for $r{$_} and $f[3]" if defined $r{$_};
		$r{$_} = $f[3];
	}
}

open(F, "SUPPLEMENT") || die "open SUPPLEMENT: $!";
while (<F>) {
	chop;
	next if /^\s*#/;
	next if /^\s*$/;
	if (/^[Xx]:\s*/) {
		$p = &lookup($', 0);
		delete $cr{$p}, $url{$p}, $dsc{$p};
		for (keys %r) {
			delete $r{$_} if $r{$_} eq $p;
		}
		undef $p;
		next;
	}
	if (/^[Cc]:\s*/) {
		undef $p if $clear;
		$clear = 0;
		if (defined $p) {
			$cr{$p} = $';
			for $c (&csv($')) {
				warn "$p overrides $r{$c} for $c"
				    if defined $r{$c};
				$r{$c} = $p;
			}
			next;
		}
		die "unknown component reference $'" unless defined $r{$'};
		$p = $r{$'};
		next;
	}
	if (/^[Pp]:\s*/) {
		$p = &lookup($', 1);
		$clear = 0;
		next;
	}
	if (/^[Aa]:\s*/) {
		$a{$p} .= "," if defined $a{$p};
		$a{$p} .= $';
		$clear = 1;
		next;
	}
	if (/^[Dd]:\s*/) {
		$url{$p} = $';
		$clear = 1;
		next;
	}
	die "don't recognize \"$_\"";
}

for (sort keys %cr) {
	next if $url{$_} eq "";
	print "# $dsc{$_}\n" unless $dsc{$_} eq "";
	print "N: $_\n";
	for $a (&csv($cr{$_})) {
		print "A: $a\n";
	}
	if (defined $a{$_}) {
		for $a (&csv($a{$_})) {
			print "A: $a\n";
		}
	}
	print "D: $url{$_}\n\n";
}