Rev 322 | Rev 326 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed
| Rev 322 | Rev 325 | ||
|---|---|---|---|
| Line 1... | Line 1... | ||
| 1 | #!/usr/bin/perl -w
|
1 | #!/usr/bin/perl -w
|
| 2 | use strict; |
2 | use strict; |
| 3 | # $Id: inventory.pl 322 2008-12-29 11:49:00Z agaran $
|
3 | # $Id: inventory.pl 325 2008-12-29 15:38:59Z agaran $
|
| 4 | # Thu, 13 Nov 2008 21:06:23 +0100
|
4 | # Thu, 13 Nov 2008 21:06:23 +0100
|
| 5 | # Maciej 'agaran' Pijanka <agaran@pld-linux.org>
|
5 | # Maciej 'agaran' Pijanka <agaran@pld-linux.org>
|
| 6 | # for OpenARM SBC Project
|
6 | # for OpenARM SBC Project
|
| 7 | # license: gpl v3
|
7 | # license: gpl v3
|
| 8 | 8 | ||
| 9 | 9 | ||
| 10 | use Getopt::Long qw//; |
10 | use Getopt::Long qw//; |
| 11 | use File::Basename qw/basename/; |
11 | use File::Basename qw/basename/; |
| 12 | use IO::Dir; |
12 | use IO::Dir; |
| 13 | use IO::File; |
13 | use IO::File; |
| - | 14 | use Text::Table; |
|
| - | 15 | ||
| - | 16 | use lib File::Basename::dirname($0).'/lib'; |
|
| - | 17 | ||
| 14 | 18 | ||
| 15 | my %Config; |
19 | my %Config; |
| 16 | 20 | ||
| 17 | # ==================================================
|
21 | # ==================================================
|
| 18 | $Config{docdir} = '.'; |
22 | $Config{docdir} = '.'; |
| 19 | $Config{bomdir} = '.'; |
23 | $Config{bomdir} = '.'; |
| - | 24 | $Config{outdir} = '.'; |
|
| 20 | $Config{verbose} = 1; |
25 | $Config{verbose} = 1; |
| 21 | 26 | ||
| 22 | # 0 mean not show, -1 show all, positive value limits depth of shown
|
27 | # 0 mean not show, -1 show all, positive value limits depth of shown
|
| 23 | $Config{dbg_showdirs} = 0; |
28 | $Config{dbg_showdirs} = 0; |
| 24 | 29 | ||
| Line 31... | Line 36... | ||
| 31 | 36 | ||
| 32 | # ==================================================
|
37 | # ==================================================
|
| 33 | 38 | ||
| 34 | my %Inv_By_PartNo; |
39 | my %Inv_By_PartNo; |
| 35 | my @Inv; |
40 | my @Inv; |
| - | 41 | my %BomData; |
|
| 36 | 42 | ||
| 37 | sub err_printf($@) { |
43 | sub err_printf($@) { |
| 38 | my ($format, @args) = @_; |
44 | my ($format, @args) = @_; |
| 39 | 45 | ||
| 40 | printf STDERR "-E- ".$format."\n", @args; |
46 | printf STDERR "-E- ".$format."\n", @args; |
| Line 115... | Line 121... | ||
| 115 | $value =~ s/^[ ]+//; |
121 | $value =~ s/^[ ]+//; |
| 116 | $value =~ s/[ ]+$//; |
122 | $value =~ s/[ ]+$//; |
| 117 | return $value; |
123 | return $value; |
| 118 | }
|
124 | }
|
| 119 | 125 | ||
| - | 126 | sub shortstring($$) { |
|
| - | 127 | my ($str,$lim) = @_; |
|
| - | 128 | return substr($str,0,$lim-4).'(..)' if (length ($str) > $lim); |
|
| - | 129 | return $str; |
|
| - | 130 | }
|
|
| - | 131 | ||
| 120 | # this subroutine is used as callback function
|
132 | # this subroutine is used as callback function
|
| 121 | # executed by file_lookup
|
133 | # executed by file_lookup
|
| 122 | sub parse_ifile($) { |
134 | sub parse_ifile($) { |
| 123 | my ($filepath) = @_; |
135 | my ($filepath) = @_; |
| 124 | 136 | ||
| Line 251... | Line 263... | ||
| 251 | $Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno}} = $id; |
263 | $Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno}} = $id; |
| 252 | } else { |
264 | } else { |
| 253 | wrn_printf("PartNumber %s happened more than once, using first occurence (id:%d)", |
265 | wrn_printf("PartNumber %s happened more than once, using first occurence (id:%d)", |
| 254 | $Inv[$id]{Manufacturer_Partno}, $id); |
266 | $Inv[$id]{Manufacturer_Partno}, $id); |
| 255 | }
|
267 | }
|
| - | 268 | ||
| 256 | #inf_printf("Part %s defined in file %s", $Inv[$id]{Manufacturer_Partno}, shortdir($filepath));
|
269 | #inf_printf("Part %s defined in file %s", $Inv[$id]{Manufacturer_Partno}, shortdir($filepath));
|
| 257 | 270 | ||
| 258 | wrn_printf("Unhandled data from parsing: %s", Dumper(\%data)) if (scalar keys %data > 0); |
271 | wrn_printf("Unhandled data from parsing: %s", Dumper(\%data)) if (scalar keys %data > 0); |
| 259 | }
|
272 | }
|
| 260 | 273 | ||
| 261 | 274 | ||
| 262 | my %BomData; |
- | |
| 263 | sub parse_bom ($) { |
275 | sub parse_bom ($) { |
| 264 | my ($filepath) = @_; |
276 | my ($filepath) = @_; |
| 265 | 277 | ||
| 266 | open(IN, $filepath) or return 1; |
278 | open(IN, $filepath) or return 1; |
| 267 | 279 | ||
| Line 383... | Line 395... | ||
| 383 | # not sure if bomdir or SCH dir
|
395 | # not sure if bomdir or SCH dir
|
| 384 | "bomdir|b=s" => sub { $Config{$_[0]} = $_[1]; }, # $_[0] contain basename of option, so in few cases could be (ab)used |
396 | "bomdir|b=s" => sub { $Config{$_[0]} = $_[1]; }, # $_[0] contain basename of option, so in few cases could be (ab)used |
| 385 | "define|D=s" => sub { my ($p,$q) = split(/=/,$_[1],2); $Config{$p} = $q; }, |
397 | "define|D=s" => sub { my ($p,$q) = split(/=/,$_[1],2); $Config{$p} = $q; }, |
| 386 | "verbose|v:+" => sub { $Config{$_[0]} = ($_[1]>1?0:$Config{$_[0]}) + $_[1]; }, |
398 | "verbose|v:+" => sub { $Config{$_[0]} = ($_[1]>1?0:$Config{$_[0]}) + $_[1]; }, |
| 387 | "help|h|?:s" => sub { $show_help = 1 }, |
399 | "help|h|?:s" => sub { $show_help = 1 }, |
| - | 400 | "outdir|o=s" => sub { $Config{$_[0]} = $_[1]; }, |
|
| 388 | 401 | ||
| 389 | # options
|
402 | # options
|
| 390 | ); |
403 | ); |
| 391 | if (!$result) { |
404 | if (!$result) { |
| 392 | printf "Usage: %s [-d directory] [-v]\n",basename($0); |
405 | printf "Usage: %s [-d directory] [-v]\n",basename($0); |
| Line 417... | Line 430... | ||
| 417 | file_lookup($Config{bomdir}, 0, qr/\.bom$/, \&parse_bom); |
430 | file_lookup($Config{bomdir}, 0, qr/\.bom$/, \&parse_bom); |
| 418 | 431 | ||
| 419 | my $n = 0; |
432 | my $n = 0; |
| 420 | my $cost = 0.0; |
433 | my $cost = 0.0; |
| 421 | 434 | ||
| 422 | sub shortstring($$) { |
- | |
| 423 | my ($str,$lim) = @_; |
- | |
| 424 | return substr($str,0,$lim-4).'(..)' if (length ($str) > $lim); |
- | |
| 425 | return $str; |
- | |
| 426 | }
|
- | |
| 427 | 435 | ||
| - | 436 | my $out = new IO::File $Config{outdir}.'/output.txt', 'w'; |
|
| 428 | 437 | ||
| 429 | - | ||
| 430 | open (BOMOUT, '>output.bom') || die 'cant open output.bom: $!'; |
- | |
| 431 | open (PARTMAP, '>output.map') || die 'cant open output.map: $!'; |
438 | open (PARTMAP, '>output.map') || die 'cant open output.map: $!'; |
| 432 | 439 | ||
| 433 | printf BOMOUT "|%s|\n| | %-33s| %-20s| %-18s| %-11s|%-5s|%-6s|%-6s|\n|----+-----------------------------------+". |
- | |
| 434 | "----------------------+--------------------+-------------+------+------+------|\n", ("-" x 119), |
- | |
| 435 | 'description','manufact. partno','manufacturer','order code','quant.','price','cost'; |
- | |
| 436 | printf PARTMAP "%-35s| refdes\n\n", 'part'; |
440 | printf PARTMAP "%-35s| refdes\n\n", 'part'; |
| 437 | 441 | ||
| - | 442 | my $bomtable = Text::Table->new( |
|
| - | 443 | { title => '|', is_sep => 1 }, |
|
| - | 444 | { title => 'item', align => 'right', align_title => 'center' }, |
|
| - | 445 | { title => '|', is_sep => 1 }, |
|
| - | 446 | { title => 'description', align => 'left', align_title => 'center' }, |
|
| - | 447 | { title => '|', is_sep => 1 }, |
|
| - | 448 | { title => 'manufacturer partno', align => 'left', align_title => 'center' }, |
|
| - | 449 | { title => '|', is_sep => 1 }, |
|
| - | 450 | { title => 'manufacturer', align => 'left', align_title => 'center' }, |
|
| - | 451 | { title => '|', is_sep => 1 }, |
|
| - | 452 | { title => 'order code', align => 'left', align_title => 'center' }, |
|
| - | 453 | { title => '|', is_sep => 1 }, |
|
| - | 454 | { title => 'quantity', align => 'right', align_title => 'center' }, |
|
| - | 455 | { title => '|', is_sep => 1 }, |
|
| - | 456 | { title => 'unit price', align => 'auto', align_title => 'center' }, |
|
| - | 457 | { title => '|', is_sep => 1 }, |
|
| - | 458 | { title => 'total price', align => 'auto', align_title => 'center' }, |
|
| - | 459 | { title => '|', is_sep => 1 }, |
|
| - | 460 | ); |
|
| 438 | 461 | ||
| - | 462 | foreach my $id ( sort {my $p = $Inv[$a]{Manufacturer} cmp $Inv[$b]{Manufacturer}; if ($p == 0) { |
|
| - | 463 | # return $Inv[$a]{Manufacturer_Partno} cmp $Inv[$b]{Manufacturer_Partno}}; return $p; } keys %BomData) {
|
|
| 439 | foreach my $id (keys %BomData) { |
464 | return $Inv[$a]{Description} cmp $Inv[$b]{Description}}; return $p; } keys %BomData) { |
| 440 | my %tmp; |
465 | my %tmp; |
| 441 | map { $tmp{$_} = 1 } @{$BomData{$id}{RefDes}}; |
466 | map { $tmp{$_} = 1 } @{$BomData{$id}{RefDes}}; |
| 442 | @{$BomData{$id}{RefDes}} = keys %tmp; |
467 | @{$BomData{$id}{RefDes}} = keys %tmp; |
| 443 | my $cnt = scalar @{$BomData{$id}{RefDes}}; |
468 | my $quant = scalar @{$BomData{$id}{RefDes}}; |
| 444 | if (!defined $Inv[$id]{Price}) { |
469 | if (!defined $Inv[$id]{Price}) { |
| 445 | wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno}); |
470 | wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno}); |
| 446 | $Inv[$id]{Price} = 0; |
471 | $Inv[$id]{Price} = 0; |
| 447 | }
|
472 | }
|
| 448 | my $icost = $cnt * $Inv[$id]{Price}; |
473 | my $icost = $quant * $Inv[$id]{Price}; |
| 449 | 474 | ||
| 450 | printf BOMOUT "|%4d|%-35s|%-22s|%-20s|%-13s|%6d|%6.3f|%6.3f|\n", $n, shortstring($Inv[$id]{Description},35), |
- | |
| 451 | shortstring($Inv[$id]{Manufacturer_Partno},22), shortstring($Inv[$id]{Manufacturer},20), |
- | |
| 452 | shortstring($Inv[$id]{Ordercode}, 13), $cnt, $Inv[$id]{Price}, $icost; |
- | |
| 453 | - | ||
| 454 | printf PARTMAP "%-35s|%s\n", shortstring($Inv[$id]{Description},35), join (', ', @{$BomData{$id}{RefDes}}); |
475 | printf PARTMAP "%-35s|%s\n", shortstring($Inv[$id]{Description},35), join (', ', sort @{$BomData{$id}{RefDes}}); |
| 455 | $cost += $icost; |
476 | $cost += $icost; |
| 456 | # %BomData{ById}{$id}{RefDes}
|
477 | # %BomData{ById}{$id}{RefDes}
|
| - | 478 | $bomtable->add($n, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $Inv[$id]{Manufacturer},$Inv[$id]{Ordercode}, |
|
| - | 479 | $quant, $Inv[$id]{Price}, $icost); |
|
| 457 | $n ++; |
480 | $n ++; |
| 458 | }
|
481 | }
|
| 459 | printf BOMOUT "|%s|\n| %-118s|\n|%s|\n", ("-" x 119), sprintf ("Total cost: %.3f, generated at %s", $cost, scalar localtime(time())), ("-" x 119); |
- | |
| 460 | 482 | ||
| - | 483 | printf $out "file generated at %s\n\n", scalar localtime(time()); |
|
| - | 484 | ||
| - | 485 | print $out $bomtable->rule('-','+'); |
|
| - | 486 | print $out $bomtable->title(); |
|
| - | 487 | print $out $bomtable->rule('-','+'); |
|
| 461 | close BOMOUT; |
488 | print $out $bomtable->body(); |
| - | 489 | print $out $bomtable->rule('-','+'); |
|
| - | 490 | ||
| - | 491 | printf $out "\nTotal cost: %.3f\n", $cost; |
|
| - | 492 | ||
| 462 | close PARTMAP; |
493 | close PARTMAP; |
| - | 494 | ||