Rev 319 | Rev 325 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed
| Rev 319 | Rev 322 | ||
|---|---|---|---|
| Line 1... | Line 1... | ||
| 1 | #!/usr/bin/perl -w
|
1 | #!/usr/bin/perl -w
|
| 2 | use strict; |
2 | use strict; |
| 3 | # $Id: inventory.pl 319 2008-12-29 11:08:59Z agaran $
|
3 | # $Id: inventory.pl 322 2008-12-29 11:49:00Z 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; |
|
| - | 13 | use IO::File; |
|
| 12 | 14 | ||
| 13 | my %Config; |
15 | my %Config; |
| 14 | 16 | ||
| 15 | # ==================================================
|
17 | # ==================================================
|
| 16 | $Config{docdir} = '.'; |
18 | $Config{docdir} = '.'; |
| Line 338... | Line 340... | ||
| 338 | my ($dir, $depth, $regexp, $callback) = @_; |
340 | my ($dir, $depth, $regexp, $callback) = @_; |
| 339 | 341 | ||
| 340 | err_printf("Sorry, callback must be CODE ref") unless (ref $callback eq 'CODE'); |
342 | err_printf("Sorry, callback must be CODE ref") unless (ref $callback eq 'CODE'); |
| 341 | 343 | ||
| 342 | if ( -d $dir) { |
344 | if ( -d $dir) { |
| 343 | opendir(DIR, $dir) or return 1; |
345 | my $d = IO::Dir->new($dir); |
| - | 346 | return 1 if (!defined $d); |
|
| - | 347 | ||
| - | 348 | ||
| 344 | foreach my $e (readdir(DIR)) { |
349 | while (defined(my $e = $d->read)) { |
| 345 | my $fe = $dir .'/'. $e; |
350 | my $fe = $dir .'/'. $e; |
| 346 | if ( -f $fe) { |
351 | if ( -f $fe) { |
| 347 | if ($fe =~ $regexp) { |
352 | if ($fe =~ $regexp) { |
| 348 | &$callback($fe); |
353 | &$callback($fe); |
| 349 | }
|
354 | }
|
| Line 359... | Line 364... | ||
| 359 | return 1 if (file_lookup($fe, $depth+1, $regexp, $callback) == 1); |
364 | return 1 if (file_lookup($fe, $depth+1, $regexp, $callback) == 1); |
| 360 | } else { |
365 | } else { |
| 361 | # symlink or other mysterius beast
|
366 | # symlink or other mysterius beast
|
| 362 | }
|
367 | }
|
| 363 | }
|
368 | }
|
| 364 | closedir(DIR); |
- | |
| 365 | }
|
369 | }
|
| 366 | return 0; |
370 | return 0; |
| 367 | }
|
371 | }
|
| 368 | 372 | ||
| 369 | Getopt::Long::Configure("bundling"); |
373 | Getopt::Long::Configure("bundling"); |
| Line 424... | Line 428... | ||
| 424 | 428 | ||
| 425 | 429 | ||
| 426 | open (BOMOUT, '>output.bom') || die 'cant open output.bom: $!'; |
430 | open (BOMOUT, '>output.bom') || die 'cant open output.bom: $!'; |
| 427 | open (PARTMAP, '>output.map') || die 'cant open output.map: $!'; |
431 | open (PARTMAP, '>output.map') || die 'cant open output.map: $!'; |
| 428 | 432 | ||
| 429 | printf BOMOUT "| | %-33s| %-20s| %-18s| %-11s|%-5s|%-6s|%-6s|\n|----+-----------------------------------+". |
433 | printf BOMOUT "|%s|\n| | %-33s| %-20s| %-18s| %-11s|%-5s|%-6s|%-6s|\n|----+-----------------------------------+". |
| 430 | "----------------------+--------------------+-------------+------+------+------|\n", |
434 | "----------------------+--------------------+-------------+------+------+------|\n", ("-" x 119), |
| 431 | 'description','manufact. partno','manufacturer','order code','quant.','price','cost'; |
435 | 'description','manufact. partno','manufacturer','order code','quant.','price','cost'; |
| 432 | printf PARTMAP "%-35s| refdes\n\n", 'part'; |
436 | printf PARTMAP "%-35s| refdes\n\n", 'part'; |
| 433 | 437 | ||
| 434 | 438 | ||
| 435 | foreach my $id (keys %BomData) { |
439 | foreach my $id (keys %BomData) { |