Root/m1r4/dsv/bomshelf

1#!/usr/bin/perl
2
3sub csv
4{
5    my $s = $_[0];
6    my @a = ();
7
8    while (1) {
9        if ($s =~ /^"/) {
10            die unless $s =~ /^"([^"]*)"(,\s*)?/;
11            push(@a, $1);
12            $s = $';
13            return @a unless length $2;
14            
15        } elsif ($s =~ /,\s*/) {
16            push(@a, $`);
17            $s = $';
18        } else {
19            push(@a, $s);
20            return @a;
21        }
22    }
23    
24}
25
26
27sub lookup
28{
29    my $p = $_[0];
30    my $add = $_[1];
31    my @a;
32
33    return $p if defined $cr{$p};
34    @a = grep { $_ =~ /^$p/ } keys %cr;
35    die "key $p* is ambiguous" if scalar @a > 1;
36    if (!@a) {
37        @a = grep { $_ =~ /$p/ } keys %cr;
38        die "key *$p* is ambiguous" if scalar @a > 1;
39        if (!@a) {
40            die "key $p matches nothing" unless $add;
41            warn "adding $p as supplement";
42            return $p;
43        }
44    }
45    return $a[0];
46}
47
48
49while (<>) {
50    chop;
51    @f = &csv($_);
52    next unless $f[0] =~ /^[0-9]+$/;
53    die "duplicate part $f[3]" if defined $cr{$f[3]};
54    $f[1] =~ s/\(DNP\)//g;
55    $cr{$f[3]} = $f[1];
56    $url{$f[3]} = $f[4];
57    $dsc{$f[3]} = $f[6];
58    for (&csv($f[1])) {
59        warn "\"$_\" used for $r{$_} and $f[3]" if defined $r{$_};
60        $r{$_} = $f[3];
61    }
62}
63
64open(F, "SUPPLEMENT") || die "open SUPPLEMENT: $!";
65while (<F>) {
66    chop;
67    next if /^\s*#/;
68    next if /^\s*$/;
69    if (/^[Xx]:\s*/) {
70        $p = &lookup($', 0);
71        delete $cr{$p}, $url{$p}, $dsc{$p};
72        for (keys %r) {
73            delete $r{$_} if $r{$_} eq $p;
74        }
75        undef $p;
76        next;
77    }
78    if (/^[Cc]:\s*/) {
79        undef $p if $clear;
80        $clear = 0;
81        if (defined $p) {
82            $cr{$p} = $';
83            for $c (&csv($')) {
84                warn "$p overrides $r{$c} for $c"
85                    if defined $r{$c};
86                $r{$c} = $p;
87            }
88            next;
89        }
90        die "unknown component reference $'" unless defined $r{$'};
91        $p = $r{$'};
92        next;
93    }
94    if (/^[Pp]:\s*/) {
95        $p = &lookup($', 1);
96        $clear = 0;
97        next;
98    }
99    if (/^[Aa]:\s*/) {
100        $a{$p} .= "," if defined $a{$p};
101        $a{$p} .= $';
102        $clear = 1;
103        next;
104    }
105    if (/^[Dd]:\s*/) {
106        $url{$p} = $';
107        $clear = 1;
108        next;
109    }
110    die "don't recognize \"$_\"";
111}
112
113for (sort keys %cr) {
114    next if $url{$_} eq "";
115    print "# $dsc{$_}\n" unless $dsc{$_} eq "";
116    print "N: $_\n";
117    for $a (&csv($cr{$_})) {
118        print "A: $a\n";
119    }
120    if (defined $a{$_}) {
121        for $a (&csv($a{$_})) {
122            print "A: $a\n";
123        }
124    }
125    print "D: $url{$_}\n\n";
126}
127

Archive Download this file

Branches:
master



interactive