Rev 293 | Rev 318 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
280 | agaran | 1 | #!/usr/bin/perl -w |
2 | use strict; |
||
293 | agaran | 3 | # $Id: inventory.pl 313 2008-12-28 23:03:20Z agaran $ |
280 | agaran | 4 | # Thu, 13 Nov 2008 21:06:23 +0100 |
5 | # Maciej 'agaran' Pijanka <agaran@pld-linux.org> |
||
6 | # for OpenARM SBC Project |
||
7 | # license: gpl v3 |
||
8 | |||
293 | agaran | 9 | |
280 | agaran | 10 | use Getopt::Long qw//; |
293 | agaran | 11 | use File::Basename qw/basename/; |
280 | agaran | 12 | |
313 | agaran | 13 | my %Config; |
280 | agaran | 14 | |
313 | agaran | 15 | # ================================================== |
16 | $Config{docdir} = '.'; |
||
17 | $Config{bomdir} = '.'; |
||
18 | $Config{verbose} = 1; |
||
280 | agaran | 19 | |
313 | agaran | 20 | # 0 mean not show, -1 show all, positive value limits depth of shown |
21 | $Config{dbg_showdirs} = 0; |
||
280 | agaran | 22 | |
313 | agaran | 23 | |
24 | # modes |
||
25 | my $build_inventory = 0; |
||
26 | my $build_bom = 0; |
||
27 | my $show_conf = 0; |
||
28 | my $show_help = 0; |
||
29 | |||
30 | # ================================================== |
||
31 | |||
32 | my %Inv_By_PartNo; |
||
33 | my @Inv; |
||
34 | |||
293 | agaran | 35 | sub err_printf($@) { |
36 | my ($format, @args) = @_; |
||
280 | agaran | 37 | |
313 | agaran | 38 | printf STDERR "-E- ".$format."\n", @args; |
39 | # exit? or fail-exit here |
||
280 | agaran | 40 | } |
41 | |||
293 | agaran | 42 | sub wrn_printf($@) { |
43 | my ($format, @args) = @_; |
||
44 | |||
45 | printf STDERR "-W- ".$format."\n", @args; |
||
46 | } |
||
47 | |||
48 | sub inf_printf($@) { |
||
49 | my ($format, @args) = @_; |
||
50 | |||
51 | printf STDERR "-I- ".$format."\n", @args; |
||
52 | } |
||
53 | |||
313 | agaran | 54 | sub Config_Show { |
55 | printf "Config for %s\n----------------------------------------\n", basename($0); |
||
56 | foreach my $name (sort keys %Config) { |
||
57 | printf "%-20s %s\n", $name, $Config{$name}; |
||
58 | } |
||
59 | } |
||
60 | |||
61 | sub Help_Show { |
||
62 | printf "Help for %s\n----------------------------------------\n", basename($0); |
||
63 | unless (defined($_[1]) && length($_[1]) != 0) { |
||
64 | print "Basic help\n\t--showrc|showconf shows current configuration\n". |
||
65 | "\t--docdir|-d <dir> tells script where information.txt files should be searched\n". |
||
66 | "\t--define <something>=<somethingelseornot> defines some configration value\n". |
||
67 | "\t--verbose|-v [level] sets verbosity level\nOrder of options DOES matter\n"; |
||
68 | return; |
||
69 | } |
||
70 | if ($_[1] =~ /^foo$/) { |
||
71 | print "Noo, there is no foo's here\n"; |
||
72 | } else { |
||
73 | printf "Sorry, help for `%s' don't exist (eventually) yet\n", $_[1]; |
||
74 | } |
||
75 | exit; |
||
76 | } |
||
77 | |||
78 | sub fix_dir ($) { |
||
79 | my $dir = shift @_; |
||
80 | |||
81 | $dir =~ s/\/$//; |
||
82 | |||
83 | if (! -d $dir) { |
||
84 | err_printf("Sorry `%s' is not valid directory, exiting", $dir); |
||
85 | } |
||
86 | |||
87 | return $dir; |
||
88 | } |
||
89 | |||
90 | sub shortdir ($) { |
||
91 | my $path = shift @_; |
||
92 | |||
93 | return substr($path, 2) if ($path =~ /^\.\//) ; |
||
94 | return $path; |
||
95 | } |
||
96 | |||
97 | |||
98 | sub trim($) { |
||
99 | my ($value) = @_; |
||
100 | |||
101 | $value =~ s/^ +//; |
||
102 | $value =~ s/ +$//; |
||
103 | return $value; |
||
104 | } |
||
105 | |||
106 | sub etrim($) { |
||
107 | my ($value) = @_; |
||
108 | |||
109 | $value =~ s/^[ ]+//; |
||
110 | $value =~ s/[ ]+$//; |
||
111 | return $value; |
||
112 | } |
||
113 | |||
114 | # this subroutine is used as callback function |
||
115 | # executed by file_lookup |
||
280 | agaran | 116 | sub parse_ifile($) { |
293 | agaran | 117 | my ($filepath) = @_; |
280 | agaran | 118 | |
293 | agaran | 119 | open(IN, $filepath) or return 1; |
280 | agaran | 120 | |
293 | agaran | 121 | my %data; |
280 | agaran | 122 | |
293 | agaran | 123 | while (not eof IN) { |
124 | my $line = <IN>; |
||
280 | agaran | 125 | |
293 | agaran | 126 | chomp $line; |
280 | agaran | 127 | |
293 | agaran | 128 | next if ($line =~ /^[ ]*$/); |
129 | next if ($line =~ /^;/); |
||
130 | |||
131 | last if ($line =~ /^--/); |
||
132 | |||
133 | if ($line =~ /^([A-Za-z ]+):(.*)$/) { |
||
313 | agaran | 134 | my ($name,$value) = (lc etrim($1),etrim($2)); |
293 | agaran | 135 | |
136 | if ($name =~ /^price$/) { |
||
137 | $value =~ s/[^0-9\.\,]//g; |
||
138 | if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) { |
||
139 | # printf STDERR "Price %.3f\n", $value; |
||
140 | if (!defined($data{price})) { |
||
141 | $data{price} = $value; |
||
142 | } else { |
||
313 | agaran | 143 | wrn_printf("Duplicated price field in file %s", shortdir($filepath)); |
293 | agaran | 144 | } |
145 | } else { |
||
313 | agaran | 146 | err_printf("Bad price field in file %s", shortdir($filepath)); |
293 | agaran | 147 | } |
148 | } elsif ($name =~ /^manufacturer$/i) { |
||
149 | # printf STDERR "Manufacturer %s\n", $value; |
||
150 | if (!defined($data{manufacturer})) { |
||
151 | $data{manufacturer} = $value; |
||
152 | } else { |
||
313 | agaran | 153 | wrn_printf("Duplicated manufacturer field in file %s", shortdir($filepath)); |
293 | agaran | 154 | } |
155 | } elsif ($name =~ /^manufacturer part no$/ ) { |
||
156 | # printf STDERR "ManPartNo %s\n", $value; |
||
157 | if (!defined($data{manufact_partno})) { |
||
313 | agaran | 158 | $data{manufact_partno} = trim($value); |
293 | agaran | 159 | } else { |
160 | wrn_printf("Duplicated manufacturer part no field in file %s", |
||
313 | agaran | 161 | shortdir($filepath)); |
293 | agaran | 162 | } |
163 | } elsif ($name =~ /^description$/i) { |
||
313 | agaran | 164 | if (!defined($data{desc})) { |
165 | $data{desc} = $value; |
||
166 | } else { |
||
167 | wrn_printf("Duplicated description no field in file %s", |
||
168 | shortdir($filepath)); |
||
169 | } |
||
293 | agaran | 170 | } elsif ($name =~ /^datasheet$/i) { |
171 | $data{datasheet} = [] unless defined $data{datasheet}; |
||
172 | push @{$data{datasheet}}, $value; |
||
173 | # printf STDERR "Datasheet %s\n", $value; |
||
174 | } elsif ($name =~ /^supplier$/i) { |
||
175 | # printf STDERR "Supplier %s\n", $value; |
||
176 | if (!defined($data{supplier})) { |
||
177 | $data{supplier} = $value; |
||
178 | } else { |
||
179 | wrn_printf("Duplicated supplier field in file %s", |
||
313 | agaran | 180 | shortdir($filepath)); |
293 | agaran | 181 | } |
182 | } elsif ($name =~ /^order code$/) { |
||
183 | # printf STDERR "Order Code %s\n", $value; |
||
184 | if (!defined($data{ordercode})) { |
||
185 | $data{ordercode} = $value; |
||
186 | } else { |
||
187 | wrn_printf("Duplicated order code field in file %s", |
||
313 | agaran | 188 | shortdir($filepath)); |
293 | agaran | 189 | } |
190 | #push @DATA, { $name => $value }; |
||
191 | } elsif ($name =~ /^url .*$/) { |
||
192 | # printf STDERR "URL %s\n", $value; |
||
193 | } elsif ($name =~ /^catalog(ue|) page$/) { |
||
194 | # printf STDERR "Catalogue Page %s\n", $value; |
||
195 | } else { |
||
196 | err_printf("Unhandled field %s in file %s", $name, |
||
313 | agaran | 197 | shortdir($filepath)); |
293 | agaran | 198 | } |
199 | |||
200 | } else { |
||
201 | wrn_printf("Unparseable line `%s', forgot ; to set it as comment in file %s\n", $line, |
||
313 | agaran | 202 | shortdir($filepath)); |
293 | agaran | 203 | } |
204 | } |
||
205 | close(IN); |
||
206 | |||
207 | if (scalar keys %data == 0) { |
||
208 | inf_printf("Skipping file %s because contain no data for me", |
||
313 | agaran | 209 | shortdir($filepath)); |
293 | agaran | 210 | return; |
211 | } |
||
212 | |||
213 | unless (defined ($data{price}) && $data{price} != 0) { |
||
214 | wrn_printf("Missing Price in file %s", |
||
313 | agaran | 215 | shortdir($filepath)); |
293 | agaran | 216 | } |
217 | |||
218 | unless (defined($data{manufact_partno})) { |
||
219 | inf_printf("Missing Manufacturer Part No in file %s", |
||
313 | agaran | 220 | shortdir($filepath)); |
293 | agaran | 221 | } |
222 | |||
223 | unless (defined($data{ordercode})) { |
||
224 | wrn_printf("Missing Order Code in file %s", |
||
313 | agaran | 225 | shortdir($filepath)); |
293 | agaran | 226 | } |
227 | |||
313 | agaran | 228 | |
293 | agaran | 229 | use Data::Dumper qw/Dumper/; |
313 | agaran | 230 | |
231 | my $id = scalar @Inv; |
||
232 | |||
233 | $Inv[$id] = {}; |
||
234 | |||
235 | $Inv[$id]{Datasheet} = delete $data{'datasheet'} if defined $data{'datasheet'}; |
||
236 | $Inv[$id]{Manufacturer} = delete $data{'manufacturer'} if defined $data{'manufacturer'}; |
||
237 | $Inv[$id]{Description} = delete $data{'desc'} if defined $data{'desc'}; |
||
238 | $Inv[$id]{Price} = delete $data{'price'} if defined $data{'price'}; |
||
239 | $Inv[$id]{Ordercode} = delete $data{'ordercode'} if defined $data{'ordercode'}; |
||
240 | $Inv[$id]{Manufacturer_Partno} = delete $data{'manufact_partno'} if defined $data{'manufact_partno'}; |
||
241 | $Inv[$id]{Supplier} = delete $data{'supplier'} if defined $data{'supplier'}; |
||
242 | |||
243 | unless (defined ($Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno}})) { |
||
244 | $Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno}} = $id; |
||
245 | } else { |
||
246 | wrn_printf("PartNumber %s happened more than once, using first occurence (id:%d)", |
||
247 | $Inv[$id]{Manufacturer_Partno}, $id); |
||
248 | } |
||
249 | #inf_printf("Part %s defined in file %s", $Inv[$id]{Manufacturer_Partno}, shortdir($filepath)); |
||
293 | agaran | 250 | |
313 | agaran | 251 | wrn_printf("Unhandled data from parsing: %s", Dumper(\%data)) if (scalar keys %data > 0); |
280 | agaran | 252 | } |
253 | |||
254 | |||
313 | agaran | 255 | my %BomData; |
256 | sub parse_bom ($) { |
||
257 | my ($filepath) = @_; |
||
280 | agaran | 258 | |
313 | agaran | 259 | open(IN, $filepath) or return 1; |
260 | |||
261 | #wrn_printf("GotARg: %s", shortdir($filepath)); |
||
262 | |||
263 | my @Fields; |
||
264 | |||
265 | my %data; |
||
266 | my $v = ''; |
||
267 | while (not eof IN) { |
||
268 | my $line = <IN>; |
||
269 | |||
270 | chomp $line; |
||
271 | |||
272 | if ($line =~ /^\.START$/) { |
||
273 | $v = 'boms'; |
||
274 | next; |
||
275 | } |
||
276 | |||
277 | if ($line =~ /^\.END$/) { |
||
278 | $v = ''; |
||
279 | next; |
||
280 | } |
||
281 | |||
282 | if ($v eq 'boms') { |
||
283 | @Fields = split(/\t/, substr($line,2)); |
||
284 | $v = 'bom'; |
||
285 | # some funny way to generate field-map |
||
286 | # that if someone reorder bom file columns we are still on place |
||
287 | next; |
||
288 | } |
||
289 | |||
290 | if ($v eq 'bom') { |
||
291 | my ($refdes, $device, $value, $footprint, $quantity) = split (/\t/, $line); |
||
292 | |||
293 | $device = trim($device); |
||
294 | |||
295 | # wrn_printf("Device: %s (value: %s) at refdes %s, %d pcs", $device, $value, $refdes, $quantity); |
||
296 | |||
297 | if (!defined $Inv_By_PartNo{$device}) { |
||
298 | wrn_printf("Device %s not found in inventory in file %s", $device, shortdir($filepath)); |
||
299 | next; |
||
300 | } |
||
301 | my $id = $Inv_By_PartNo{$device}; |
||
302 | next if ($Inv[$id]{Manufacturer} =~ /none/i); # skip parts whose manufacturer is none |
||
303 | #inf_printf("Found in Inventory at %d %s", $id, $Inv[$id]{Manufacturer_Partno}); |
||
304 | push @{$data{$id}{RefDes}}, $refdes; |
||
305 | } |
||
306 | } |
||
307 | close(IN); |
||
308 | |||
309 | if (scalar keys %data == 0) { |
||
310 | inf_printf("Skipping file %s because contain no data for me", |
||
311 | shortdir($filepath)); |
||
312 | return; |
||
313 | } |
||
314 | |||
315 | my $cost = 0; |
||
316 | foreach my $id (keys %data) { |
||
317 | my %tmp; |
||
318 | map { $tmp{$_} = 1 } @{$data{$id}{RefDes}}; |
||
319 | @{$data{$id}{RefDes}} = keys %tmp; |
||
320 | my $cnt = scalar @{$data{$id}{RefDes}}; |
||
321 | if (!defined $Inv[$id]{Price}) { |
||
322 | wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno}); |
||
323 | $Inv[$id]{Price} = 0; |
||
324 | } |
||
325 | my $icost = $Inv[$id]{Price} * $cnt; |
||
326 | # printf "%-20s %.4f %s\n", $Inv[$id]{Manufacturer_Partno}, $cnt, $icost, join (', ', @{$data{$id}{RefDes}}); |
||
327 | $cost += $icost; |
||
328 | # %BomData{ById}{$id}{RefDes} |
||
329 | } |
||
330 | printf "Total (%s): %.4f\n", shortdir($filepath), $cost; |
||
331 | } |
||
332 | |||
333 | sub file_lookup ($$$$) ; |
||
334 | sub file_lookup ($$$$) { |
||
335 | my ($dir, $depth, $regexp, $callback) = @_; |
||
336 | |||
337 | err_printf("Sorry, callback must be CODE ref") unless (ref $callback eq 'CODE'); |
||
338 | |||
293 | agaran | 339 | if ( -d $dir) { |
340 | opendir(DIR, $dir) or return 1; |
||
341 | foreach my $e (readdir(DIR)) { |
||
342 | my $fe = $dir .'/'. $e; |
||
343 | if ( -f $fe) { |
||
313 | agaran | 344 | if ($fe =~ $regexp) { |
345 | &$callback($fe); |
||
293 | agaran | 346 | } |
347 | } elsif (-d $fe) { # now its dir... |
||
348 | if ($e eq '.svn') { # if entry name is equal to svn |
||
349 | next; # go to next entry in foreach loop |
||
350 | } |
||
351 | next if ($e eq '.' or $e eq '..'); # skip to next if dir entry is . or .. |
||
281 | jelle | 352 | |
313 | agaran | 353 | if ($Config{dbg_showdirs} == -1 or $Config{dbg_showdirs} > $depth) { |
354 | printf STDERR "Entering directory %s\n", shortdir($fe); |
||
293 | agaran | 355 | } |
313 | agaran | 356 | return 1 if (file_lookup($fe, $depth+1, $regexp, $callback) == 1); |
293 | agaran | 357 | } else { |
313 | agaran | 358 | # symlink or other mysterius beast |
293 | agaran | 359 | } |
360 | } |
||
361 | closedir(DIR); |
||
362 | } |
||
313 | agaran | 363 | return 0; |
280 | agaran | 364 | } |
365 | |||
293 | agaran | 366 | Getopt::Long::Configure("bundling"); |
280 | agaran | 367 | |
313 | agaran | 368 | my $result = Getopt::Long::GetOptions ( |
369 | "showrc|showconf" => sub { $show_conf = 1 }, |
||
370 | "docdir|d=s" => sub { $Config{docdir} = $_[1]; }, |
||
371 | # not sure if bomdir or SCH dir |
||
372 | "bomdir|b=s" => sub { $Config{$_[0]} = $_[1]; }, # $_[0] contain basename of option, so in few cases could be (ab)used |
||
373 | "define|D=s" => sub { my ($p,$q) = split(/=/,$_[1],2); $Config{$p} = $q; }, |
||
374 | "verbose|v:+" => sub { $Config{$_[0]} = ($_[1]>1?0:$Config{$_[0]}) + $_[1]; }, |
||
375 | "help|h|?:s" => sub { $show_help = 1 }, |
||
376 | |||
377 | # options |
||
293 | agaran | 378 | ); |
379 | if (!$result) { |
||
380 | printf "Usage: %s [-d directory] [-v]\n",basename($0); |
||
381 | exit; |
||
382 | } |
||
313 | agaran | 383 | |
384 | # ================================================== |
||
385 | # processing of options/config values, checking ranges etc |
||
386 | # |
||
387 | |||
388 | $Config{docdir} = fix_dir ($Config{docdir}); |
||
389 | $Config{bomdir} = fix_dir ($Config{bomdir}); |
||
390 | |||
391 | if ( $show_help == 1) { |
||
392 | Help_Show(); |
||
393 | exit; |
||
293 | agaran | 394 | } |
395 | |||
313 | agaran | 396 | if ( $show_conf == 1) { |
397 | Config_Show(); |
||
398 | exit; |
||
399 | } |
||
293 | agaran | 400 | |
313 | agaran | 401 | # make Inventory |
402 | file_lookup($Config{docdir}, 0, qr/\/information.txt$/, \&parse_ifile); |
||
403 | |||
404 | # process BOM files |
||
405 | file_lookup($Config{bomdir}, 0, qr/\.bom$/, \&parse_bom); |
||
406 |