Rev 337 | Rev 419 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed
| Rev 337 | Rev 417 | ||
|---|---|---|---|
| Line 1... | Line 1... | ||
| 1 | #!/usr/bin/perl -w
|
1 | #!/usr/bin/perl -w
|
| 2 | use strict; |
2 | use strict; |
| 3 | # $Id: inventory.pl 337 2009-01-23 16:29:03Z agaran $
|
3 | # $Id: inventory.pl 417 2009-05-15 17:21:21Z 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 Data::Dumper qw/Dumper/; |
|
| 14 | 15 | ||
| 15 | use lib File::Basename::dirname($0).'/lib'; |
16 | use lib File::Basename::dirname($0).'/lib'; |
| 16 | use Text::Table; |
17 | use Text::Table; |
| 17 | 18 | ||
| 18 | 19 | ||
| Line 142... | Line 143... | ||
| 142 | }
|
143 | }
|
| 143 | }
|
144 | }
|
| 144 | return $str; |
145 | return $str; |
| 145 | }
|
146 | }
|
| 146 | 147 | ||
| - | 148 | # this function return price of single item
|
|
| - | 149 | # quantity is needed to cope with quantity-based prices
|
|
| - | 150 | sub get_price($$) { |
|
| - | 151 | my ($id, $quantity) = @_; |
|
| - | 152 | ||
| - | 153 | if (!defined $Inv[$id]{Price}) { |
|
| - | 154 | wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno}); |
|
| - | 155 | return 0.0; |
|
| - | 156 | }
|
|
| - | 157 | ||
| - | 158 | if (ref $Inv[$id]{Price} eq 'ARRAY') { # handle structured prices |
|
| - | 159 | my $ret = 0; |
|
| - | 160 | foreach my $pd (@{$Inv[$id]{Price}}) { |
|
| - | 161 | if (ref $pd eq 'ARRAY') { |
|
| - | 162 | my ($rmin,$rmax) = split '-', $pd->[0]; |
|
| - | 163 | $ret = $pd->[1] if ($quantity >= $rmin); |
|
| - | 164 | }
|
|
| - | 165 | }
|
|
| - | 166 | return $ret; |
|
| - | 167 | }
|
|
| - | 168 | ||
| - | 169 | return $Inv[$id]{Price}; |
|
| - | 170 | }
|
|
| - | 171 | ||
| - | 172 | ||
| - | 173 | ||
| 147 | # this subroutine is used as callback function
|
174 | # this subroutine is used as callback function
|
| 148 | # executed by file_lookup
|
175 | # executed by file_lookup
|
| 149 | sub parse_ifile($) { |
176 | sub parse_ifile($) { |
| 150 | my ($filepath) = @_; |
177 | my ($filepath) = @_; |
| 151 | 178 | ||
| 152 | 179 | ||
| 153 | open(IN, $filepath) or return 1; |
180 | open(IN, $filepath) or return 1; |
| 154 | 181 | ||
| 155 | my %data; |
182 | my %data; |
| - | 183 | my $lineno = 0; |
|
| - | 184 | ||
| - | 185 | my $_ok; |
|
| 156 | 186 | ||
| 157 | while (not eof IN) { |
187 | while (not eof IN) { |
| 158 | my $line = <IN>; |
188 | my $line = <IN>; |
| - | 189 | $lineno++; |
|
| 159 | 190 | ||
| 160 | chomp $line; |
191 | chomp $line; |
| 161 | 192 | ||
| 162 | next if ($line =~ /^[ ]*$/); |
193 | next if ($line =~ /^[ ]*$/); |
| 163 | next if ($line =~ /^;/); |
194 | next if ($line =~ /^;/); |
| Line 166... | Line 197... | ||
| 166 | 197 | ||
| 167 | if ($line =~ /^([A-Za-z ]+):(.*)$/) { |
198 | if ($line =~ /^([A-Za-z ]+):(.*)$/) { |
| 168 | my ($name,$value) = (lc etrim($1),etrim($2)); |
199 | my ($name,$value) = (lc etrim($1),etrim($2)); |
| 169 | 200 | ||
| 170 | if ($name =~ /^price$/) { |
201 | if ($name =~ /^price$/) { |
| 171 | $value =~ s/[^0-9\.\,]//g; |
202 | $value =~ s/[^0-9\.\,]//g; # remove any characters beside DIGITS |
| 172 | if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) { |
203 | if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) { |
| 173 | # printf STDERR "Price %.3f\n", $value;
|
204 | # printf STDERR "Price %.3f\n", $value;
|
| 174 | if (!defined($data{price})) { |
205 | if (!defined($data{price})) { |
| 175 | $data{price} = $value; |
206 | $data{price} = $value; |
| - | 207 | $_ok->{$name} = 1; |
|
| 176 | } else { |
208 | } else { |
| 177 | wrn_printf("Duplicated price field in file %s", shortdir($filepath)); |
209 | wrn_printf("Duplicated price field in file %s", shortdir($filepath)); |
| 178 | }
|
210 | }
|
| 179 | } else { |
211 | } else { |
| 180 | err_printf("Bad price field in file %s", shortdir($filepath)); |
212 | err_printf("Bad price field in file %s", shortdir($filepath)); |
| 181 | }
|
213 | }
|
| 182 | } elsif ($name =~ /^manufacturer$/i) { |
214 | } elsif ($name =~ /^manufacturer$/i) { |
| 183 | # printf STDERR "Manufacturer %s\n", $value;
|
215 | # printf STDERR "Manufacturer %s\n", $value;
|
| 184 | if (!defined($data{manufacturer})) { |
216 | if (!defined($data{manufacturer})) { |
| 185 | $data{manufacturer} = $value; |
217 | $data{manufacturer} = $value; |
| - | 218 | $_ok->{$name} = 1; |
|
| 186 | } else { |
219 | } else { |
| 187 | wrn_printf("Duplicated manufacturer field in file %s", shortdir($filepath)); |
220 | wrn_printf("Duplicated manufacturer field in file %s", shortdir($filepath)); |
| 188 | }
|
221 | }
|
| 189 | } elsif ($name =~ /^manufacturer part no$/ ) { |
222 | } elsif ($name =~ /^manufacturer part no$/ ) { |
| 190 | # printf STDERR "ManPartNo %s\n", $value;
|
223 | # printf STDERR "ManPartNo %s\n", $value;
|
| 191 | if (!defined($data{manufact_partno})) { |
224 | if (!defined($data{manufact_partno})) { |
| 192 | $data{manufact_partno} = trim($value); |
225 | $data{manufact_partno} = trim($value); |
| - | 226 | $_ok->{$name} = 1; |
|
| 193 | } else { |
227 | } else { |
| 194 | wrn_printf("Duplicated manufacturer part no field in file %s", |
228 | wrn_printf("Duplicated manufacturer part no field in file %s", |
| 195 | shortdir($filepath)); |
229 | shortdir($filepath)); |
| 196 | }
|
230 | }
|
| 197 | } elsif ($name =~ /^description$/i) { |
231 | } elsif ($name =~ /^description$/i) { |
| Line 207... | Line 241... | ||
| 207 | # printf STDERR "Datasheet %s\n", $value;
|
241 | # printf STDERR "Datasheet %s\n", $value;
|
| 208 | } elsif ($name =~ /^supplier$/i) { |
242 | } elsif ($name =~ /^supplier$/i) { |
| 209 | # printf STDERR "Supplier %s\n", $value;
|
243 | # printf STDERR "Supplier %s\n", $value;
|
| 210 | if (!defined($data{supplier})) { |
244 | if (!defined($data{supplier})) { |
| 211 | $data{supplier} = $value; |
245 | $data{supplier} = $value; |
| - | 246 | $_ok->{$name} = 1; |
|
| 212 | } else { |
247 | } else { |
| 213 | wrn_printf("Duplicated supplier field in file %s", |
248 | wrn_printf("Duplicated supplier field in file %s", |
| 214 | shortdir($filepath)); |
249 | shortdir($filepath)); |
| 215 | }
|
250 | }
|
| 216 | } elsif ($name =~ /^order code$/) { |
251 | } elsif ($name =~ /^order code$/) { |
| 217 | # printf STDERR "Order Code %s\n", $value;
|
252 | # printf STDERR "Order Code %s\n", $value;
|
| 218 | if (!defined($data{ordercode})) { |
253 | if (!defined($data{ordercode})) { |
| 219 | $data{ordercode} = $value; |
254 | $data{ordercode} = $value; |
| - | 255 | $_ok->{$name} = 1; |
|
| 220 | } else { |
256 | } else { |
| 221 | wrn_printf("Duplicated order code field in file %s", |
257 | wrn_printf("Duplicated order code field in file %s", |
| 222 | shortdir($filepath)); |
258 | shortdir($filepath)); |
| 223 | }
|
259 | }
|
| 224 | #push @DATA, { $name => $value };
|
260 | #push @DATA, { $name => $value };
|
| Line 228... | Line 264... | ||
| 228 | # printf STDERR "Catalogue Page %s\n", $value;
|
264 | # printf STDERR "Catalogue Page %s\n", $value;
|
| 229 | } else { |
265 | } else { |
| 230 | err_printf("Unhandled field %s in file %s", $name, |
266 | err_printf("Unhandled field %s in file %s", $name, |
| 231 | shortdir($filepath)); |
267 | shortdir($filepath)); |
| 232 | }
|
268 | }
|
| - | 269 | } elsif ($line =~ /^([A-Za-z ]+)[ \t]*\(([A-Za-z 0-9\(\)\-]+)\)[ \t]*:(.*)$/) { |
|
| - | 270 | my ($name, $extdata, $value) = (lc etrim($1),etrim($2),etrim($3)); |
|
| - | 271 | if ($name =~ /^price$/) { |
|
| - | 272 | $extdata =~ s/ //g; |
|
| - | 273 | #wrn_printf("Extended-Price <%s> <%s> at %s:%d", $extdata, $value, shortdir($filepath), $lineno);
|
|
| - | 274 | $data{price} = [] if (!defined $data{price}); |
|
| 233 | 275 | ||
| - | 276 | if(ref $data{price} eq 'ARRAY') { |
|
| - | 277 | $value =~ s/[^0-9\.\,]//g; # remove any characters beside DIGITS |
|
| - | 278 | if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) { |
|
| - | 279 | push @{$data{price}}, [ $extdata, $value ]; |
|
| - | 280 | $_ok->{$name} = 1; |
|
| - | 281 | } else { |
|
| - | 282 | err_printf("Bad price field in file %s:%d", shortdir($filepath), $lineno); |
|
| - | 283 | }
|
|
| - | 284 | }
|
|
| - | 285 | } else { |
|
| - | 286 | wrn_printf("Got: <%s> <%s> <%s> at %s:%s", $name, $extdata, $value, $line, shortdir($filepath)); |
|
| - | 287 | }
|
|
| 234 | } else { |
288 | } else { |
| 235 | wrn_printf("Unparseable line `%s', forgot ; to set it as comment in file %s", $line, |
289 | wrn_printf("Unparseable line `%s', forgot ; to set it as comment in file %s", $line, |
| 236 | shortdir($filepath)); |
290 | shortdir($filepath)); |
| 237 | }
|
291 | }
|
| 238 | }
|
292 | }
|
| 239 | close(IN); |
293 | close(IN); |
| 240 | 294 | ||
| 241 | if (scalar keys %data == 0) { |
295 | if (scalar keys %data == 0) { |
| 242 | inf_printf("Skipping file %s because contain no data for me", |
296 | inf_printf("Skipping file %s because contain no data for me", shortdir($filepath)); |
| 243 | shortdir($filepath)); |
- | |
| 244 | return; |
297 | return; |
| 245 | }
|
298 | }
|
| 246 | 299 | ||
| 247 | unless (defined ($data{price}) && $data{price} != 0) { |
300 | foreach my $field (split /\!/, q/price!manufacturer part no!order code/) { |
| 248 | wrn_printf("Missing Price in file %s", |
301 | wrn_printf("Missing ".(ucfirst $field)." in file %s", shortdir($filepath)) unless ($_ok->{$field}); |
| 249 | shortdir($filepath)); |
- | |
| 250 | }
|
302 | }
|
| 251 | - | ||
| 252 | unless (defined($data{manufact_partno})) { |
- | |
| 253 | inf_printf("Missing Manufacturer Part No in file %s", |
- | |
| 254 | shortdir($filepath)); |
- | |
| 255 | }
|
- | |
| 256 | - | ||
| 257 | unless (defined($data{ordercode})) { |
- | |
| 258 | wrn_printf("Missing Order Code in file %s", |
- | |
| 259 | shortdir($filepath)); |
- | |
| 260 | }
|
- | |
| 261 | - | ||
| 262 | 303 | ||
| 263 | use Data::Dumper qw/Dumper/; |
- | |
| 264 | 304 | ||
| 265 | my $id = scalar @Inv; |
305 | my $id = scalar @Inv; |
| 266 | 306 | ||
| 267 | $Inv[$id] = {}; |
307 | $Inv[$id] = {}; |
| 268 | 308 | ||
| Line 359... | Line 399... | ||
| 359 | foreach my $id (keys %data) { |
399 | foreach my $id (keys %data) { |
| 360 | my %tmp; |
400 | my %tmp; |
| 361 | map { $tmp{$_} = 1 } @{$data{$id}{RefDes}}; |
401 | map { $tmp{$_} = 1 } @{$data{$id}{RefDes}}; |
| 362 | @{$data{$id}{RefDes}} = keys %tmp; |
402 | @{$data{$id}{RefDes}} = keys %tmp; |
| 363 | my $cnt = scalar @{$data{$id}{RefDes}}; |
403 | my $cnt = scalar @{$data{$id}{RefDes}}; |
| 364 | if (!defined $Inv[$id]{Price}) { |
- | |
| 365 | wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno}); |
- | |
| 366 | $Inv[$id]{Price} = 0; |
- | |
| 367 | }
|
- | |
| 368 | push @{$BomData{$id}{RefDes}}, @{$data{$id}{RefDes}}; |
404 | push @{$BomData{$id}{RefDes}}, @{$data{$id}{RefDes}}; |
| 369 | if (!defined $BomData{$id}{Footprint}) { |
405 | if (!defined $BomData{$id}{Footprint}) { |
| 370 | $BomData{$id}{Footprint} = $data{$id}{Footprint}; |
406 | $BomData{$id}{Footprint} = $data{$id}{Footprint}; |
| 371 | } else { |
407 | } else { |
| 372 | if ($data{$id}{Footprint} ne $data{$id}{Footprint}) { |
408 | if ($data{$id}{Footprint} ne $data{$id}{Footprint}) { |
| Line 533... | Line 569... | ||
| 533 | return $Inv[$a]{Description} cmp $Inv[$b]{Description}}; return $p; } keys %BomData) { |
569 | return $Inv[$a]{Description} cmp $Inv[$b]{Description}}; return $p; } keys %BomData) { |
| 534 | my %tmp; |
570 | my %tmp; |
| 535 | map { $tmp{$_} = 1 } @{$BomData{$id}{RefDes}}; |
571 | map { $tmp{$_} = 1 } @{$BomData{$id}{RefDes}}; |
| 536 | @{$BomData{$id}{RefDes}} = keys %tmp; |
572 | @{$BomData{$id}{RefDes}} = keys %tmp; |
| 537 | my $quant = scalar @{$BomData{$id}{RefDes}}; |
573 | my $quant = scalar @{$BomData{$id}{RefDes}}; |
| - | 574 | my $price = get_price($id,$quant); |
|
| 538 | if (!defined $Inv[$id]{Price}) { |
575 | if ($price == 0) { |
| 539 | wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno}); |
576 | wrn_printf("%s has zero price", $Inv[$id]{Manufacturer_Partno}); |
| 540 | $Inv[$id]{Price} = 0; |
- | |
| 541 | }
|
577 | }
|
| 542 | my $icost = $quant * $Inv[$id]{Price}; |
578 | my $icost = $quant * $price; |
| 543 | 579 | ||
| 544 | # printf PARTMAP "%-35s|%s\n", shortstring($Inv[$id]{Description},35), join (', ', sort @{$BomData{$id}{RefDes}});
|
580 | # printf PARTMAP "%-35s|%s\n", shortstring($Inv[$id]{Description},35), join (', ', sort @{$BomData{$id}{RefDes}});
|
| 545 | $cost += $icost; |
581 | $cost += $icost; |
| 546 | # %BomData{ById}{$id}{RefDes}
|
582 | # %BomData{ById}{$id}{RefDes}
|
| 547 | # $bomtable->add(' '.$n.' ', $Inv[$id]{Description}.' ', $Inv[$id]{Manufacturer_Partno}.' ', $Inv[$id]{Manufacturer}.' ',
|
583 | # $bomtable->add(' '.$n.' ', $Inv[$id]{Description}.' ', $Inv[$id]{Manufacturer_Partno}.' ', $Inv[$id]{Manufacturer}.' ',
|
| 548 | # $Inv[$id]{Ordercode}.' ', ' '.$quant.' ', sprintf("%.3f ",$Inv[$id]{Price}), sprintf("%.3f ",$icost));
|
584 | # $Inv[$id]{Ordercode}.' ', ' '.$quant.' ', sprintf("%.3f ",$Inv[$id]{Price}), sprintf("%.3f ",$icost));
|
| 549 | $bomtable->add($bn++, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $Inv[$id]{Manufacturer}, |
585 | $bomtable->add($bn++, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $Inv[$id]{Manufacturer}, |
| 550 | $Inv[$id]{Ordercode},$quant, sprintf("%.3f",$Inv[$id]{Price}), sprintf("%.3f",$icost)); |
586 | $Inv[$id]{Ordercode},$quant, sprintf("%.3f",$price), sprintf("%.3f",$icost)); |
| 551 | 587 | ||
| 552 | # $parttable->add($pn++, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $BomData{$id}{Footprint},
|
588 | # $parttable->add($pn++, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $BomData{$id}{Footprint},
|
| 553 | # strbreak(join (', ', sort @{$BomData{$id}{RefDes}}),43), join("\n",@{$BomData{$id}{Files}}));
|
589 | # strbreak(join (', ', sort @{$BomData{$id}{RefDes}}),43), join("\n",@{$BomData{$id}{Files}}));
|
| 554 | }
|
590 | }
|
| 555 | 591 | ||