Rev 319 |
Rev 326 |
Go to most recent revision |
Blame |
Compare with Previous |
Last modification |
View Log
| RSS feed
#!/usr/bin/perl -w
use strict
;
# $Id: inventory.pl 322 2008-12-29 11:49:00Z agaran $
# Thu, 13 Nov 2008 21:06:23 +0100
# Maciej 'agaran' Pijanka <agaran@pld-linux.org>
# for OpenARM SBC Project
# license: gpl v3
use Getopt
::Long qw//;
use File
::Basename qw/basename/;
use IO
::Dir;
use IO
::File;
my %Config;
# ==================================================
$Config{docdir
} = '.';
$Config{bomdir
} = '.';
$Config{verbose
} = 1;
# 0 mean not show, -1 show all, positive value limits depth of shown
$Config{dbg_showdirs
} = 0;
# modes
my $build_inventory = 0;
my $build_bom = 0;
my $show_conf = 0;
my $show_help = 0;
# ==================================================
my %Inv_By_PartNo;
my @Inv;
sub err_printf
($@) {
my ($format, @args) = @_;
printf STDERR "-E- ".$format."\n", @args;
# exit? or fail-exit here
}
sub wrn_printf
($@) {
my ($format, @args) = @_;
printf STDERR "-W- ".$format."\n", @args;
}
sub inf_printf
($@) {
my ($format, @args) = @_;
printf STDERR "-I- ".$format."\n", @args;
}
sub Config_Show
{
printf "Config for %s\n----------------------------------------\n", basename
($0);
foreach my $name (sort keys %Config) {
printf "%-20s %s\n", $name, $Config{$name};
}
}
sub Help_Show
{
printf "Help for %s\n----------------------------------------\n", basename
($0);
unless (defined($_[1]) && length($_[1]) != 0) {
print "Basic help\n\t--showrc|showconf shows current configuration\n".
"\t--docdir|-d <dir> tells script where information.txt files should be searched\n".
"\t--define <something>=<somethingelseornot> defines some configration value\n".
"\t--verbose|-v [level] sets verbosity level\nOrder of options DOES matter\n".
"\t--bomdir|-b <dir> tells script where boms should be searched\n";
print "\t\e[0;31mThis Help Is created especially for \e[0;33mJelle\e[0;29m\n".
"\tThis script search all directories below specified ones to find interesting files\n";
return;
}
if ($_[1] =~ /^foo$/) {
print "Noo, there is no foo's here\n";
} else {
printf "Sorry, help for `%s' don't exist (eventually) yet\n", $_[1];
}
exit;
}
sub fix_dir
($) {
my $dir = shift @_;
$dir =~ s/\/$//;
if (! -d
$dir) {
err_printf
("Sorry `%s' is not valid directory, exiting", $dir);
}
return $dir;
}
sub shortdir
($) {
my $path = shift @_;
return substr($path, 2) if ($path =~ /^\.\//) ;
return $path;
}
sub trim
($) {
my ($value) = @_;
$value =~ s/^ +//;
$value =~ s/ +$//;
return $value;
}
sub etrim
($) {
my ($value) = @_;
$value =~ s/^[ ]+//;
$value =~ s/[ ]+$//;
return $value;
}
# this subroutine is used as callback function
# executed by file_lookup
sub parse_ifile
($) {
my ($filepath) = @_;
open(IN
, $filepath) or return 1;
my %data;
while (not eof IN
) {
my $line = <IN>;
chomp $line;
next if ($line =~ /^[ ]*$/);
next if ($line =~ /^;/);
last if ($line =~ /^--/);
if ($line =~ /^([A-Za-z ]+):(.*)$/) {
my ($name,$value) = (lc etrim
($1),etrim
($2));
if ($name =~ /^price$/) {
$value =~ s/[^0-9\.\,]//g;
if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) {
# printf STDERR "Price %.3f\n", $value;
if (!defined($data{price
})) {
$data{price
} = $value;
} else {
wrn_printf
("Duplicated price field in file %s", shortdir
($filepath));
}
} else {
err_printf
("Bad price field in file %s", shortdir
($filepath));
}
} elsif ($name =~ /^manufacturer$/i) {
# printf STDERR "Manufacturer %s\n", $value;
if (!defined($data{manufacturer
})) {
$data{manufacturer
} = $value;
} else {
wrn_printf
("Duplicated manufacturer field in file %s", shortdir
($filepath));
}
} elsif ($name =~ /^manufacturer part no$/ ) {
# printf STDERR "ManPartNo %s\n", $value;
if (!defined($data{manufact_partno
})) {
$data{manufact_partno
} = trim
($value);
} else {
wrn_printf
("Duplicated manufacturer part no field in file %s",
shortdir
($filepath));
}
} elsif ($name =~ /^description$/i) {
if (!defined($data{desc
})) {
$data{desc
} = $value;
} else {
wrn_printf
("Duplicated description no field in file %s",
shortdir
($filepath));
}
} elsif ($name =~ /^datasheet$/i) {
$data{datasheet
} = [] unless defined $data{datasheet
};
push @{$data{datasheet
}}, $value;
# printf STDERR "Datasheet %s\n", $value;
} elsif ($name =~ /^supplier$/i) {
# printf STDERR "Supplier %s\n", $value;
if (!defined($data{supplier
})) {
$data{supplier
} = $value;
} else {
wrn_printf
("Duplicated supplier field in file %s",
shortdir
($filepath));
}
} elsif ($name =~ /^order code$/) {
# printf STDERR "Order Code %s\n", $value;
if (!defined($data{ordercode
})) {
$data{ordercode
} = $value;
} else {
wrn_printf
("Duplicated order code field in file %s",
shortdir
($filepath));
}
#push @DATA, { $name => $value };
} elsif ($name =~ /^url .*$/) {
# printf STDERR "URL %s\n", $value;
} elsif ($name =~ /^catalog(ue|) page$/) {
# printf STDERR "Catalogue Page %s\n", $value;
} else {
err_printf
("Unhandled field %s in file %s", $name,
shortdir
($filepath));
}
} else {
wrn_printf
("Unparseable line `%s', forgot ; to set it as comment in file %s\n", $line,
shortdir
($filepath));
}
}
close(IN
);
if (scalar keys %data == 0) {
inf_printf
("Skipping file %s because contain no data for me",
shortdir
($filepath));
return;
}
unless (defined ($data{price
}) && $data{price
} != 0) {
wrn_printf
("Missing Price in file %s",
shortdir
($filepath));
}
unless (defined($data{manufact_partno
})) {
inf_printf
("Missing Manufacturer Part No in file %s",
shortdir
($filepath));
}
unless (defined($data{ordercode
})) {
wrn_printf
("Missing Order Code in file %s",
shortdir
($filepath));
}
use Data
::Dumper qw/Dumper/;
my $id = scalar @Inv;
$Inv[$id] = {};
$Inv[$id]{Datasheet
} = delete $data{'datasheet'} if defined $data{'datasheet'};
$Inv[$id]{Manufacturer
} = delete $data{'manufacturer'} if defined $data{'manufacturer'};
$Inv[$id]{Description
} = delete $data{'desc'} if defined $data{'desc'};
$Inv[$id]{Price
} = delete $data{'price'} if defined $data{'price'};
$Inv[$id]{Ordercode
} = delete $data{'ordercode'} if defined $data{'ordercode'};
$Inv[$id]{Manufacturer_Partno
} = delete $data{'manufact_partno'} if defined $data{'manufact_partno'};
$Inv[$id]{Supplier
} = delete $data{'supplier'} if defined $data{'supplier'};
unless (defined ($Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno
}})) {
$Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno
}} = $id;
} else {
wrn_printf
("PartNumber %s happened more than once, using first occurence (id:%d)",
$Inv[$id]{Manufacturer_Partno
}, $id);
}
#inf_printf("Part %s defined in file %s", $Inv[$id]{Manufacturer_Partno}, shortdir($filepath));
wrn_printf
("Unhandled data from parsing: %s", Dumper
(\%data)) if (scalar keys %data > 0);
}
my %BomData;
sub parse_bom
($) {
my ($filepath) = @_;
open(IN
, $filepath) or return 1;
#wrn_printf("GotARg: %s", shortdir($filepath));
my @Fields;
my %data;
my $v = '';
while (not eof IN
) {
my $line = <IN>;
chomp $line;
if ($line =~ /^\.START$/) {
$v = 'boms';
next;
}
if ($line =~ /^\.END$/) {
$v = '';
next;
}
if ($v eq 'boms') {
@Fields = split(/\t/, substr($line,2));
$v = 'bom';
# some funny way to generate field-map
# that if someone reorder bom file columns we are still on place
next;
}
if ($v eq 'bom') {
my ($refdes, $device, $value, $footprint, $quantity) = split (/\t/, $line);
$device = trim
($device);
# wrn_printf("Device: %s (value: %s) at refdes %s, %d pcs", $device, $value, $refdes, $quantity);
if (!defined $Inv_By_PartNo{$device}) {
wrn_printf
("Device %s not found in inventory in file %s", $device, shortdir
($filepath));
next;
}
my $id = $Inv_By_PartNo{$device};
next if ($Inv[$id]{Manufacturer
} =~ /none/i); # skip parts whose manufacturer is none
#inf_printf("Found in Inventory at %d %s", $id, $Inv[$id]{Manufacturer_Partno});
push @{$data{$id}{RefDes
}}, $refdes;
}
}
close(IN
);
if (scalar keys %data == 0) {
inf_printf
("Skipping file %s because contain no data for me",
shortdir
($filepath));
return;
}
foreach my $id (keys %data) {
my %tmp;
map { $tmp{$_} = 1 } @{$data{$id}{RefDes
}};
@{$data{$id}{RefDes
}} = keys %tmp;
my $cnt = scalar @{$data{$id}{RefDes
}};
if (!defined $Inv[$id]{Price
}) {
wrn_printf
("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno
});
$Inv[$id]{Price
} = 0;
}
push @{$BomData{$id}{RefDes
}}, @{$data{$id}{RefDes
}};
# printf "%-20s %.4f %s\n", $Inv[$id]{Manufacturer_Partno}, $cnt, $icost, join (', ', @{$data{$id}{RefDes}});
# %BomData{ById}{$id}{RefDes}
}
}
sub file_lookup
($$$$) ;
sub file_lookup
($$$$) {
my ($dir, $depth, $regexp, $callback) = @_;
err_printf
("Sorry, callback must be CODE ref") unless (ref $callback eq 'CODE');
if ( -d
$dir) {
my $d = IO
::Dir->new($dir);
return 1 if (!defined $d);
while (defined(my $e = $d->read)) {
my $fe = $dir .'/'. $e;
if ( -f
$fe) {
if ($fe =~ $regexp) {
&$callback($fe);
}
} elsif (-d
$fe) { # now its dir...
if ($e eq '.svn') { # if entry name is equal to svn
next; # go to next entry in foreach loop
}
next if ($e eq '.' or $e eq '..'); # skip to next if dir entry is . or ..
if ($Config{dbg_showdirs
} == -1 or $Config{dbg_showdirs
} > $depth) {
printf STDERR "Entering directory %s\n", shortdir
($fe);
}
return 1 if (file_lookup
($fe, $depth+1, $regexp, $callback) == 1);
} else {
# symlink or other mysterius beast
}
}
}
return 0;
}
Getopt
::Long::Configure("bundling");
if (scalar @ARGV == 0) {
Help_Show
();
exit;
}
my $result = Getopt
::Long::GetOptions (
"showrc|showconf" => sub { $show_conf = 1 },
"docdir|d=s" => sub { $Config{docdir
} = $_[1]; },
# not sure if bomdir or SCH dir
"bomdir|b=s" => sub { $Config{$_[0]} = $_[1]; }, # $_[0] contain basename of option, so in few cases could be (ab)used
"define|D=s" => sub { my ($p,$q) = split(/=/,$_[1],2); $Config{$p} = $q; },
"verbose|v:+" => sub { $Config{$_[0]} = ($_[1]>1?0:$Config{$_[0]}) + $_[1]; },
"help|h|?:s" => sub { $show_help = 1 },
# options
);
if (!$result) {
printf "Usage: %s [-d directory] [-v]\n",basename
($0);
exit;
}
# ==================================================
# processing of options/config values, checking ranges etc
#
$Config{docdir
} = fix_dir
($Config{docdir
});
$Config{bomdir
} = fix_dir
($Config{bomdir
});
if ( $show_help == 1) {
Help_Show
();
exit;
}
if ( $show_conf == 1) {
Config_Show
();
exit;
}
# make Inventory
file_lookup
($Config{docdir
}, 0, qr/\/information.txt$/, \&parse_ifile);
# process BOM files
file_lookup
($Config{bomdir
}, 0, qr/\.bom$/, \&parse_bom);
my $n = 0;
my $cost = 0.0;
sub shortstring
($$) {
my ($str,$lim) = @_;
return substr($str,0,$lim-4).'(..)' if (length ($str) > $lim);
return $str;
}
open (BOMOUT
, '>output.bom') || die 'cant open output.bom: $!';
open (PARTMAP
, '>output.map') || die 'cant open output.map: $!';
printf BOMOUT
"|%s|\n| | %-33s| %-20s| %-18s| %-11s|%-5s|%-6s|%-6s|\n|----+-----------------------------------+".
"----------------------+--------------------+-------------+------+------+------|\n", ("-" x
119),
'description','manufact. partno','manufacturer','order code','quant.','price','cost';
printf PARTMAP
"%-35s| refdes\n\n", 'part';
foreach my $id (keys %BomData) {
my %tmp;
map { $tmp{$_} = 1 } @{$BomData{$id}{RefDes
}};
@{$BomData{$id}{RefDes
}} = keys %tmp;
my $cnt = scalar @{$BomData{$id}{RefDes
}};
if (!defined $Inv[$id]{Price
}) {
wrn_printf
("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno
});
$Inv[$id]{Price
} = 0;
}
my $icost = $cnt * $Inv[$id]{Price
};
printf BOMOUT
"|%4d|%-35s|%-22s|%-20s|%-13s|%6d|%6.3f|%6.3f|\n", $n, shortstring
($Inv[$id]{Description
},35),
shortstring
($Inv[$id]{Manufacturer_Partno
},22), shortstring
($Inv[$id]{Manufacturer
},20),
shortstring
($Inv[$id]{Ordercode
}, 13), $cnt, $Inv[$id]{Price
}, $icost;
printf PARTMAP
"%-35s|%s\n", shortstring
($Inv[$id]{Description
},35), join (', ', @{$BomData{$id}{RefDes
}});
$cost += $icost;
# %BomData{ById}{$id}{RefDes}
$n ++;
}
printf BOMOUT
"|%s|\n| %-118s|\n|%s|\n", ("-" x
119), sprintf ("Total cost: %.3f, generated at %s", $cost, scalar localtime(time())), ("-" x
119);
close BOMOUT
;
close PARTMAP
;