Date:2012-05-02 04:09:24 (11 years 10 months ago)
Author:Werner Almesberger
Commit:881bf33be0420b98fb9eac5372f6974eb62b00a0
Message:rescue files from svn.openmoko.org

Files: old-boom/CHARACTERISTICS (1 diff)
old-boom/Makefile (1 diff)
old-boom/README (1 diff)
old-boom/annotate (1 diff)
old-boom/bom2part (1 diff)
old-boom/boom (1 diff)
old-boom/gen2chr (1 diff)
old-boom/match.pl (1 diff)
old-boom/misc.pl (1 diff)
old-boom/pardup.pl (1 diff)
old-boom/parser.pl (1 diff)
old-boom/part2order (1 diff)
old-boom/prettyord (1 diff)
old-boom/testsub (1 diff)
old-boom/workflow.fig (1 diff)

Change Details

old-boom/CHARACTERISTICS
1*** This is an older draft of the concept - differs sometimes from the way
2    things are done in gta02-core. ***
3
4
5BOM matching
6============
7
8BOMs are matched with inventories in the following way:
9
10- a .lst file with the BOM is generated by KiCad
11
12- using a ruleset, component characteristics are translated to a
13  canonical format and default values may be used for unspecified
14  characteristics
15
16- part catalogs are searched for matches with the canonical component
17  descriptions. This yields a list of supplier-specific part numbers
18  for each component.
19
20  Parts can be characterized by either specifying their properties or
21  by equating them to another part. E.g., a Digi-Key part may be
22  defined as an NXP part which in turn is equivalent to a TI part.
23
24- this list is then matched against inventories, using a suitable
25  optimization strategy (e.g., prioritize inventories and try to
26  pick as many suitable components as possible higher priority ones
27  before moving to lower priority ones)
28
29  E.g., local stock could be the first-level inventory, followed by
30  more distant warehouses, followed by distributors, followed by
31  manufacturers.
32
33  Inventories could also include pricing information.
34
35- TBD: it would be good if parameters gathered in the matching process
36  could be fed back into KiCad (as some sort of annotations, similar
37  to the expanded view of schematic symbols), such that under-specifed
38  parts yielding mismatches can be spotted by manual review.
39
40
41Catalog
42=======
43
44A catalog contains part characteristics and the reference number(s)
45assigned to them.
46
47
48Basic syntax
49------------
50
51Catalog entries consist of "words" in the sense that each word does
52not contain any whitespace and words are separated from each other by
53whitespace. Whitespace can be included in a word if it is enclosed in
54double quotes.
55
56Each entry begins in the first column of a line. If an entry needs
57more than one line, the words on the continuation line(s) must be
58indented by whitespace.
59
60Trailing whitespace is ignored, and so are comments beginning with a
61hash mark. Blank lines end any entry and are also ignored.
62
63Each catalog entry begins with the part number followed by a part type
64designator.
65
66Characteristics have the form <field>=<value>, where
67the fields follow the pattern outlined below. The value is some
68description of the value of that characteristic, typically a number
69and a unit (e.g., 4.7uF) or a name (e.g., X5R).
70
71Numbers use a decimal point where necessary. Mantissas are normalized
72such that they fall into the range 1 <= n < 1000. E.g., instead of
730.1uF, write 100nF. There is no space between number and unit. The
74Omega of Ohm is written as "R".
75
76
77Fields
78------
79
80Each
81
82General fields
83- - - - - - -
84
85FP Footprint
86H Height (overrides any height implied by footprint)
87TOL Tolerance, with percent sign. Split tolerances are indicated as n/m%
88DSC Free-format description
89
90
91Resistors
92- - - - -
93
94RES Part type designator
95R Resistance, with unit
96P Maximum power dissipation
97V Maximum volatage
98
99
100Capacitors
101- - - - -
102
103CAP Part type designator
104C Capacitance, with unit
105M Material, e.g., TANT, NP0, X5R, etc.
106V Maximum voltage
107ESR ESR, with unit
108
109
110Inductors
111-- - - -
112
113Diodes
114- - -
115
116DIODE Regular diode
117STKY Schottky diode
118
119Vf Maximum forward voltage
120Vr Maximum reverse voltage
121If Maximum forward current
122Ir Maximum reverse current
123C Capacitance
124
125LED Ligh-emitting diode
126
127COL Color, multiple colors are separated by /, e.g., blue/red
128ARRAY If multiple diodes form an array, this parameter describes
129    its structure: CA = common anode, CC = common cathode,
130    SEQ = tap-A-C-tap-A-C-tap sequence
131
132ZENER Zener diode
133
134Vz Zener voltage
135
136TVS Transient voltage suppressor
137
138Vac Working voltage, AC
139Vdc Working voltage, DC
140E Energy
old-boom/Makefile
1UPLOAD=werner@sita.openmoko.org:public_html/gta02-core/
2COPY=rsync -e ssh --progress
3
4.PHONY: all xpdf spotless upload
5
6all:
7        @echo "make what ? xpdf, upload, or spotless ?" 1>&2
8
9workflow.pdf: workflow.fig
10        fig2dev -L pdf $< >$@ || { rm -f $@; exit 1; }
11
12xpdf: workflow.pdf
13        xpdf workflow.pdf
14
15upload: workflow.pdf
16        $(COPY) workflow.pdf $(UPLOAD)/bom-workflow.pdf
17
18spotless:
19        rm -f workflow.pdf
old-boom/README
1The BOM processing system
2=========================
3
4The BOM processing system takes a bill of material generated by
5KiCad and converts it in various steps into a "shopping list"
6that can be used to order from various providers.
7
8
9Introduction
10============
11
12The following sections describe how to use the basic elements of
13the BOM processing system.
14
15
16A simple BOM translation
17------------------------
18
19KiCad identifies components by a so-called component reference,
20e.g., R1001, U5, etc. In addition to this, each component can have
21various parameters, such as a "value", its footprint, and further
22user-defined items. These parameters can be shown in the schematics
23(e.g., the value usually is) or they can be hidden (e.g., the
24footprint).
25
26At the end of the process, we want a "shopping list" that can be
27used to order items or to find them in an inventory or catalog.
28Components in the shopping list are identified by a part number.
29
30...
31- BOM
32- inventory
33- ID matching
34
35
36Equivalences
37------------
38
39A single component can be associated with multiple part numbers.
40For example, a chip its manufacturer calls "XYZ-R1" may be listed in
41a distributor's catalog with a completely different order number,
42such as "20-1234-8". The BOM processing system therefore
43distinguishes multiple so-called name spaces. A name space is
44identified by a (unique) name and a part number is generally
45qualified by the name of the name space.
46
47E.g., if the manufacturer is called "ACME" and the distributor of
48electronical components calls itself "DIST-EL", the part in our
49example may have the equivalent names "ACME XYZ-R1" and "DIST-EL
5020-1234-8".
51
52...
53- revise .inv
54
55example.equ:
56
57#INV
58DIST-EL 20-1234-8
59#EQU
60ACME XYZ-R1 DIST-EL 20-1234-8
61
62
63Adding stock and cost
64---------------------
65
66- .inv, more fields
67- quanta
68
69Substituting component names
70----------------------------
71
72- intro to .sub
73- ad-hoc fixes
74
75
76Selecting characteristics
77-------------------------
78
79- .sub
80- .chr
81- <rel><number><multiplier><unit> syntax
82...
83
84
85Generating characteristics
86--------------------------
87
88- .gen
89
90
91Advanced topics
92===============
93
94- generating .inv files
95- different presentations (e.g., CT, TR, ...)
96- component substitution (one-way equivalence)
97- problem reports
98- hiding known problems (while sourcing)
99
100
101File formats
102============
103
104The BOM processing system uses a large number of different files to
105store information retrieved from the BOM, inventories, intermediate
106results, etc. The following sections describe the various formats.
107
108
109Part characteristics (.chr)
110---------------------------
111
112A part characteristics file lists the parameters of components.
113This information is then matched with the parameters specified in
114the schematics.
115
116The part characteristics file begins with a line containing only
117#CHR
118
119After this, each line contains the manufacturer (namespace), the
120part number, and a list of parameter=value entries. Fields are
121separated by spaces.
122
123Long lines can be wrapped by indenting the continuation lines.
124
125Blank lines and comments (#) are ignored.
126
127
128Substitutions (.sub)
129--------------------
130
131A substitutions file specifies rules for translating component
132parameters in schematics to part characteristics.
133
134A substitution rule consists of zero or more conditions and zero or
135more assignments. The conditions are of the form field=pattern. The
136field can be a per-component fields KiCad provides or any parameter
137set by substitutions.
138
139KiCad fields are named as follows:
140
141KiCad field Field name
142----------- ----------
143Reference REF (*)
144Value VAL
145Footprint FP
146Field1 F1
147... ...
148
149(*) As a shortcut, REF= can be omitted.
150
151Note that fields with a user-defined name currently still only appear
152as F1, F2, etc.
153
154The special field name FN can be used to look for a match in all of
155F1, F2, ... This way, it's sufficient to use a consistent syntax for
156additional parameters, without having to assign also a fixed location
157for them. If more than one field matches, the first match is taken.
158
159Field names are case-insensitive.
160
161The pattern is uses a notation similar to filename globbing. There
162are the following special constructs:
163
164- * matches a string of any length
165- ? matches a single character
166- (...) matches the pattern between the parentheses and records the
167  string matched
168- $X marks a value in nXn notation, e.g., 4u7 or 100R. Such values
169  are converted to SI-like notation.
170
171A rule is applied when all conditions are fulfilled. In this case,
172assignments of the form field=value are executed. Strings obtained
173in the match can be included in a value as follows:
174
175- $field and ${field} are replaced by the respective field
176- $field:n and ${field:n} are replaced by the n-th (...) pattern in
177  the match of the respective field
178
179If a rule ends with an exclamation mark, the substitution process stops
180after the rule is applied. Otherwise, further rules are processed.
181
182Examples:
183
184R* val=$R -> R=$val
185
186This rule translates the values of all resistors to SI notation.
187
188D* FN=(*)Vdc -> T=TSV Vdc=FN:1
189
190This rule sets the parameters T and Vdc for Zeners acting as TSVs.
191
192If a set of rules has a common set of conditions or assignments, the
193more compact block notation can be used instead of repeating them for
194each rule:
195
196common-conditions -> common-assignments {
197    rule-specific-conditions -> rule-specific-assignments
198    ...
199}
200
201Rules in a block only match if both the common and the rule-specific
202conditions are met. Then the common and the rule-specific assignments
203are performed. If a condition or an assignment appears both in the
204common and the rule-specific part, only the latter is used.
205
206Long lines can be wrapped by indenting the continuation lines. Note
207that { and ! are also considered to be part of the same line as the
208rest of the rule. In particular, the following construct wouldn't
209work:
210
211X=Y
212{
213    ...
214}
215
216With proper indentation, this would:
217
218X=Y
219  {
220    ...
221}
222
223
224Characteristics generation (.gen)
225---------------------------------
226
227The substitution mechanism can also be used to automatically generate
228characteristics from part numbers, e.g., for resistors or capacitors.
229
230.gen files are exactly .sub files, with the exception that the only
231field used is the REF field and that it contains the part number.
232
233Once the rule set has been processed, all fields (except REF) whose
234name doesn't begin with an underscore are placed in the characteristics
235entry as parameters.
236
237An entry is only produced if the rule set is explicitly terminated.
238
239
240Parts list (.par)
241------------------
242
243A parts file lists the parts that are suitable for a given BOM item.
244The file begins with a line containing only
245#PAR
246
247After this, each line contains the component reference, a space, and
248then one or more namespace part-number groups, separated by spaces as
249well.
250
251Blank lines and comments (#) are ignored.
252
253
254Order list (.ord)
255-----------------
256
257An order file lists the quantities to order from inventories, along
258with the cost and the component references the item is used for. The
259file begins with a line containing only
260#ORD
261
262After this, each line contains the supplier (namespace), the part
263number, the number of items to order, the currency code, the cost,
264and one or more component references.
265
266Blank lines and comments (#) are ignored.
267
268
269Equivalence (.equ)
270------------------
271
272Equivalence files establish equivalences between parts numbers in the
273same or in different name spaces. An equivalence file begins with a
274line containing only
275#EQU
276
277After this, each line consists of the following four space-separated
278fields:
279
280namespace-1 part-number-1 namespace-2 part-number-2
281
282Blank lines and comments (#) are ignored.
283
284
285Inventory (.inv)
286----------------
287
288Inventory files list inventory and component cost. An inventory file
289begins with a line containing only
290#INV
291
292After this, each line contains the namespace and the part number,
293followed by the number of items in stock, the currency code, and one
294or more pricing entries.
295
296Each pricing entry consists of two fields: the number of items in an
297order, and the per item price at that quantity. A sequence of
298increasing order sizes indicates that they are quanta. A sequence of
299decreasing order sizes indicates that smaller quanta are possible
300after a previous larger threshold has been met.
301
302Example:
303
304... USD 1 0.5 10 0.4 100 0.2
305
306Means that an order of at least 170 units would be made either as
3072 * 100 units, costing USD 40, or as 1 * 100 + 7 * 10 units, costing
308USD 20 + USD 28 = USD 48.
309
310If the entry is
311
312... USD 1 0.5 10 0.4 100 0.2 1 0.2
313
314Then the USD 0.2 per unit cost would apply to any any quantity of at
315least 100 units. So a 170 units order would cost USD 34.
316
317Blank lines and comments (#) are ignored.
318
319The number of items in stock and the pricing data can be omitted. We
320call this "virtual inventory". In this case, the numer of items in
321stock and the price default to large numbers (e.g., 999999). Virtual
322inventory is used to suppress warnings for parts that have not been
323sourced yet, but where sourcing is in progress.
324
325
326Description (.dsc)
327------------------
328
329A description file contains plain text descriptions of parts. The file
330begins with a like containing only
331#DSC
332
333Each line contains the name space, a space, the part number, another
334space, and the description. The description can contain any printable
335character and ends with a newline.
336
337Blank lines and comments (#) are ignored.
old-boom/annotate
1#!/usr/bin/perl
2
3require "parser.pl";
4require "misc.pl";
5
6
7$H = 50; # character height
8$W = $H*0.9; # character width
9$L = $H+20; # line skip
10
11
12sub normalize
13{
14    my @t = @_;
15
16    # convert from (x0, y0, w, h) to (x0, y0, x1, y1)
17    $t[2] += $t[0];
18    $t[3] = $t[1]-$t[3];
19    return ($t[0], $t[3], $t[2], $t[1]);
20}
21
22
23#
24# 2x2 matrix inversion
25# http://en.wikipedia.org/wiki/Invertible_matrix#Inversion_of_2.C3.972_matrices
26#
27
28sub invert
29{
30    my @m = @_;
31    my $f = 1/($m[0]*$m[3]-$m[1]*$m[2]);
32    return ($f*$m[3], -$f*$m[1], -$f*$m[2], $f*$m[0]);
33}
34
35
36sub block
37{
38    my @t = &normalize(@_);
39    push(@block, [ @t ]);
40    $wnl .= "Wire Notes Line\n\t$t[0] $t[1] $t[2] $t[3]\n";
41}
42
43
44sub pass
45{
46    my @t = &normalize(@_);
47
48    for (@block) {
49    my @b = @{ $_ };
50    next if $t[0] > $b[2];
51    next if $t[2] < $b[0];
52    next if $t[1] > $b[3];
53    next if $t[3] < $b[1];
54    return 0;
55    }
56    return 1;
57}
58
59
60sub put
61{
62    local ($x0, $y0, $ref, @s) = @_;
63
64    my $h = @s*$L;
65    my $w = 0;
66    for (@s) {
67    my $t = $W*length $_;
68    $w = $t if $t > $w;
69    }
70    my $a = 270;
71    my $r = 100;
72    my $x, $y;
73    my $ym = $y0-$h+$H/2;
74    for ($i = 0; $i != 128; $i++) {
75    $x = int($x0+$r*cos($a/180*3.14159));
76    $y = int($ym+$r*sin($a/180*3.14159));
77    last if &pass($x, $y, $w, $h);
78    $a += 22.5;
79    $r += $L/8;
80    }
81    warn "no place found for \"$s[0]\"" if $i == 128;
82
83    my @m = &invert( @{ $m{$ref} });
84    &block($x, $y+$H/2, $w, $h);
85    my $n = 10;
86    for my $s (reverse @s) {
87    my $dx = $x-$x0;
88    my $dy = $y-$y0;
89    my $sx = $x0+$dx*$m[0]+$dy*$m[1];
90    my $sy = $y0+$dx*$m[2]+$dy*$m[3];
91    ($hv, $hj, $vj) = ("H", "L", "C") if $m[0] == 1;
92    ($hv, $hj, $vj) = ("H", "R", "C") if $m[0] == -1;
93    ($hv, $hj, $vj) = ("V", "C", "B") if $m[1] == 1;
94    ($hv, $hj, $vj) = ("V", "C", "T") if $m[1] == -1;
95    $s =~ s/~/-/g;
96    print "F $n \"$s\" $hv $sx $sy $H 0000 $hj ${vj}NN\n";
97    $y -= $L;
98    $n++;
99    }
100}
101
102
103sub dsc_parts
104{
105    local ($ref) = @_;
106    my @p = @{ $parts{$ref} };
107    my @f = ();
108    while (@p) {
109    my @id = splice(@p, 0, 2);
110    my $id = "$id[0] $id[1]";
111    my $dsc = &dsc_find($id);
112    push(@f, &dsc) if defined $dsc;
113    }
114    return @f;
115}
116
117
118sub dsc_order
119{
120    local ($ref) = @_;
121    my @f = ();
122    for my $id (keys %order) {
123    my @p = @{ $order{$id} };
124    for (splice(@p, 3)) {
125        push(@f, &dsc_find($id)) if $_ eq $ref;
126    }
127    }
128    return @f;
129}
130
131
132sub usage
133{
134    print STDERR "usage: $0 [-s/from/to/ ...] ...\n";
135    exit(1);
136}
137
138
139while ($ARGV[0] =~ /^-s/) {
140    &usage unless &dsc_xlat_arg($');
141    shift @ARGV;
142}
143&usage if $ARGV[0] =~ /^-./;
144
145&parse;
146
147
148#
149# pass 1: find the orientation of all parts
150#
151
152for (@eeschema) {
153    $ref = $1 if /^L \S+ (\S+)/;
154    undef $ref if /^\$EndComp/;
155    next unless /^\s+(-?[01])\s+(-?[01])\s+(-?[01])\s+(-?[01])\s*$/;
156    my @m = split(/\s+/);
157    shift @m;
158    $m{$ref} = [ @m ];
159}
160
161
162#
163# pass 2: block the spaces occupied by fields
164#
165
166for (@eeschema) {
167    $ref = $1 if /^L \S+ (\S+)/;
168    if (/^P (\d+) (\d+)/) {
169    $x0 = $1;
170    $y0 = $2;
171    }
172    next unless /^F /;
173    die "$_" unless
174      /^F \d+ "([^"]*)" ([HV]) (\d+) (\d+) (\d+) +(\d+) ([LC]) (C)/;
175    ($s, $hv, $x, $y, $size, $flag, $hj, $vj) =
176      ($1, $2, $3, $4, $5, $6, $7, $8);
177    $dx = $x-$x0;
178    $dy = $y-$y0;
179    $x = $x0+$dx*$m{$ref}[0]+$dy*$m{$ref}[1];
180    $y = $y0+$dx*$m{$ref}[2]+$dy*$m{$ref}[3];
181    next if $flag != 0;
182    $w = $size*0.8*length $s;
183    # we don't need to consider H/V
184    &block($hj eq "L" ? $x : $x-$w/2, $y+$size/2, $w, $size);
185}
186
187#
188# pass 3:
189#
190
191for (@eeschema) {
192    undef @f if /^\$Comp/;
193    if (/^L \S+ (\S+)/) {
194    $ref = $1;
195    push(@f, &dsc_order($ref)) if %order;
196    push(@f, &dsc_parts($ref)) if %parts;
197    }
198    if (/^P (\d+) (\d+)/) {
199    $x = $1;
200    $y = $2;
201    }
202    if (/^\s+/) {
203    my %seen;
204    my @u = ();
205    for (@f) {
206        next if $seen{$_};
207        push(@u, $_);
208        $seen{$_} = 1;
209    }
210    undef @f;
211    # $m{$ref}[0] == 1 OK
212    # $m{$ref}[0] == -1 OK
213    # $m{$ref}[1] == 1 OK
214    # $m{$ref}[1] == -1 OK (small deviations found)
215    &put($x, $y, $ref, @u) if 1 || $m{$ref}[1] == -1;
216    }
217    if (/\$EndSCHEMATC/) {
218    # uncomment for debugging
219# print $wnl;
220    }
221    print "$_\n";
222}
old-boom/bom2part
1#!/usr/bin/perl
2
3require "parser.pl";
4require "match.pl";
5require "misc.pl";
6
7
8sub issue
9{
10    print shift(@_), " ", join(" ", @_, &eq(@_)), "\n";
11}
12
13
14sub scale
15{
16    local ($v, $m) = @_;
17
18    return $v*1e-12 if $m eq "p";
19    return $v*1e-9 if $m eq "n";
20    return $v*1e-6 if $m eq "u";
21    return $v*1e-3 if $m eq "m";
22    return $v*1e3 if $m eq "k";
23    return $v*1e6 if $m eq "M";
24    return $v*1e9 if $m eq "G";
25    return $v if $m eq "";
26    die "unknown multiplier \"$m\"";
27}
28
29
30sub compat
31{
32    local ($a, $b) = @_; # $a = part char., $b = component spec.
33
34    return 1 if $a eq $b;
35    return 0 unless $a =~ /^([0-9.]+)([GMkmunp]?)/;
36    my ($av, $am, $au) = ($1, $2, $');
37    return 0 unless $b =~ /^(>|>=|<|<=)([0-9.]+)([GMkmunp]?)/;
38    my ($rel, $bv, $bm, $bu) = ($1, $2, $3, $');
39    return 0 if $au ne $bu;
40    $av = &scale($av, $am);
41    $bv = &scale($bv, $bm);
42    return $av > $bv if $rel eq ">";
43    return $av >= $bv if $rel eq ">=";
44    return $av < $bv if $rel eq "<";
45    return $av <= $bv if $rel eq "<=";
46    die;
47}
48
49
50if ($ARGV[0] eq "-d") {
51    $debug = 1;
52    shift @ARGV;
53}
54&parse;
55
56$total = 0;
57$bad = 0;
58
59print "#PAR\n";
60for $ref (keys %cmp) {
61    @f = @{ $cmp{$ref} };
62    $total++;
63
64    print STDERR "REF $ref\n" if $debug;
65
66    # if we're lucky, we get a direct ID match
67
68    if (defined $id{$f[0]}) {
69    print STDERR "FIRST ID\n" if $debug;
70    &issue($ref, $id{$f[0]});
71    next;
72    }
73
74    # no such luck. Let's roll up our sleeves and to the substitutions.
75
76    undef %field;
77    $field{"REF"} = $ref;
78    $field{"VAL"} = $f[0];
79    if ($f[1] eq "") {
80    print STDERR "warning: $ref ($f[0]) has no footprint\n";
81    } else {
82    $field{"FP"} = $f[1];
83    }
84    for (my $i = 1; $i != 10; $i++) {
85    $field{"F$i"} = $f[$i+1];
86    }
87    &apply_rules();
88
89    # try our luck again
90
91    if (defined $id{$field{"VAL"}}) {
92    print STDERR "SECOND ID\n" if $debug;
93    &issue($ref, $id{$field{"VAL"}});
94    next;
95    }
96
97    # still nothing. Let's match characteristics then.
98
99    my @p = ();
100    COMP: for my $c (keys %chr) {
101    print STDERR "PART $c\n" if $debug;
102    for (keys %field) {
103        next if $_ eq "REF" || $_ eq "VAL" || $_ =~ /^F\d$/;
104        next if $field{$_} eq "";
105        print STDERR " $_=",$field{$_}," " if $debug;
106        if (!defined $chr{$c}{$_}) {
107        print STDERR "NO FIELD\n" if $debug;
108        next COMP;
109        next;
110        }
111        if (&compat($chr{$c}{$_}, $field{$_})) {
112        print STDERR "== $chr{$c}{$_}\n" if $debug;
113        } else {
114        print STDERR "!= $chr{$c}{$_}\n" if $debug;
115        next COMP;
116        }
117    }
118    push(@p, $c);
119    }
120    if (@p) {
121    &issue($ref, @p);
122    next;
123    }
124
125    print STDERR "unmatched: $ref (", join(", ", @f), ")\n";
126    $bad++;
127# print join("#", ($ref, @f)), " -> $id{$f[0]}\n";
128}
129print STDERR "$bad/$total unmatched\n" if $bad;
old-boom/boom
1#!/usr/bin/perl
2
3
4sub usage
5{
6    print STDERR "usage: $0 command [arg ...]\n";
7    exit(1);
8}
9
10
11&usage unless @ARGV;
12
13($d = $0) =~ s|/[^/]*$||;
14if ($d eq "") {
15    $p = "/";
16} elsif ($d =~ /^\//) {
17    $p = "$d";
18} else {
19    chomp($cwd = `pwd`);
20    $p = "$cwd/$d";
21}
22
23$cmd = shift @ARGV;
24$cmd = "$p/$cmd" unless $cmd =~ m|/|;
25exec("perl", "-I", $p, $cmd, @ARGV);
26die "exec perl: $!";
old-boom/gen2chr
1#!/usr/bin/perl
2
3require "parser.pl";
4require "match.pl";
5
6
7sub translate
8{
9    local ($r) = @_;
10
11    undef %field;
12    $field{"REF"} = $r;
13    &match_set_error($r);
14    if (!&apply_rules()) {
15    print "$id{$r}\n" if $negate;
16    return;
17    }
18    return if $negate;
19    print $id{$r};
20    for (sort keys %field) {
21    next if $_ =~ /^_/;
22    next if $_ eq "REF";
23    print " $_=$field{$_}";
24    }
25    print "\n";
26}
27
28
29sub usage
30{
31    print STDERR "usage: $0 [-d|-n] key file ...\n";
32    print STDERR " $0 -q query file ...\n";
33    exit(1);
34}
35
36while ($ARGV[0] =~ /^-/) {
37    if ($ARGV[0] eq "-d") {
38    $debug = 1;
39    } elsif ($ARGV[0] eq "-n") {
40    $negate = 1;
41    } elsif ($ARGV[0] eq "-q") {
42    $query = 1;
43    } else {
44    &usage;
45    }
46    shift @ARGV;
47}
48
49$key = shift @ARGV;
50&usage unless defined $key;
51
52&parse;
53
54if ($query) {
55    $debug = 1;
56    &translate($key);
57    exit(0);
58}
59
60print "#CHR\n";
61for (keys %id) {
62    next unless $id{$_} eq "$key $_";
63    &translate($_);
64}
old-boom/match.pl
1#!/usr/bin/perl
2
3use re 'eval';
4
5
6#
7# "sub" populates the following global variables:
8#
9# $end[rule-number] = 0 / 1
10# $match[rule-number]{field}[0] = original-pattern
11# $match[rule-number]{field}[1] = RE1
12# $match[rule-number]{field}[2] = RE2
13# $action[rule-number]{field} = value
14#
15# $match_stack[depth]{field}[0] = original-pattern
16# $match_stack[depth]{field}[1] = RE1
17# $match_stack[depth]{field}[2] = RE2
18# $action_stack[depth]{field} = value
19# $may_cont = 0 / 1
20# $last
21# $last_action
22#
23
24#
25# $cvn_from{internal-handle} = index
26# $cvn_to{internal-handle} = index
27# $cvn_unit{internal-handle} = unit-name
28# $cvn_num = internal-handle
29# $found{field-or-subfield} = string
30
31
32#
33# We convert each input pattern into two regular expressions: the first matches
34# units in the nXn notation, e.g., 4u7 or 100R. The second matches them in SI
35# notation (sans space).
36#
37# When matching (sub_match), we first apply the first expression. Each time we
38# encounter a unit ($R, $F, etc.), __cvn is called. __cvn stores the index of
39# the unit in %cvn_from and %cvn_to.
40#
41# We then pick these substrings from the input string and convert the units to
42# SI notation. At the same time, we normalize the mantissa. Once done, we run
43# the second expression. This one always matches (hopefully :-)
44#
45# All (...) ranges in the original pattern have been replaced with named
46# capture buffers in the second expression, so all these subfields are now
47# gathered in the $+ array. (The same also happened in the first pass, but we
48# ignore it.)
49#
50# Finally, when expanding a value (sub_expand), we look for $field and
51# $field:index, and expand accordingly.
52#
53
54
55sub __cvn
56{
57    local ($num) = @_;
58
59    $cvn_from{$num} = $-[$#-];
60    $cvn_to{$num} = $+[$#+];
61}
62
63
64sub sub_match
65{
66    local ($s, $field, $m1, $m2) = @_;
67
68    #
69    # Perform the first match and record where we saw $<unit> patterns.
70    #
71    undef %cvn_from;
72    undef %cvn_to;
73    return undef unless $s =~ $m1;
74
75    #
76    # Convert the unit patterns to almost-SI notation. (We don't put a space
77    # after the number, but the rest is SI-compliant.)
78    #
79    my $off = 0;
80    for (keys %cvn_from) {
81    my $unit = $cvn_unit{$_};
82    my $from = $cvn_from{$_}+$off;
83    my $len = $cvn_to{$_}-$cvn_from{$_};
84    die unless substr($s, $from, $len) =~
85        /(\d+)$unit(\d*)|(\d+)([GMkmunpf])(\d*)/;
86
87    #
88    # Normalize to \d+.\d*
89    #
90    my $v = "$1$3.$2$5";
91    my $exp = $4 eq "" ? " " : $4;
92
93    #
94    # Remove leading zeroes.
95    #
96    $v =~ s/^0*(\d+)/\1/;
97
98    #
99    # Mantissa must be < 1000.
100    # Do the math as string operation to avoid rounding errors.
101    #
102    while ($v =~ /(\d+)(\d{3})\./) {
103        $v = "$1.$2$'";
104        $exp =~ tr/GMk munpf/TGMk munp/;
105    }
106
107    #
108    # Mantissa must be >= 1.
109    #
110    while ($v =~ /\b0\.(\d+)/) {
111        if (length $1 < 3) {
112        $v = $1.("0" x (3-length $1)).".";
113        } else {
114        $v = substr($1, 0, 3).".".substr($1, 3);
115        }
116        $exp =~ tr/GMk munpf/Mk munpa/;
117    }
118
119    #
120    # Remove trailing zeroes
121    #
122    $v =~ s/(\.[1-9]*)0*/\1/;
123
124    $exp =~ s/ //;
125    $v =~ s/\.$//;
126    $v = $v.$exp.$unit;
127    $off += length($v)-$len;
128    substr($s, $from, $len, $v);
129    }
130
131    #
132    # Run the second match on the string to process any (...) patterns
133    #
134    $found{$field} = $s;
135    die $m2 unless $s =~ $m2;
136    for (keys %+) {
137    $found{$_} = $+{$_};
138    }
139    return $s;
140}
141
142
143sub sub_expand
144{
145    local ($s) = @_;
146
147    while ($s =~ /^([^\$]*)\$([A-Za-z_]\w*)(:(\d+))?|^([^\$]*)\${([A-Za-z_]\w*)(:(\d+))?}/) {
148    my $name = "$2$6";
149    $name .= "__$4$8" if defined($4) || defined($8);
150    if (!defined $found{$name}) {
151        die "don't know \"$name\"".
152          (defined $__match_error ?
153          " (processing \"$__match_error\")" : "");
154    }
155    $s = $1.$5.$found{$name}.$';
156    }
157    return $s;
158}
159
160
161#
162# return 0 if all rules have been exhausted, 1 if there was an explicit halt.
163#
164
165sub apply_rules
166{
167    RULE: for (my $i = 0; $i <= $#match; $i++) {
168    print STDERR "RULE #$i\n" if $debug;
169    %found = %field;
170    FIELD: for my $f (keys %{ $match[$i] }) {
171        my @f = $f ne "FN" ? ($f) :
172          ("F1", "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9");
173        for (@f) {
174        print STDERR " MATCH $_=$match[$i]{$f}[0] " if $debug;
175        if (!defined $found{$_}) {
176            print STDERR "NO FIELD\n" if $debug;
177            next;
178        }
179        print STDERR "FIELD $found{$_} " if $debug;
180        if (!defined &sub_match($found{$_}, $f,
181          $match[$i]{$f}[1], $match[$i]{$f}[2])) {
182            print STDERR "MISS\n" if $debug;
183            next;
184        }
185        print STDERR "MATCH\n" if $debug;
186        next FIELD;
187        }
188        next RULE;
189    }
190    for (keys %{ $action[$i] }) {
191        my $s = &sub_expand($action[$i]{$_});
192        print STDERR " SET $_=$action[$i]{$_} => $s\n" if $debug;
193        $field{$_} = $s;
194    }
195    if ($end[$i]) {
196        print STDERR " END\n" if $debug;
197        return 1;
198    }
199    }
200    return 0;
201}
202
203
204sub match_set_error
205{
206    $__match_error = $_[0];
207}
208
209
210return 1;
old-boom/misc.pl
1#!/usr/bin/perl
2
3
4#
5# determine the equivalent parts, taking into account that %eq is transitive
6#
7
8sub eq
9{
10    my %seen;
11    my @p = @_; # parts to consider
12    my @r = (); # new equivalences we've found
13    my $skip = @p;
14
15    while (@p) {
16    my $p = shift @p;
17    next if $seen{$p};
18    $seen{$p} = 1;
19    push(@r, $p) if $skip-- <= 0;
20    push(@p, @{ $eq{$p} });
21    }
22    return @r;
23}
24
25
26#
27# When looking for a description, we also consider equivalent parts.
28#
29# Furthermore, some descriptions may just be pointers to other descriptions.
30# Users can add regular expressions that are used to extract references from
31# a description, which are then looked up as well.
32#
33
34sub __dsc_lookup
35{
36    local ($id) = @_;
37
38    for ($id, &eq($id)) {
39        return $dsc{$_} if defined $dsc{$_};
40    }
41    return undef;
42}
43
44
45sub dsc_find
46{
47    my $id = $_[0];
48    LOOKUP: while (1) {
49    my $dsc = &__dsc_lookup($id);
50    return undef unless defined $dsc;
51    for (my $i = 0; $i <= $#xlat_from; $i++) {
52# @@@ this is UUUUHHHGLLEEEEE !!! Why can't I just expand $to[$i] ?
53        next
54          unless ($id = $dsc) =~ s/^.*$xlat_from[$i].*$/$xlat_to[$i] $1/;
55        next LOOKUP if defined &__dsc_lookup($id);
56    }
57    return $dsc;
58    }
59    return undef;
60}
61
62
63sub dsc_xlat
64{
65    local ($from, $to) = @_;
66    push(@xlat_from, $from);
67    push(@xlat_to, $to);
68}
69
70
71sub dsc_xlat_arg
72{
73    return undef unless $_[0] =~ /^(.)([^\1]*)\1([^\1]*)\1$/;
74    &dsc_xlat($2, $3);
75    return 1;
76}
77
78
79#
80# Lexical ordering of component references
81#
82
83sub cmp_cref
84{
85    local ($a, $b) = @_;
86    local ($as, $an, $bs, $bn);
87
88    return $a cmp $b unless ($as, $an) = $a =~ /^([[:alpha:]]+)(\d*)$/;
89    return $a cmp $b unless ($bs, $bn) = $b =~ /^([[:alpha:]]+)(\d*)$/;
90    return $as cmp $bs unless $as eq $bs;
91    return $an <=> $bn
92}
93
94
95return 1;
old-boom/pardup.pl
1#!/usr/bin/perl
2while (<>) {
3    @f = split(/\s+/);
4    $ref = shift @f;
5    for ($i = 0; $i != @f; $i++) {
6    next unless $f[$i] eq "FIC" || $f[$i] eq "MISSING" ||
7      $f[$i] eq "DIGI-KEY";
8    splice(@f, $i, 2);
9    $i--;
10    }
11    next if @f < 3;
12    push(@{ $multi{join(" ", @f)} }, $ref);
13}
14for (sort keys %multi) {
15    print "$_ -- ", join(" ", @{ $multi{$_} }), "\n";
16}
old-boom/parser.pl
1#!/usr/bin/perl
2
3use re 'eval';
4use IO::File;
5
6
7#
8# "sanitize" converts all "special" characters to underscores. This is used to
9# avoid part names that could conflict with other uses of meta-characters, such
10# as spaces or hash signs.
11#
12
13sub sanitize
14{
15    local (*s) = @_;
16    my $ok = '[^-a-zA-Z0-9._%,:()=+\/]';
17
18    print STDERR "converting special character(s) in $s\n" if $s =~ /$ok/;
19    $s =~ s/$ok/_/g;
20}
21
22
23sub skip
24{
25    # do nothing
26}
27
28
29#
30# "bom" populates the following global variable:
31#
32# $cmp{component-reference}[0] = value
33# $cmp{component-reference}[1] = footprint
34# $cmp{component-reference}[2] = field1
35# ...
36#
37
38sub bom
39{
40    if (/^#End Cmp/) {
41    $mode = *skip;
42    return;
43    }
44    die unless /^\|\s+(\S+)\s+/;
45    my $ref = $1;
46    my @f = split(/\s*;\s*/, $');
47    next if $f[0] eq "NC";
48    for (@f) {
49    s/\s+$//;
50    &sanitize(\$_);
51    }
52    $cmp{$ref} = [ @f ];
53}
54
55
56#
57# "equ" populates the following global variables:
58#
59# $id{item-number} = "namespace item-number"
60# This is used for heuristics that look up parts commonly referred to by
61# their part number.
62#
63# $eq{"namespace0 item-number0"}[] = ("namespace1 item-number1", ...)
64# List of all parts a given part is equivalent to.
65#
66
67sub equ
68{
69    my @f = split(/\s+/);
70    &sanitize(\$f[1]);
71    &sanitize(\$f[3]);
72    my $a = "$f[0] $f[1]";
73    my $b = "$f[2] $f[3]";
74    $id{$f[1]} = $a;
75    $id{$f[3]} = $b;
76    push @{ $eq{$a} }, $b;
77    push @{ $eq{$b} }, $a;
78}
79
80
81#
82# "inv" populates the following global variables:
83#
84# $id{item-number} = "namespace item-number"
85# This is used for heuristics that look up parts commonly referred to by
86# their part number.
87#
88# $inv{"namespace item-number"}[0] = items-in-stock
89# $inv{"namespace item-number"}[1] = currency
90# $inv{"namespace item-number"}[2] = order-quantity
91# $inv{"namespace item-number"}[3] = unit-price
92# [2] and [3] may repeat.
93#
94
95sub inv
96{
97    my @f = split(/\s+/);
98    &sanitize(\$f[1]);
99    my $id = "$f[0] $f[1]";
100    shift @f;
101    my $ref = shift @f;
102    die "duplicate inventory entry for \"$id\"" if defined $inv{$id};
103    $id{$ref} = $id;
104    $inv{$id} = [ @f ];
105    $inv{$id}[0] = 999999 unless defined $inv{$id}[0];
106    $inv{$id}[1] = "N/A" unless defined $inv{$id}[1];
107    $inv{$id}[2] = 1 unless defined $inv{$id}[2];
108    $inv{$id}[3] = 999999 unless defined $inv{$id}[3];
109}
110
111
112#
113# "par" populates the following global variables:
114#
115# $parts{component-ref}[0] = namespace
116# $parts{component-ref}[1] = item-number
117# [0] and [1] may repeat
118#
119# $want{"namespace item"} = number of times we may use the part. If multiple
120# parts are eligible for a component, each of them is counted as desirable
121# for each component.
122#
123# $comps{"namespace item"}{component-ref} = 1
124# Set of components a part may be used for.
125#
126
127sub par
128{
129    my @f = split(/\s+/);
130    my $ref = shift @f;
131    $parts{$ref} = [ @f ];
132    while (@f) {
133    my @id = splice(@f, 0, 2);
134    my $id = "$id[0] $id[1]";
135    $want{$id}++;
136    $comps{$id}{$ref} = 1;
137    }
138}
139
140
141#
142# "chr" populates the following global variable:
143#
144# $chr{"namespace item-number"}{parameter} = value
145#
146# $last is used internally for continuation lines.
147#
148
149sub chr
150{
151    my @f;
152    if (/^\s+/) {
153    @f = split(/\s+/, $');
154    } else {
155    @f = split(/\s+/);
156    my $ref = shift @f;
157    my $num = shift @f;
158    $last = "$ref $num";
159    }
160    for (@f) {
161    die "\"=\" missing in $_" unless /=/;
162    $chr{$last}{uc($`)} = $';
163    }
164}
165
166
167#
168# "sub" populates the following global variables:
169#
170# $end[rule-number] = 0 / 1
171# $match[rule-number]{field}[0] = original-pattern
172# $match[rule-number]{field}[1] = RE1
173# $match[rule-number]{field}[2] = RE2
174# $action[rule-number]{field} = value
175#
176# $match_stack[depth]{field}[0] = original-pattern
177# $match_stack[depth]{field}[1] = RE1
178# $match_stack[depth]{field}[2] = RE2
179# $action_stack[depth]{field} = value
180# $may_cont = 0 / 1
181# $last
182# $last_action
183#
184
185#
186# $cvn_from{internal-handle} = index
187# $cvn_to{internal-handle} = index
188# $cvn_unit{internal-handle} = unit-name
189# $cvn_num = internal-handle
190# $found{field-or-subfield} = string
191
192
193sub sub_pattern
194{
195    local ($field, $p) = @_;
196    my $n = 0;
197    $p =~ s/\./\\./g;
198    $p =~ s/\+/\\+/g;
199    $p =~ s/\?/./g;
200    $p =~ s/\*/.*/g;
201    my $tmp = "";
202    while ($p =~ /^([^\(]*)\(/) {
203    $n++;
204    $tmp .= "$1(?'${field}__$n'";
205    $p = $';
206    }
207    $p = "^".$tmp.$p."\$";
208    my $q = $p;
209    while ($p =~ /^([^\$]*)\$(.)/) {
210    $p = "$1(\\d+$2\\d*|\\d+[GMkmunpf$2]\\d*)(?{ &__cvn($cvn_num); })$'";
211    $cvn_unit{$cvn_num} = $2;
212    die unless $q =~ /^([^\$]*)\$(.)/;
213    $q = "$1(\\d+(\.\\d+)?[GMkmunpf]?$2)$'";
214    $cvn_num++;
215    }
216    return ($p, $q);
217}
218
219
220sub sub_value
221{
222    return $_[0];
223}
224
225
226sub sub
227{
228    /^(\s*)/;
229    my $indent = $1;
230    my @f = split(/\s+/, $');
231    my $f;
232    my $in = 0; # indentation level
233    while (length $indent) {
234    my $c = substr($indent, 0, 1, "");
235    if ($c eq " ") {
236        $in++;
237    } elsif ($c eq "\t") {
238        $in = ($in+8) & ~7;
239    } else {
240        die;
241    }
242    }
243    if ($may_cont && $in > $last) {
244    pop(@match);
245    pop(@action);
246    pop(@end);
247    } else {
248    $match_stack[0] = undef;
249    $action_stack[0] = undef;
250    $last_action = 0;
251    $last = $in;
252    }
253    if (!$last_action) {
254    while (@f) {
255        $f = shift @f;
256        last if $f eq "->" || $f eq "{" || $f eq "}" || $f eq "!";
257        if ($f =~ /=/) {
258        $match_stack[0]{uc($`)} = [ $', &sub_pattern(uc($`), $') ];
259        } else {
260        $match_stack[0]{"REF"} = [ &sub_pattern("REF", $f) ];
261        }
262    }
263    $last_action = 1 if $f eq "->";
264    }
265    if ($last_action) {
266    while (@f) {
267        $f = shift @f;
268        last if $f eq "{" || $f eq "!";
269        die unless $f =~ /=/;
270        $action_stack[0]{uc($`)} = &sub_value($');
271    }
272    }
273    $may_cont = 0;
274    if ($f eq "{") {
275    unshift(@match_stack, undef);
276    unshift(@action_stack, undef);
277    die "items following {" if @f;
278    } elsif ($f eq "}") {
279    shift @match_stack;
280    shift @action_stack;
281    die "items following }" if @f;
282    } else {
283    die "items following !" if @f && $f eq "!";
284    push(@end, $f eq "!");
285    $may_cont = $f ne "!";
286    my $n = $#end;
287    push(@match, undef);
288    push(@action, undef);
289    for my $m (reverse @match_stack) {
290        for (keys %{ $m }) {
291        $match[$n]{$_} = $m->{$_};
292        }
293    }
294    for my $a (reverse @action_stack) {
295        for (keys %{ $a }) {
296        $action[$n]{$_} = $a->{$_};
297        }
298    }
299    }
300}
301
302
303#
304# "ord" populates the following global variables:
305#
306# $order{"namespace item-number"}[0] = quantity to order
307# $order{"namespace item-number"}[1] = currency
308# $order{"namespace item-number"}[2] = total cost in above currency
309# $order{"namespace item-number"}[3] = component reference
310# ...
311#
312
313sub ord
314{
315    my @f = split(/\s+/);
316    my @id = splice(@f, 0, 2);
317    @{ $order{"$id[0] $id[1]"} } = @f;
318}
319
320
321#
322# "dsc" populates the following global variable:
323#
324# $dsc{"namespace item-number"} = description
325#
326
327sub dsc
328{
329    my @f = split(/\s+/);
330    my @id = splice(@f, 0, 2);
331    $dsc{"$id[0] $id[1]"} = join(" ", @f);
332}
333
334
335#
336# "eeschema" populates the following global variable:
337#
338# $eeschema[] = line
339#
340
341
342sub eeschema
343{
344    push(@eeschema, $_[0]);
345    if ($_[0] =~ /^\$EndSCHEMATC/) {
346    $mode = *skip;
347    undef $raw;
348    }
349}
350
351
352sub babylonic
353{
354    if ($_[0] =~ /^#/) {
355    $hash++;
356    if ($hash == 2) {
357        $mode = *skip;
358        undef $raw;
359    }
360    return;
361    }
362    &bom($_[0]) if $hash == 1;
363}
364
365
366sub dirname
367{
368    local ($name) = @_;
369
370    return $name =~ m|/[^/]*$| ? $` : ".";
371}
372
373
374sub rel_path
375{
376    local ($cwd, $path) = @_;
377
378    return $path =~ m|^/| ? $path : "$cwd/$path";
379}
380
381
382sub parse_one
383{
384    local ($name) = @_;
385
386    my $file = new IO::File->new($name) || die "$name: $!";
387    my $dir = &dirname($name);
388
389    while (1) {
390    $_ = <$file>;
391    if (!defined $_) {
392        $file->close();
393        return unless @inc;
394        $file = pop @inc;
395        $dir = pop @dir;
396        next;
397    }
398    if (/^\s*include\s+(.*?)\s*$/) {
399        push(@inc, $file);
400        push(@dir, $dir);
401        $name = &rel_path($dir, $1);
402        $dir = &dirname($name);
403        $file = new IO::File->new($name) || die "$name: $!";
404        next;
405    }
406    chop;
407
408# ----- KiCad BOM parsing. Alas, the BOM is localized, so there are almost no
409# reliable clues for the parser. Below would be good clues for the English
410# version:
411    if (0 && /^#Cmp.*order = Reference/) {
412        $mode = *bom;
413        next;
414    }
415    if (0 && /^#Cmp.*order = Value/) {
416        $mode = *skip;
417        next;
418    }
419    if (0 && /^eeschema \(/) { # hack to allow loading in any order
420        $mode = *skip;
421        next;
422    }
423# ----- now an attempt at a "generic" version:
424    if (/^eeschema \(/) {
425        $mode = *babylonic;
426        $hash = 0;
427        $raw = 1;
428        next;
429    }
430# -----
431    if (/^EESchema Schematic/) {
432        $mode = *eeschema;
433        $raw = 1;
434        die "only one schematic allowed" if defined @eeschema;
435        &eeschema($_);
436        next;
437    }
438    if (/^#EQU\b/) {
439        $mode = *equ;
440        next;
441    }
442    if (/^#INV\b/) {
443        $mode = *inv;
444        next;
445    }
446    if (/^#PAR\b/) {
447        $mode = *par;
448        next;
449    }
450    if (/^#CHR\b/) {
451        $mode = *chr;
452        undef $last;
453        next;
454    }
455    if (/^#(SUB|GEN)\b/) {
456        $mode = *sub;
457        undef $last;
458        undef $last_action;
459        undef $may_cont;
460        next;
461    }
462    if (/^#ORD\b/) {
463        $mode = *ord;
464        next;
465    }
466    if (/^#DSC\b/) {
467        $mode = *dsc;
468        next;
469    }
470    if (/^#END\b\(/) { # for commenting things out
471        $mode = *skip;
472        next;
473    }
474    if (!$raw) {
475        s/#.*//;
476        next if /^\s*$/;
477    }
478    &$mode($_);
479    }
480}
481
482
483sub parse
484{
485    $mode = *skip;
486    for (@ARGV) {
487    &parse_one($_);
488    }
489}
490
491#
492# in case user calls directly &parse_one and not &parse
493#
494$mode = *skip;
495
496return 1;
old-boom/part2order
1#!/usr/bin/perl
2
3require "parser.pl";
4require "misc.pl";
5
6$mult = shift(@ARGV);
7&parse;
8
9
10sub number
11{
12    local ($id) = @_;
13
14    my $s = $inv{$id}[0];
15    my $n = $want{$id}*$mult;
16    return $n < $s ? $n : $s;
17
18}
19
20
21#
22# The heuristics here aren't very nice. We give zero-cost stock priority over
23# any other stock, when we go by stock size up to the quantity we need. The
24# idea is to exhause local stock (zero-cost) first, then try to obtain the
25# parts with as few orders as possible.
26#
27# It would be better to have some sort of priority, so that we can express a
28# preference among stock we already own. Also, if non-zero-cost stock has widly
29# different prices, the smallest order cost may not be a good indicator of
30# which source we prefer.
31#
32# Furthermore, the algorithm doesn't consider the number of sources we use in
33# total or things like lead time, shipping cost, customs, etc.
34#
35
36sub rank
37{
38    local ($a, $b) = @_;
39
40    my $na = &number($a); # min(number wanted, available)
41    my $nb = &number($b);
42    my $pa = $inv{$a}[3]; # per unit price for smallest quantum
43    my $pb = $inv{$b}[3];
44
45#print STDERR "a=$a b=$b na=$na nb=$nb pa=$pa pb=$pb\n";
46    return 1 if $na && !$pa && $pb;
47    return -1 if $nb && $pa && !$pb;
48    return $na <=> $nb if $na != $nb;
49    return $pb <=> $pa;
50}
51
52
53for (keys %parts) {
54    $parts++;
55}
56
57print "#ORD\n";
58for (sort { &rank($b, $a) } keys %want) {
59    my $n = &number($_);
60    $n -= $n % $mult;
61    next unless $n;
62    my @f = @{ $inv{$_} };
63    my $max = shift @f;
64    my $currency = shift @f;
65    my @qty;
66    my @price;
67    my %index;
68    my $best_qty;
69    my $best_price = undef;
70    while (@f) {
71    my $q = shift @f;
72    my $p = shift @f;
73    if (defined $index{$q}) {
74        $price[$index{$q}] = $p;
75    } else {
76        push(@qty, $q);
77        push(@price, $p);
78        $index{$q} = $#qty;
79        # @@@ this fails if smaller quantities following a large quantity
80        # differ from the quantities preceding them. E.g., 1 10 100 25
81        # wouldn't yield correct results.
82    }
83    for (my $i = $#qty; $i >= 0; $i--) {
84        my $order = 0;
85        my $price = 0;
86        my $left = $n;
87        for (my $j = $#qty; $j >= $i; $j--) {
88        while ($left >= ($j == $i ? 1 : $qty[$j])) {
89            $left -= $qty[$j];
90            $order += $qty[$j];
91            $price += $price[$j]*$qty[$j];
92        }
93        }
94        next if $order > $max;
95        if (!defined $best_price || $price < $best_price) {
96        $best_price = $price;
97        $best_qty = $order;
98        }
99    }
100    }
101    next if !defined $best_price;
102    print "$_ $best_qty $currency $best_price";
103    my $id = $_;
104    while (keys %{ $comps{$id} }) {
105    last if $best_qty < $mult;
106    $best_qty -= $mult;
107    my $ref = (sort { &cmp_cref($a, $b); } keys %{ $comps{$id} })[0];
108#print STDERR "$id: $ref + ", join("|", keys %{ $comps{$id} }), "\n";
109    my @f = @{ $parts{$ref} };
110    while (@f) {
111        my @id2 = splice(@f, 0, 2);
112        my $id2 = "$id2[0] $id2[1]";
113        $want{$id2}--;
114        delete $comps{$id2}{$ref};
115    }
116    print " $ref";
117    }
118    print "\n";
119}
120
121for my $id (sort { $want{$b} <=> $want{$a} } keys %want) {
122    next unless $want{$id};
123    print STDERR "$id";
124    for (&eq($id)) {
125# next unless $want{$_};
126    die "\n$_ ($want{$_}) vs. $id want ($want{$id})"
127      unless $want{$_} == $want{$id};
128    print STDERR " $_";
129    $want{$_} = 0;
130    }
131    print STDERR ": want $want{$id}\n";
132    $want{$id} = 0;
133}
old-boom/prettyord
1#!/usr/bin/perl
2
3require "parser.pl";
4require "misc.pl";
5
6
7sub usage
8{
9    print STDERR <<"END";
10usage: $0 [-c] [-f|-t] [-r] [-s/from/to/ ...] ...
11
12  -c generate CSV output (default: generate formatted text)
13  -f generate SMT fab output (default: generate shopping list)
14  -r sort by component reference (default: sort by part number)
15  -s/from/to/ substitute description and treat result as reference
16  -t print the total number of items and the total cost.
17               -t cannot be combined with -c or -f.
18END
19    exit(1);
20}
21
22$shop = 1;
23$by_pn = 1;
24while ($ARGV[0] =~ /^-./) {
25    if ($ARGV[0] =~ /^-s/) {
26    &usage unless &dsc_xlat_arg($');
27    } elsif ($ARGV[0] eq "-c") {
28    $csv = 1;
29    } elsif ($ARGV[0] eq "-f") {
30    $shop = 0;
31    } elsif ($ARGV[0] eq "-r") {
32    $by_pn = 0;
33    } elsif ($ARGV[0] eq "-t") {
34    $total = 1;
35    } else {
36    &usage;
37    }
38    shift @ARGV;
39}
40
41&usage if $total && !$shop;
42&usage if $total && $csv;
43
44&parse;
45
46$out[0][0] = "Pos";
47$out[1][0] = "Qty";
48$out[2][0] = "P/N";
49$out[3][0] = "Description";
50
51if ($shop) {
52    $out[4][0] = "Value";
53    $out[5][0] = "";
54} else {
55    $out[4][0] = "Ref";
56}
57
58for (sort { $by_pn ? $a cmp $b : &cmp_cref($order{$a}[3], $order{$b}[3]) }
59  keys %order) {
60    push(@{ $out[0] }, ++$n);
61    push(@{ $out[1] }, $shop ? $order{$_}[0] : @{ $order{$_} }-3);
62    @f = split(/\s+/, $_);
63    push(@{ $out[2] }, $shop ? $f[1] : "$f[0] $f[1]");
64    my $dsc = &dsc_find($_);
65    print STDERR "$_: no description\n" unless defined $dsc;
66    push(@{ $out[3] }, defined $dsc ? $dsc : "???");
67    if ($shop) {
68    push(@{ $out[4] }, $order{$_}[1]);
69    push(@{ $out[5] }, sprintf("%.2f", $order{$_}[2]));
70    $price{$order{$_}[1]} += $order{$_}[2];
71    } else {
72    my @r = @{ $order{$_} };
73    push(@{ $out[4] }, join(", ", @r[3..$#r]));
74    }
75}
76
77if ($csv) {
78    for ($i = 0; $i <= $#{ $out[0] }; $i++) {
79    for ($j = 0; $j <= $#out; $j++) {
80        print "," if $j;
81        if ($i && $j < 2) {
82        print $out[$j][$i];
83        } else {
84        my $s = $out[$j][$i];
85        $s =~ s/"/''/g;
86        print "\"$s\"";
87        }
88    }
89    print "\n";
90    }
91    exit(0);
92}
93
94for (@out) {
95    push(@max, 0);
96    if (length $_->[0]) {
97    $max[$last_pos] = $last_len if defined $last_pos;
98    $last_pos = $#max;
99    $last_len = length $_->[0];
100    }
101}
102$i = 0;
103for (@out) {
104    $first = 1;
105    for (@{ $_ }) {
106    next if $first-- > 0;
107    $max[$i] = length $_ if length $_ > $max[$i];
108    }
109    $i++;
110}
111
112for ($i = 0; $i <= $#{ $out[0] }; $i++) {
113    $l = "";
114    for ($j = 0; $j != 6; $j++) {
115    my $s = $out[$j][$i];;
116    $l .= $s if $j == 2 || $j == 3 || $j == 4;
117    $l .= " " x ($max[$j]-length $s);
118    $l .= $s if $j == 0 || $j == 1 || $j == 5;
119    $l .= " " unless $j == 5;
120    }
121    $l =~ s/\s*$//;
122    print "$l\n";
123}
124
125if ($total) {
126    print "$n item".($n == 1 ? "" : "s");
127    for (sort keys %price) {
128    print ", $_ $price{$_}";
129    }
130    print "\n";
131}
old-boom/testsub
1#!/usr/bin/perl
2
3require "parser.pl";
4require "match.pl";
5
6
7sub usage
8{
9    print STDERR "usage: $0 [-d] file.sub|field ...\n\n";
10    print STDERR " fields: ref value [footprint user-field ...]\n";
11}
12
13
14for (@ARGV) {
15    if ($_ eq "-d") {
16        $debug = 1;
17        next;
18    }
19    &usage if /^-/;
20    if (/\.sub$/) {
21        &parse_one($_);
22    } else {
23        push(@f, $_);
24    }
25}
26
27&usage unless @f >= 2;
28
29$field{"REF"} = shift @f;
30$field{"VAL"} = shift @f;
31$field{"FP"} = shift @f;
32
33for (my $i = 1; $i != 10; $i++) {
34    $field{"F$i"} = $f[$i-1];
35}
36
37&apply_rules;
38
39for (sort keys %field) {
40    if ($field{$_} =~ / /) {
41        print "$_ = \"$field{$_}\"\n";
42    } else {
43        print "$_ = $field{$_}\n";
44    }
45}
old-boom/workflow.fig
1#FIG 3.2 Produced by xfig version 3.2.5a
2Landscape
3Center
4Metric
5A4
6100.00
7Single
8-2
91200 2
106 450 5850 3150 6525
114 0 0 50 -1 14 12 0.0000 4 180 2700 450 6030 Source file (in SVN)\001
124 0 0 50 -1 12 12 0.0000 4 150 1890 450 6255 Generated file\001
134 0 0 50 -1 18 12 0.0000 4 210 1830 450 6480 Program (in SVN)\001
14-6
156 450 7875 6480 9000
164 0 0 50 -1 12 12 0.0000 4 105 540 450 8055 .csv\001
174 0 0 50 -1 12 12 0.0000 4 150 540 450 8280 .inv\001
184 0 0 50 -1 12 12 0.0000 4 150 540 450 8505 .equ\001
194 0 0 50 -1 12 12 0.0000 4 150 540 450 8730 .par\001
204 0 0 50 -1 12 12 0.0000 4 150 540 450 8955 .ord\001
214 0 0 50 -1 1 12 0.0000 4 195 2520 1350 8280 inventory with stock and cost\001
224 0 0 50 -1 1 12 0.0000 4 195 3045 1350 8055 GTA02 EE component stock at FIC\001
234 0 0 50 -1 1 12 0.0000 4 195 5130 1350 8505 part number equivalences, e.g., manufacturer vs. distributor\001
244 0 0 50 -1 1 12 0.0000 4 195 2910 1350 8730 component to part number(s) map\001
254 0 0 50 -1 1 12 0.0000 4 195 5025 1350 8955 list of parts to order, with price and component references\001
26-6
276 450 7425 3465 7875
284 0 0 50 -1 12 12 0.0000 4 150 540 450 7605 .chr\001
294 0 0 50 -1 12 12 0.0000 4 150 540 450 7830 .sub\001
304 0 0 50 -1 1 12 0.0000 4 195 1695 1350 7605 part characteristics\001
314 0 0 50 -1 1 12 0.0000 4 195 2085 1350 7830 parameter substitutions\001
32-6
332 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 4
34    1 1 2.00 60.00 60.00
35     7875 2700 7875 2925 6525 2925 6525 4725
362 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 4
37    1 1 2.00 60.00 60.00
38     9000 2700 9000 5850 6525 5850 6525 6075
392 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 4
40    1 1 2.00 60.00 60.00
41     3150 1350 3150 5850 6075 5850 6075 6075
422 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
43    1 1 2.00 60.00 60.00
44     6300 2700 6300 4725
452 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
46    1 1 2.00 60.00 60.00
47     6300 2025 6300 2475
482 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
49    1 1 2.00 60.00 60.00
50     6300 1350 6300 1800
512 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 4
52    1 1 2.00 60.00 60.00
53     4950 1350 4950 4275 6075 4275 6075 4725
542 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 3
55    1 1 2.00 60.00 60.00
56     3150 4500 5850 4500 5850 4725
572 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 4
58    1 1 2.00 60.00 60.00
59     8100 4275 8100 4500 6750 4500 6750 4725
602 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 0 0 3
61     11700 1575 11700 3150 10170 3150
622 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
63    1 1 2.00 60.00 60.00
64     6300 4950 6300 5400
652 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
66    1 1 2.00 60.00 60.00
67     6300 5625 6300 6075
682 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
69    1 1 2.00 60.00 60.00
70     6300 6300 6300 6750
712 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
72    1 1 2.00 60.00 60.00
73     6300 6975 6300 7425
742 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
75    1 1 2.00 60.00 60.00
76     6525 7650 6525 8100
772 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
78    1 1 2.00 60.00 60.00
79     9000 1350 9000 1800
802 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 3
81    1 1 2.00 60.00 60.00
82     9000 1575 7875 1575 7875 1800
832 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 3
84    1 1 2.00 60.00 60.00
85     9000 1575 10125 1575 10125 1800
862 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
87    1 1 2.00 60.00 60.00
88     7875 2025 7875 2475
892 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
90    1 1 2.00 60.00 60.00
91     9000 2025 9000 2475
922 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
93    1 1 2.00 60.00 60.00
94     7875 2925 7875 3375
952 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 3
96    1 1 2.00 60.00 60.00
97     8955 3150 8325 3150 8325 3375
982 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
99    1 1 2.00 60.00 60.00
100     8100 3600 8100 4050
1012 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
102    1 1 2.00 60.00 60.00
103     10125 2025 10125 2475
1042 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 4
105    1 1 2.00 60.00 60.00
106     10125 2700 10125 7200 6750 7200 6750 7425
1072 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
108    1 1 2.00 60.00 60.00
109     8955 4500 8100 4500
1102 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
111     9045 3150 10080 3150
1122 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 0 0 3
113     11700 4050 11700 4500 10170 4500
1142 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
115     10080 4500 9045 4500
1164 0 0 50 -1 2 16 0.0000 4 255 3345 450 675 BOM Processing - Workflow\001
1174 1 0 50 -1 12 12 0.0000 4 195 1890 6300 2655 gta02-core.lst\001
1184 1 0 50 -1 18 12 0.0000 4 165 1035 6300 1980 eeschema\001
1194 1 0 50 -1 14 12 0.0000 4 150 675 6300 1305 *.sch\001
1204 1 0 50 -1 18 12 0.0000 4 210 990 6300 4905 bom2part\001
1214 1 0 50 -1 18 12 0.0000 4 210 1110 6300 6255 part2order\001
1224 1 0 50 -1 12 12 0.0000 4 195 1890 6300 6930 gta02-core.ord\001
1234 1 0 50 -1 12 12 0.0000 4 195 1890 6300 5580 gta02-core.par\001
1244 1 0 50 -1 14 12 0.0000 4 195 1890 4950 1305 gta02-core.sub\001
1254 1 0 50 -1 14 12 0.0000 4 195 1890 3105 1305 gta02-core.inv\001
1264 1 0 50 -1 18 12 0.0000 4 210 975 6525 7605 prettyord\001
1274 1 0 50 -1 18 12 0.0000 4 165 1095 7875 1980 fic2vendor\001
1284 1 0 50 -1 18 12 0.0000 4 165 675 9000 1980 fic2inv\001
1294 1 0 50 -1 18 12 0.0000 4 210 855 8100 3555 gen2chr\001
1304 1 0 50 -1 12 12 0.0000 4 150 675 8100 4230 *.chr\001
1314 1 0 50 -1 12 12 0.0000 4 195 945 7875 2655 fic.equ\001
1324 1 0 50 -1 12 12 0.0000 4 150 945 9000 2655 fic.inv\001
1334 1 0 50 -1 18 12 0.0000 4 165 735 10125 1980 fic2dsc\001
1344 1 0 50 -1 14 12 0.0000 4 195 2700 9000 1305 inventory-fic-ee.csv\001
1354 0 0 50 -1 12 12 0.0000 4 150 540 450 7155 .lst\001
1364 0 0 50 -1 1 12 0.0000 4 195 2220 1350 7155 BOM generated by KiCad\001
1374 0 0 50 -1 12 12 0.0000 4 150 540 450 6930 .sch\001
1384 0 0 50 -1 1 12 0.0000 4 195 2010 1350 6930 schematics (for KiCad)\001
1394 0 0 50 -1 12 12 0.0000 4 150 540 450 7380 .gen\001
1404 0 0 50 -1 1 12 0.0000 4 195 2745 1350 7380 characteristics generation rules\001
1414 0 0 50 -1 12 12 0.0000 4 150 540 450 9180 .dsc\001
1424 0 0 50 -1 1 12 0.0000 4 195 2685 1350 9180 Textual component description\001
1434 1 0 50 -1 14 12 0.0000 4 180 675 11700 1305 *.gen\001
1444 1 0 50 -1 14 12 0.0000 4 150 675 11700 3780 *.chr\001
1454 1 0 50 -1 14 9 0.0000 4 135 1440 11700 4005 (acx, misc, ...)\001
1464 1 0 50 -1 14 9 0.0000 4 135 1800 11700 1530 (darfon, ralec, ...)\001
1474 1 0 50 -1 12 12 0.0000 4 150 945 10125 2655 fic.dsc\001

Archive Download the corresponding diff file

Branches:
master



interactive