Rev 419 | 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 428 2009-07-15 21:37:16Z 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 | |||
9 | use Getopt::Long qw//; |
||
293 | agaran | 10 | use File::Basename qw/basename/; |
322 | agaran | 11 | use IO::Dir; |
12 | use IO::File; |
||
417 | agaran | 13 | use Data::Dumper qw/Dumper/; |
280 | agaran | 14 | |
325 | agaran | 15 | use lib File::Basename::dirname($0).'/lib'; |
326 | agaran | 16 | use Text::Table; |
325 | agaran | 17 | |
18 | |||
313 | agaran | 19 | my %Config; |
280 | agaran | 20 | |
419 | agaran | 21 | # ===[ SETUP DEFAULTS ]============================= |
313 | agaran | 22 | $Config{docdir} = '.'; |
23 | $Config{bomdir} = '.'; |
||
24 | $Config{verbose} = 1; |
||
280 | agaran | 25 | |
313 | agaran | 26 | # 0 mean not show, -1 show all, positive value limits depth of shown |
27 | $Config{dbg_showdirs} = 0; |
||
280 | agaran | 28 | |
313 | agaran | 29 | |
30 | # modes |
||
31 | my $show_conf = 0; |
||
32 | my $show_help = 0; |
||
33 | |||
34 | # ================================================== |
||
35 | |||
36 | my %Inv_By_PartNo; |
||
37 | my @Inv; |
||
325 | agaran | 38 | my %BomData; |
332 | agaran | 39 | my %Files; |
419 | agaran | 40 | my ($file_name, $file_line); |
313 | agaran | 41 | |
293 | agaran | 42 | sub err_printf($@) { |
43 | my ($format, @args) = @_; |
||
280 | agaran | 44 | |
419 | agaran | 45 | if (defined $file_name && defined $file_line) { |
46 | $format = '(%s:%d) '.$format; |
||
47 | unshift @args, shortdir($file_name), $file_line; |
||
48 | } |
||
49 | |||
313 | agaran | 50 | printf STDERR "-E- ".$format."\n", @args; |
51 | # exit? or fail-exit here |
||
280 | agaran | 52 | } |
53 | |||
293 | agaran | 54 | sub wrn_printf($@) { |
55 | my ($format, @args) = @_; |
||
328 | agaran | 56 | return if ($Config{verbose} <= 1) ; |
419 | agaran | 57 | |
58 | if (defined $file_name && defined $file_line) { |
||
59 | $format = '(%s:%d) '.$format; |
||
60 | unshift @args, shortdir($file_name), $file_line; |
||
61 | } |
||
62 | |||
293 | agaran | 63 | printf STDERR "-W- ".$format."\n", @args; |
64 | } |
||
65 | |||
66 | sub inf_printf($@) { |
||
67 | my ($format, @args) = @_; |
||
328 | agaran | 68 | return if ($Config{verbose} <= 2) ; |
419 | agaran | 69 | |
70 | if (defined $file_name && defined $file_line) { |
||
71 | $format = '(%s:%d) '.$format; |
||
72 | unshift @args, shortdir($file_name), $file_line; |
||
73 | } |
||
74 | |||
293 | agaran | 75 | printf STDERR "-I- ".$format."\n", @args; |
76 | } |
||
77 | |||
419 | agaran | 78 | sub nfo_printf($@) { |
79 | my ($format, @args) = @_; |
||
80 | |||
81 | return if ($Config{verbose} <= 0) ; |
||
82 | |||
83 | if (defined $file_name && defined $file_line) { |
||
84 | $format = '(%s:%d) '.$format; |
||
85 | unshift @args, shortdir($file_name), $file_line; |
||
86 | } |
||
87 | |||
88 | printf STDERR "-N- ".$format."\n", @args; |
||
89 | # exit? or fail-exit here |
||
90 | } |
||
91 | |||
92 | |||
93 | |||
313 | agaran | 94 | sub Config_Show { |
95 | printf "Config for %s\n----------------------------------------\n", basename($0); |
||
96 | foreach my $name (sort keys %Config) { |
||
97 | printf "%-20s %s\n", $name, $Config{$name}; |
||
98 | } |
||
99 | } |
||
100 | |||
101 | sub Help_Show { |
||
102 | printf "Help for %s\n----------------------------------------\n", basename($0); |
||
103 | unless (defined($_[1]) && length($_[1]) != 0) { |
||
104 | print "Basic help\n\t--showrc|showconf shows current configuration\n". |
||
105 | "\t--docdir|-d <dir> tells script where information.txt files should be searched\n". |
||
106 | "\t--define <something>=<somethingelseornot> defines some configration value\n". |
||
419 | agaran | 107 | "\t--verbose|-v [level] increases or sets verbosity level\nOrder of options DOES matter\n". |
330 | agaran | 108 | "\t--bomdir|-b <dir> tells script where boms should be searched\n". |
331 | agaran | 109 | "\t--outfile|-o <file> tells where script shall save output data\n". |
337 | agaran | 110 | "\t--force|-f forces script to save data even if file exist already\n". |
111 | "\t-l <num> repeat title for output tables every <num> rows\n"; |
||
319 | agaran | 112 | |
113 | print "\t\e[0;31mThis Help Is created especially for \e[0;33mJelle\e[0;29m\n". |
||
114 | "\tThis script search all directories below specified ones to find interesting files\n"; |
||
313 | agaran | 115 | return; |
116 | } |
||
117 | if ($_[1] =~ /^foo$/) { |
||
118 | print "Noo, there is no foo's here\n"; |
||
119 | } else { |
||
120 | printf "Sorry, help for `%s' don't exist (eventually) yet\n", $_[1]; |
||
121 | } |
||
122 | exit; |
||
123 | } |
||
124 | |||
125 | sub fix_dir ($) { |
||
126 | my $dir = shift @_; |
||
127 | |||
128 | $dir =~ s/\/$//; |
||
129 | |||
130 | if (! -d $dir) { |
||
131 | err_printf("Sorry `%s' is not valid directory, exiting", $dir); |
||
132 | } |
||
133 | |||
134 | return $dir; |
||
135 | } |
||
136 | |||
137 | sub shortdir ($) { |
||
138 | my $path = shift @_; |
||
139 | |||
140 | return substr($path, 2) if ($path =~ /^\.\//) ; |
||
141 | return $path; |
||
142 | } |
||
143 | |||
144 | |||
145 | sub trim($) { |
||
146 | my ($value) = @_; |
||
147 | |||
148 | $value =~ s/^ +//; |
||
149 | $value =~ s/ +$//; |
||
150 | return $value; |
||
151 | } |
||
152 | |||
153 | sub etrim($) { |
||
154 | my ($value) = @_; |
||
155 | |||
156 | $value =~ s/^[ ]+//; |
||
157 | $value =~ s/[ ]+$//; |
||
158 | return $value; |
||
159 | } |
||
160 | |||
428 | agaran | 161 | # break string at $lim character (or bit before) |
162 | # but only on whitespaces |
||
330 | agaran | 163 | sub strbreak($$) { |
325 | agaran | 164 | my ($str,$lim) = @_; |
334 | agaran | 165 | my @p = split /\ /,$str; |
330 | agaran | 166 | $str = ''; |
167 | my $l = 0; |
||
168 | while (@p) { |
||
169 | my $e = shift @p; |
||
170 | if ($l + length ($e) +1 > $lim) { |
||
171 | $str .= "\n".$e; |
||
172 | $l = length $e; |
||
173 | } else { |
||
174 | $str .= " ".$e; |
||
175 | $l += length($e) + 1; |
||
176 | } |
||
177 | } |
||
325 | agaran | 178 | return $str; |
179 | } |
||
180 | |||
417 | agaran | 181 | # this function return price of single item |
182 | # quantity is needed to cope with quantity-based prices |
||
183 | sub get_price($$) { |
||
184 | my ($id, $quantity) = @_; |
||
185 | |||
186 | if (!defined $Inv[$id]{Price}) { |
||
187 | wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno}); |
||
188 | return 0.0; |
||
189 | } |
||
190 | |||
191 | if (ref $Inv[$id]{Price} eq 'ARRAY') { # handle structured prices |
||
428 | agaran | 192 | my ($ret,$li) = (0,0); |
417 | agaran | 193 | foreach my $pd (@{$Inv[$id]{Price}}) { |
194 | if (ref $pd eq 'ARRAY') { |
||
195 | my ($rmin,$rmax) = split '-', $pd->[0]; |
||
428 | agaran | 196 | if ($rmin > $li && $quantity >= $rmin) { |
197 | $ret = $pd->[1]; |
||
198 | $li = $rmin; |
||
199 | } |
||
200 | #inf_printf("Debuging %s, %s %d",$pd->[0], $ret, $quantity); |
||
417 | agaran | 201 | } |
202 | } |
||
203 | return $ret; |
||
204 | } |
||
205 | |||
206 | return $Inv[$id]{Price}; |
||
207 | } |
||
208 | |||
209 | |||
210 | |||
313 | agaran | 211 | # this subroutine is used as callback function |
212 | # executed by file_lookup |
||
280 | agaran | 213 | sub parse_ifile($) { |
293 | agaran | 214 | my ($filepath) = @_; |
280 | agaran | 215 | |
293 | agaran | 216 | open(IN, $filepath) or return 1; |
280 | agaran | 217 | |
293 | agaran | 218 | my %data; |
280 | agaran | 219 | |
419 | agaran | 220 | $file_name = $filepath; |
221 | $file_line = 0; |
||
222 | |||
417 | agaran | 223 | my $_ok; |
224 | |||
293 | agaran | 225 | while (not eof IN) { |
226 | my $line = <IN>; |
||
419 | agaran | 227 | $file_line++; |
280 | agaran | 228 | |
293 | agaran | 229 | chomp $line; |
280 | agaran | 230 | |
293 | agaran | 231 | next if ($line =~ /^[ ]*$/); |
232 | next if ($line =~ /^;/); |
||
233 | |||
234 | last if ($line =~ /^--/); |
||
235 | |||
236 | if ($line =~ /^([A-Za-z ]+):(.*)$/) { |
||
313 | agaran | 237 | my ($name,$value) = (lc etrim($1),etrim($2)); |
293 | agaran | 238 | |
239 | if ($name =~ /^price$/) { |
||
417 | agaran | 240 | $value =~ s/[^0-9\.\,]//g; # remove any characters beside DIGITS |
293 | agaran | 241 | if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) { |
242 | # printf STDERR "Price %.3f\n", $value; |
||
243 | if (!defined($data{price})) { |
||
244 | $data{price} = $value; |
||
417 | agaran | 245 | $_ok->{$name} = 1; |
293 | agaran | 246 | } else { |
419 | agaran | 247 | wrn_printf("Duplicated price field."); |
293 | agaran | 248 | } |
249 | } else { |
||
419 | agaran | 250 | err_printf("Bad data in price field."); |
293 | agaran | 251 | } |
252 | } elsif ($name =~ /^manufacturer$/i) { |
||
253 | # printf STDERR "Manufacturer %s\n", $value; |
||
254 | if (!defined($data{manufacturer})) { |
||
255 | $data{manufacturer} = $value; |
||
417 | agaran | 256 | $_ok->{$name} = 1; |
293 | agaran | 257 | } else { |
419 | agaran | 258 | wrn_printf("Duplicated manufacturer field."); |
293 | agaran | 259 | } |
260 | } elsif ($name =~ /^manufacturer part no$/ ) { |
||
261 | # printf STDERR "ManPartNo %s\n", $value; |
||
262 | if (!defined($data{manufact_partno})) { |
||
313 | agaran | 263 | $data{manufact_partno} = trim($value); |
417 | agaran | 264 | $_ok->{$name} = 1; |
293 | agaran | 265 | } else { |
419 | agaran | 266 | wrn_printf("Duplicated manufacturer part no field."); |
293 | agaran | 267 | } |
268 | } elsif ($name =~ /^description$/i) { |
||
313 | agaran | 269 | if (!defined($data{desc})) { |
270 | $data{desc} = $value; |
||
271 | } else { |
||
419 | agaran | 272 | wrn_printf("Duplicated description no field."); |
313 | agaran | 273 | } |
293 | agaran | 274 | } elsif ($name =~ /^datasheet$/i) { |
275 | $data{datasheet} = [] unless defined $data{datasheet}; |
||
276 | push @{$data{datasheet}}, $value; |
||
277 | # printf STDERR "Datasheet %s\n", $value; |
||
278 | } elsif ($name =~ /^supplier$/i) { |
||
279 | # printf STDERR "Supplier %s\n", $value; |
||
280 | if (!defined($data{supplier})) { |
||
281 | $data{supplier} = $value; |
||
417 | agaran | 282 | $_ok->{$name} = 1; |
293 | agaran | 283 | } else { |
419 | agaran | 284 | wrn_printf("Duplicated supplier field."); |
293 | agaran | 285 | } |
286 | } elsif ($name =~ /^order code$/) { |
||
287 | if (!defined($data{ordercode})) { |
||
288 | $data{ordercode} = $value; |
||
417 | agaran | 289 | $_ok->{$name} = 1; |
293 | agaran | 290 | } else { |
419 | agaran | 291 | wrn_printf("Duplicated order code field."); |
293 | agaran | 292 | } |
293 | #push @DATA, { $name => $value }; |
||
294 | } elsif ($name =~ /^url .*$/) { |
||
295 | # printf STDERR "URL %s\n", $value; |
||
296 | } elsif ($name =~ /^catalog(ue|) page$/) { |
||
297 | # printf STDERR "Catalogue Page %s\n", $value; |
||
298 | } else { |
||
419 | agaran | 299 | err_printf("Unhandled field type `%s'.",$name); |
293 | agaran | 300 | } |
417 | agaran | 301 | } elsif ($line =~ /^([A-Za-z ]+)[ \t]*\(([A-Za-z 0-9\(\)\-]+)\)[ \t]*:(.*)$/) { |
302 | my ($name, $extdata, $value) = (lc etrim($1),etrim($2),etrim($3)); |
||
303 | if ($name =~ /^price$/) { |
||
304 | $extdata =~ s/ //g; |
||
428 | agaran | 305 | #wrn_printf("Extended-Price <%s> <%s> at %s:%d", $extdata, $value, shortdir($filepath), $file_line); |
417 | agaran | 306 | $data{price} = [] if (!defined $data{price}); |
293 | agaran | 307 | |
417 | agaran | 308 | if(ref $data{price} eq 'ARRAY') { |
309 | $value =~ s/[^0-9\.\,]//g; # remove any characters beside DIGITS |
||
310 | if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) { |
||
311 | push @{$data{price}}, [ $extdata, $value ]; |
||
312 | $_ok->{$name} = 1; |
||
313 | } else { |
||
419 | agaran | 314 | err_printf("Bad extended price field."); |
417 | agaran | 315 | } |
316 | } |
||
317 | } else { |
||
419 | agaran | 318 | wrn_printf("Unrecognized extended data `%s'.", $name); |
417 | agaran | 319 | } |
293 | agaran | 320 | } else { |
419 | agaran | 321 | wrn_printf("Unparseable line, is it an comment?"); |
293 | agaran | 322 | } |
323 | } |
||
324 | close(IN); |
||
325 | |||
326 | if (scalar keys %data == 0) { |
||
419 | agaran | 327 | inf_printf("No data for me, skipping."); |
293 | agaran | 328 | return; |
329 | } |
||
330 | |||
417 | agaran | 331 | foreach my $field (split /\!/, q/price!manufacturer part no!order code/) { |
419 | agaran | 332 | wrn_printf("Missing required field `".(ucfirst $field)."'.") unless ($_ok->{$field}); |
293 | agaran | 333 | } |
313 | agaran | 334 | |
335 | |||
336 | my $id = scalar @Inv; |
||
337 | |||
338 | $Inv[$id] = {}; |
||
339 | |||
340 | $Inv[$id]{Datasheet} = delete $data{'datasheet'} if defined $data{'datasheet'}; |
||
334 | agaran | 341 | $Inv[$id]{Manufacturer} = etrim(trim(delete $data{'manufacturer'})) if defined $data{'manufacturer'}; |
342 | $Inv[$id]{Description} = etrim(trim(delete $data{'desc'})) if defined $data{'desc'}; |
||
313 | agaran | 343 | $Inv[$id]{Price} = delete $data{'price'} if defined $data{'price'}; |
334 | agaran | 344 | $Inv[$id]{Ordercode} = etrim(trim(delete $data{'ordercode'})) if defined $data{'ordercode'}; |
345 | $Inv[$id]{Manufacturer_Partno} = etrim(trim(delete $data{'manufact_partno'})) if defined $data{'manufact_partno'}; |
||
313 | agaran | 346 | $Inv[$id]{Supplier} = delete $data{'supplier'} if defined $data{'supplier'}; |
347 | |||
348 | unless (defined ($Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno}})) { |
||
349 | $Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno}} = $id; |
||
350 | } else { |
||
351 | wrn_printf("PartNumber %s happened more than once, using first occurence (id:%d)", |
||
352 | $Inv[$id]{Manufacturer_Partno}, $id); |
||
353 | } |
||
325 | agaran | 354 | |
313 | agaran | 355 | #inf_printf("Part %s defined in file %s", $Inv[$id]{Manufacturer_Partno}, shortdir($filepath)); |
293 | agaran | 356 | |
419 | agaran | 357 | wrn_printf("Bug in parser, please report: %s", Dumper(\%data)) if (scalar keys %data > 0); |
280 | agaran | 358 | } |
359 | |||
360 | |||
313 | agaran | 361 | sub parse_bom ($) { |
362 | my ($filepath) = @_; |
||
280 | agaran | 363 | |
313 | agaran | 364 | open(IN, $filepath) or return 1; |
332 | agaran | 365 | my $fkey = substr(basename($filepath),0,length(basename($filepath))-4); |
313 | agaran | 366 | |
419 | agaran | 367 | $file_name = $filepath; |
368 | $file_line = 0; |
||
369 | |||
313 | agaran | 370 | #wrn_printf("GotARg: %s", shortdir($filepath)); |
371 | |||
372 | my @Fields; |
||
373 | |||
374 | my %data; |
||
375 | my $v = ''; |
||
376 | while (not eof IN) { |
||
377 | my $line = <IN>; |
||
419 | agaran | 378 | $file_line++; |
313 | agaran | 379 | |
380 | chomp $line; |
||
381 | |||
382 | if ($line =~ /^\.START$/) { |
||
383 | $v = 'boms'; |
||
384 | next; |
||
385 | } |
||
386 | |||
387 | if ($line =~ /^\.END$/) { |
||
388 | $v = ''; |
||
389 | next; |
||
390 | } |
||
391 | |||
392 | if ($v eq 'boms') { |
||
393 | @Fields = split(/\t/, substr($line,2)); |
||
394 | $v = 'bom'; |
||
395 | # some funny way to generate field-map |
||
396 | # that if someone reorder bom file columns we are still on place |
||
397 | next; |
||
398 | } |
||
399 | |||
400 | if ($v eq 'bom') { |
||
401 | my ($refdes, $device, $value, $footprint, $quantity) = split (/\t/, $line); |
||
402 | |||
403 | $device = trim($device); |
||
404 | |||
405 | # wrn_printf("Device: %s (value: %s) at refdes %s, %d pcs", $device, $value, $refdes, $quantity); |
||
406 | |||
407 | if (!defined $Inv_By_PartNo{$device}) { |
||
419 | agaran | 408 | wrn_printf("Device %s not found in inventory.", $device); |
313 | agaran | 409 | next; |
410 | } |
||
411 | my $id = $Inv_By_PartNo{$device}; |
||
412 | next if ($Inv[$id]{Manufacturer} =~ /none/i); # skip parts whose manufacturer is none |
||
413 | #inf_printf("Found in Inventory at %d %s", $id, $Inv[$id]{Manufacturer_Partno}); |
||
334 | agaran | 414 | push @{$data{$id}{RefDes}}, etrim(trim($refdes)); |
330 | agaran | 415 | if (!defined $data{$id}{Footprint}) { |
416 | $data{$id}{Footprint} = $footprint; |
||
417 | } else { |
||
418 | if ($data{$id}{Footprint} ne $footprint) { |
||
419 | err_printf("Different footprints for same device in within single bom file, script ". |
||
420 | "cannot work around this, will use first one, but expect that output file ". |
||
421 | "might have errors."); |
||
422 | } |
||
423 | } |
||
313 | agaran | 424 | } |
425 | } |
||
426 | close(IN); |
||
427 | |||
428 | if (scalar keys %data == 0) { |
||
419 | agaran | 429 | inf_printf("No data for me, skipping."); |
313 | agaran | 430 | return; |
431 | } |
||
432 | |||
433 | foreach my $id (keys %data) { |
||
434 | my %tmp; |
||
435 | map { $tmp{$_} = 1 } @{$data{$id}{RefDes}}; |
||
436 | @{$data{$id}{RefDes}} = keys %tmp; |
||
437 | my $cnt = scalar @{$data{$id}{RefDes}}; |
||
318 | agaran | 438 | push @{$BomData{$id}{RefDes}}, @{$data{$id}{RefDes}}; |
330 | agaran | 439 | if (!defined $BomData{$id}{Footprint}) { |
440 | $BomData{$id}{Footprint} = $data{$id}{Footprint}; |
||
441 | } else { |
||
442 | if ($data{$id}{Footprint} ne $data{$id}{Footprint}) { |
||
443 | err_printf("Different footprints for same device between sheets, script cannot ". |
||
444 | "work around this, will use first one, but expect that output file might ". |
||
445 | "have errors."); |
||
446 | } |
||
447 | } |
||
332 | agaran | 448 | push @{$BomData{$id}{Files}}, $fkey; |
449 | push @{$Files{$fkey}{$id}{RefDes}}, @{$data{$id}{RefDes}}; |
||
318 | agaran | 450 | |
313 | agaran | 451 | # printf "%-20s %.4f %s\n", $Inv[$id]{Manufacturer_Partno}, $cnt, $icost, join (', ', @{$data{$id}{RefDes}}); |
452 | # %BomData{ById}{$id}{RefDes} |
||
453 | } |
||
454 | } |
||
455 | |||
456 | sub file_lookup ($$$$) ; |
||
419 | agaran | 457 | sub file_lookup ($$$$) { # {{{1 |
313 | agaran | 458 | my ($dir, $depth, $regexp, $callback) = @_; |
459 | |||
419 | agaran | 460 | err_printf("BUG: Sorry, callback must be CODE ref") unless (ref $callback eq 'CODE'); |
313 | agaran | 461 | |
293 | agaran | 462 | if ( -d $dir) { |
322 | agaran | 463 | my $d = IO::Dir->new($dir); |
464 | return 1 if (!defined $d); |
||
465 | |||
466 | |||
467 | while (defined(my $e = $d->read)) { |
||
293 | agaran | 468 | my $fe = $dir .'/'. $e; |
469 | if ( -f $fe) { |
||
313 | agaran | 470 | if ($fe =~ $regexp) { |
471 | &$callback($fe); |
||
419 | agaran | 472 | $file_name = undef; |
293 | agaran | 473 | } |
474 | } elsif (-d $fe) { # now its dir... |
||
475 | if ($e eq '.svn') { # if entry name is equal to svn |
||
476 | next; # go to next entry in foreach loop |
||
477 | } |
||
478 | next if ($e eq '.' or $e eq '..'); # skip to next if dir entry is . or .. |
||
281 | jelle | 479 | |
313 | agaran | 480 | if ($Config{dbg_showdirs} == -1 or $Config{dbg_showdirs} > $depth) { |
419 | agaran | 481 | $file_name = undef; |
482 | dbg_printf("Entering directory %s", shortdir($fe)); |
||
293 | agaran | 483 | } |
313 | agaran | 484 | return 1 if (file_lookup($fe, $depth+1, $regexp, $callback) == 1); |
293 | agaran | 485 | } else { |
313 | agaran | 486 | # symlink or other mysterius beast |
293 | agaran | 487 | } |
488 | } |
||
489 | } |
||
313 | agaran | 490 | return 0; |
419 | agaran | 491 | } # }}} |
280 | agaran | 492 | |
419 | agaran | 493 | sub gen_bomfile ($) { # {{{1 |
494 | my $outfile = shift @_; |
||
495 | |||
496 | if (-e $outfile) { |
||
428 | agaran | 497 | wrn_printf("File already exist, will overwrite"); |
419 | agaran | 498 | } |
499 | |||
500 | my $out = new IO::File $outfile, 'w'; |
||
501 | |||
502 | my $bomtable = Text::Table->new( |
||
503 | { title => '| ', is_sep => 1 }, |
||
504 | { title => 'id', align => 'right', align_title => 'left' }, |
||
505 | { title => ' | ', is_sep => 1 }, |
||
506 | { title => 'description', align => 'left', align_title => 'left' }, |
||
507 | { title => ' | ', is_sep => 1 }, |
||
508 | { title => 'manufacturer partid', align => 'left', align_title => 'left' }, |
||
509 | { title => ' | ', is_sep => 1 }, |
||
510 | { title => 'manufacturer', align => 'left', align_title => 'left' }, |
||
511 | { title => ' | ', is_sep => 1 }, |
||
512 | { title => 'order code', align => 'left', align_title => 'left' }, |
||
513 | { title => ' | ', is_sep => 1 }, |
||
514 | { title => 'quantity', align => 'right', align_title => 'left' }, |
||
515 | { title => ' | ', is_sep => 1 }, |
||
516 | { title => "price", align => 'right', align_title => 'left' }, |
||
517 | { title => ' | ', is_sep => 1 }, |
||
518 | { title => "cost", align => 'right', align_title => 'left' }, |
||
519 | { title => ' |', is_sep => 1 }, |
||
520 | ); |
||
521 | |||
522 | # counters |
||
523 | my ($bn,$totalcost,$partcount) = (1,0,0); |
||
524 | |||
525 | foreach my $id ( sort {my $p = $Inv[$a]{Manufacturer} cmp $Inv[$b]{Manufacturer}; if ($p == 0) { |
||
526 | # return $Inv[$a]{Manufacturer_Partno} cmp $Inv[$b]{Manufacturer_Partno}}; return $p; } keys %BomData) { |
||
527 | return $Inv[$a]{Description} cmp $Inv[$b]{Description}}; return $p; } keys %BomData) { |
||
528 | my %tmp; |
||
529 | |||
530 | map { $tmp{$_} = 1 } @{$BomData{$id}{RefDes}}; # duplicated refdes removal |
||
531 | @{$BomData{$id}{RefDes}} = keys %tmp; |
||
532 | |||
533 | my $quant = scalar @{$BomData{$id}{RefDes}}; # quantity based on number of refdes.. |
||
534 | |||
535 | my $price = get_price($id,$quant); |
||
536 | if ($price == 0) { |
||
537 | wrn_printf("%s has zero price", $Inv[$id]{Manufacturer_Partno}); |
||
538 | } |
||
539 | my $icost = $quant * $price; |
||
540 | |||
541 | $bomtable->add($bn++, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $Inv[$id]{Manufacturer}, |
||
542 | $Inv[$id]{Ordercode},$quant, sprintf("%.3f",$price), sprintf("%.3f", $icost)); |
||
543 | |||
544 | $totalcost += $icost; |
||
545 | $partcount += $quant; |
||
546 | } |
||
547 | |||
548 | printf $out "file generated at %s\n\n", scalar localtime(time()); |
||
549 | |||
550 | print $out $bomtable->rule('-','+'); |
||
551 | print $out $bomtable->title(); |
||
552 | print $out $bomtable->rule('-','+'); |
||
553 | |||
554 | # repeat header every NTH lines or not |
||
555 | unless (defined $Config{'lines'}) { |
||
556 | print $out $bomtable->body(); |
||
557 | } else { |
||
558 | my @p = split(/\n/,$bomtable->body()); |
||
559 | while (@p) { |
||
560 | my @sub = splice @p,0,$Config{'lines'}; |
||
561 | print $out join("\n",@sub)."\n"; |
||
562 | if (scalar @p > 0) { |
||
563 | print $out $bomtable->rule('-','+'); |
||
564 | print $out $bomtable->title(); |
||
565 | print $out $bomtable->rule('-','+'); |
||
566 | } |
||
567 | } |
||
568 | } |
||
569 | print $out $bomtable->rule('-','+'); |
||
570 | |||
571 | printf $out "\nTotal cost: %.3f\nTotal part count: %d\n\n", $totalcost, $partcount; |
||
572 | |||
573 | $out->close; |
||
574 | } # }}} |
||
575 | |||
576 | sub gen_mapfile ($) { # {{{1 |
||
577 | my $outfile = shift @_; |
||
578 | |||
579 | if (-e $outfile) { |
||
428 | agaran | 580 | wrn_printf("File already exist, will overwrite"); |
419 | agaran | 581 | } |
582 | |||
583 | my $out = new IO::File $outfile, 'w'; |
||
584 | |||
585 | my $parttable = Text::Table->new( |
||
586 | { title => '| ', is_sep => 1 }, |
||
587 | { title => 'id', align => 'right', align_title => 'center' }, |
||
588 | { title => ' | ', is_sep => 1 }, |
||
428 | agaran | 589 | { title => 'description', align => 'left', align_title => 'left' }, |
419 | agaran | 590 | { title => ' | ', is_sep => 1 }, |
428 | agaran | 591 | { title => 'manufacturer partid', align => 'left', align_title => 'left' }, |
419 | agaran | 592 | { title => ' | ', is_sep => 1 }, |
428 | agaran | 593 | { title => 'footprint', align => 'left', align_title => 'left' }, |
419 | agaran | 594 | { title => ' | ', is_sep => 1 }, |
428 | agaran | 595 | { title => 'refdes', align => 'left', align_title => 'left' }, |
419 | agaran | 596 | { title => ' | ', is_sep => 1 }, |
428 | agaran | 597 | { title => 'sheet', align => 'left', align_title => 'left' }, |
419 | agaran | 598 | { title => ' |', is_sep => 1 }, |
599 | ); |
||
600 | |||
601 | my ($pn) = (1); |
||
602 | |||
603 | foreach my $fkey (sort keys %Files) { |
||
604 | my $rowblock = 0; |
||
605 | foreach my $id ( sort {my $p = $Inv[$a]{Manufacturer} cmp $Inv[$b]{Manufacturer}; if ($p == 0) { |
||
606 | return $Inv[$a]{Description} cmp $Inv[$b]{Description}}; return $p; } keys %{$Files{$fkey}}) { |
||
607 | |||
608 | if ($Config{'no-repeat-columns'}) { |
||
609 | my @p = split(/\n/, strbreak(join (', ', sort @{$Files{$fkey}{$id}{RefDes}}),43)); |
||
610 | |||
611 | $parttable->add($pn, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $BomData{$id}{Footprint}, |
||
612 | etrim(trim(shift @p)), $fkey); |
||
613 | |||
614 | while (@p) { |
||
615 | $parttable->add('++', '', '', '', etrim(trim(shift @p)), ''); |
||
616 | } |
||
617 | } else { |
||
618 | my @p = split(/\n/, strbreak(join (', ', sort @{$Files{$fkey}{$id}{RefDes}}),43)); |
||
619 | while (@p) { |
||
620 | $parttable->add($pn, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $BomData{$id}{Footprint}, |
||
621 | etrim(trim(shift @p)), $fkey); |
||
622 | } |
||
623 | } |
||
624 | |||
625 | |||
626 | $pn++; |
||
627 | } |
||
628 | $parttable->add('--','=========','==========','==========','==========','=========='); |
||
629 | } |
||
630 | |||
631 | print $out $parttable->rule('-','+'); |
||
632 | print $out $parttable->title(); |
||
633 | print $out $parttable->rule('-','+'); |
||
634 | unless (defined $Config{'lines'}) { |
||
635 | print $out $parttable->body(); |
||
636 | } else { |
||
637 | my @p = split(/\n/,$parttable->body()); |
||
638 | while (@p) { |
||
639 | my @sub = splice @p,0,$Config{'lines'}; |
||
640 | print $out join("\n",@sub)."\n"; |
||
641 | if (scalar @p > 0) { |
||
642 | print $out $parttable->rule('-','+'); |
||
643 | print $out $parttable->title(); |
||
644 | print $out $parttable->rule('-','+'); |
||
645 | } |
||
646 | } |
||
647 | } |
||
648 | print $out $parttable->rule('-','+'); |
||
649 | |||
650 | $out->close(); |
||
651 | } #}}}1 |
||
652 | |||
293 | agaran | 653 | Getopt::Long::Configure("bundling"); |
280 | agaran | 654 | |
319 | agaran | 655 | if (scalar @ARGV == 0) { |
656 | Help_Show(); |
||
657 | exit; |
||
658 | } |
||
659 | |||
313 | agaran | 660 | my $result = Getopt::Long::GetOptions ( |
661 | "showrc|showconf" => sub { $show_conf = 1 }, |
||
662 | "docdir|d=s" => sub { $Config{docdir} = $_[1]; }, |
||
663 | # not sure if bomdir or SCH dir |
||
664 | "bomdir|b=s" => sub { $Config{$_[0]} = $_[1]; }, # $_[0] contain basename of option, so in few cases could be (ab)used |
||
419 | agaran | 665 | "define|D=s" => sub { my ($p,$q) = split(/=/,$_[1],2); $Config{$p} = ($q||1); }, |
666 | "verbose|v:+" => \$Config{'verbose'}, |
||
330 | agaran | 667 | "help|h|?:s" => sub { $show_help = 1; }, |
668 | "outfile|o=s" => sub { $Config{$_[0]} = $_[1]; }, |
||
669 | "force|f" => sub { $Config{$_[0]} = 1 }, |
||
337 | agaran | 670 | "lines|l=i" => sub { $Config{$_[0]} = abs(int($_[1]));}, |
313 | agaran | 671 | |
672 | # options |
||
293 | agaran | 673 | ); |
674 | if (!$result) { |
||
675 | printf "Usage: %s [-d directory] [-v]\n",basename($0); |
||
676 | exit; |
||
677 | } |
||
313 | agaran | 678 | |
679 | # ================================================== |
||
680 | # processing of options/config values, checking ranges etc |
||
681 | # |
||
682 | |||
683 | $Config{docdir} = fix_dir ($Config{docdir}); |
||
684 | $Config{bomdir} = fix_dir ($Config{bomdir}); |
||
685 | |||
686 | if ( $show_help == 1) { |
||
687 | Help_Show(); |
||
688 | exit; |
||
293 | agaran | 689 | } |
690 | |||
313 | agaran | 691 | if ( $show_conf == 1) { |
692 | Config_Show(); |
||
693 | exit; |
||
694 | } |
||
293 | agaran | 695 | |
313 | agaran | 696 | # make Inventory |
419 | agaran | 697 | nfo_printf("Fetching data from information.txt (under %s)",shortdir($Config{docdir})); |
313 | agaran | 698 | file_lookup($Config{docdir}, 0, qr/\/information.txt$/, \&parse_ifile); |
419 | agaran | 699 | nfo_printf("Finished, %d entries loaded.", scalar(@Inv)+1); |
313 | agaran | 700 | |
701 | # process BOM files |
||
419 | agaran | 702 | nfo_printf("Fetching BOM data from %s", shortdir($Config{bomdir})); |
313 | agaran | 703 | file_lookup($Config{bomdir}, 0, qr/\.bom$/, \&parse_bom); |
419 | agaran | 704 | nfo_printf("Finished, %d entries loaded.", scalar keys %BomData); |
313 | agaran | 705 | |
330 | agaran | 706 | if (!defined $Config{outfile}) { |
419 | agaran | 707 | $Config{outfile} = './output'; |
330 | agaran | 708 | wrn_printf("Output file not specified, saving out in ".$Config{outfile}); |
709 | } |
||
318 | agaran | 710 | |
419 | agaran | 711 | if ($Config{outfile} =~ /^(.*)\.txt$/) { |
712 | $Config{outfile} = $1; |
||
713 | inf_printf("Please specify output name without extension, -bom.txt and -map.txt will be added automatically"); |
||
330 | agaran | 714 | } |
318 | agaran | 715 | |
419 | agaran | 716 | gen_bomfile($Config{'outfile'}.'-bom.txt'); |
318 | agaran | 717 | |
419 | agaran | 718 | gen_mapfile($Config{'outfile'}.'-map.txt'); |
330 | agaran | 719 | |
419 | agaran | 720 | nfo_printf("Script finished, output saved in %s-{map,bom}.txt", $Config{outfile}); |
318 | agaran | 721 | |
419 | agaran | 722 | __END__ |
332 | agaran | 723 | |
419 | agaran | 724 | if ( -e $Config{outfile}) { |
725 | unless (defined $Config{force} && $Config{force} == 1) { |
||
726 | inf_printf("Unlinking output.txt before owrewriting"); |
||
727 | unlink($Config{outfile}); |
||
728 | } else { |
||
729 | wrn_printf("Output file already exist, add --force if i shall overwrite it"); |
||
730 | exit; |
||
337 | agaran | 731 | } |
732 | } |