1
0
mirror of git://projects.qi-hardware.com/wernermisc.git synced 2024-12-25 04:11:44 +02:00
wernermisc/m1r4/dsv/bomshelf
Werner Almesberger 04721daef7 m1r4/dsv/bomshelf: use less alarmist message when overriding a component
This can be something as harmless as replacing one type of LED with
another one.
2012-03-06 21:48:44 -03:00

127 lines
2.1 KiB
Perl
Executable File

#!/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";
}