Subversion Repositories OpenARM Single-board Computer

#!/usr/bin/perl -w

use strict;

# $Id: inventory.pl 333 2008-12-29 21:17:29Z 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;

use lib File::Basename::dirname($0).'/lib';

use Text::Table;

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;

my %BomData;

my %Files;

sub err_printf($@) {

        my ($format, @args) = @_;

        printf STDERR "-E- ".$format."\n", @args;

        # exit? or fail-exit here

}

sub wrn_printf($@) {

        my ($format, @args) = @_;

        return if ($Config{verbose} <= 1) ;

        printf STDERR "-W- ".$format."\n", @args;

}

sub inf_printf($@) {

        my ($format, @args) = @_;

        return if ($Config{verbose} <= 2) ;

        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".

                        "\t--outfile|-o <file> tells where script shall save output data\n".

                        "\t--force|-f forces script to save data even if file exist already\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;

}

sub strbreak($$) {

        my ($str,$lim) = @_;

        my @p = split / /,$str;

        $str = '';

        my $l = 0;

        while (@p) {

                my $e = shift @p;

                if ($l + length ($e) +1 > $lim) {

                        $str .= "\n".$e;

                        $l = length $e;

                } else {

                        $str .= " ".$e;

                        $l += length($e) + 1;

                }

        }

        return $str;

}

# 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", $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);

}

sub parse_bom ($) {

        my ($filepath) = @_;

        open(IN, $filepath) or return 1;

        my $fkey = substr(basename($filepath),0,length(basename($filepath))-4);

        #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;

                        if (!defined $data{$id}{Footprint}) {

                                $data{$id}{Footprint} = $footprint;

                        } else {

                                if ($data{$id}{Footprint} ne $footprint) {

                                        err_printf("Different footprints for same device in within single bom file, script ".

                                                "cannot work around this, will use first one, but expect that output file ".

                                                "might have errors.");

                                }

                        }

                }

        }

        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}};

                if (!defined $BomData{$id}{Footprint}) {

                        $BomData{$id}{Footprint} = $data{$id}{Footprint};

                } else {

                        if ($data{$id}{Footprint} ne $data{$id}{Footprint}) {

                                err_printf("Different footprints for same device between sheets, script cannot ".

                                        "work around this, will use first one, but expect that output file might ".

                                        "have errors.");

                        }

                }

                push @{$BomData{$id}{Files}}, $fkey;

                push @{$Files{$fkey}{$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; },

        "outfile|o=s" => sub { $Config{$_[0]} = $_[1]; },

        "force|f" => sub { $Config{$_[0]} = 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

printf STDERR "Indexing information.txt (under %s)\n",shortdir($Config{docdir});

file_lookup($Config{docdir}, 0, qr/\/information.txt$/, \&parse_ifile);

printf STDERR "\tFinished, %d entries loaded\n", scalar(@Inv)+1;

# process BOM files

printf STDERR "Loading bom data from %s\n", shortdir($Config{bomdir});

file_lookup($Config{bomdir}, 0, qr/\.bom$/, \&parse_bom);

printf STDERR "\tLoaded, now processing\n";

my ($bn,$pn) = (1,1);

my $cost = 0.0;

my $out;

if (!defined $Config{outfile}) {

        $Config{outfile} = './output.txt';

        wrn_printf("Output file not specified, saving out in ".$Config{outfile});

}

if ( -e $Config{outfile}) {

        unless (defined $Config{force} && $Config{force} == 1) {

                inf_printf("Unlinking output.txt before owrewriting");

                unlink($Config{outfile});

        } else {

                wrn_printf("Output file already exist, add --force if i shall overwrite it");

                exit;

        }

}

$out = new IO::File $Config{outfile}, 'w';

my $bomtable = Text::Table->new(

        { title => '| ', is_sep => 1 },

        { title => 'id', align => 'right', align_title => 'left' },

        { title => ' | ', is_sep => 1 },

        { title => 'description', align => 'left', align_title => 'left' },

        { title => ' | ', is_sep => 1 },

        { title => 'manufacturer partid', align => 'left', align_title => 'left' },

        { title => ' | ', is_sep => 1 },

        { title => 'manufacturer', align => 'left', align_title => 'left' },

        { title => ' | ', is_sep => 1 },

        { title => 'order code', align => 'left', align_title => 'left' },

        { title => ' | ', is_sep => 1 },

        { title => 'quantity', align => 'right', align_title => 'left' },

        { title => ' | ', is_sep => 1 },

        { title => "price", align => 'right', align_title => 'left' },

        { title => ' | ', is_sep => 1 },

        { title => "cost", align => 'right', align_title => 'left' },

        { title => ' |', is_sep => 1 },

);

my $parttable = Text::Table->new(

        { title => '| ', is_sep => 1 },

        { title => 'id', align => 'right', align_title => 'center' },

        { title => ' | ', is_sep => 1 },

        { title => 'description', align => 'left', align_title => 'center' },

        { title => ' | ', is_sep => 1 },

        { title => 'manufacturer partno', align => 'left', align_title => 'center' },

        { title => ' | ', is_sep => 1 },

        { title => 'footprint', align => 'left', align_title => 'center' },

        { title => ' | ', is_sep => 1 },

        { title => 'refdes', align => 'left', align_title => 'center' },

        { title => ' | ', is_sep => 1 },

        { title => 'sheet', align => 'left', align_title => 'center' },

        { title => ' |', is_sep => 1 },

);

foreach my $id ( sort {my $p = $Inv[$a]{Manufacturer} cmp $Inv[$b]{Manufacturer}; if ($p == 0) {

#               return $Inv[$a]{Manufacturer_Partno} cmp $Inv[$b]{Manufacturer_Partno}}; return $p; }  keys %BomData) {

                return $Inv[$a]{Description} cmp $Inv[$b]{Description}}; return $p; }  keys %BomData) {

        my %tmp;

        map { $tmp{$_} = 1 } @{$BomData{$id}{RefDes}};

        @{$BomData{$id}{RefDes}} = keys %tmp;

        my $quant = 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 = $quant * $Inv[$id]{Price};

#       printf PARTMAP "%-35s|%s\n", shortstring($Inv[$id]{Description},35), join (', ', sort @{$BomData{$id}{RefDes}});

        $cost += $icost;

#       %BomData{ById}{$id}{RefDes}

#       $bomtable->add(' '.$n.' ', $Inv[$id]{Description}.' ', $Inv[$id]{Manufacturer_Partno}.' ', $Inv[$id]{Manufacturer}.' ',

#               $Inv[$id]{Ordercode}.' ', ' '.$quant.' ', sprintf("%.3f ",$Inv[$id]{Price}), sprintf("%.3f ",$icost));

        $bomtable->add($bn++, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $Inv[$id]{Manufacturer},

                $Inv[$id]{Ordercode},$quant, sprintf("%.3f",$Inv[$id]{Price}), sprintf("%.3f",$icost));

#       $parttable->add($pn++, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $BomData{$id}{Footprint}, 

#               strbreak(join (', ', sort @{$BomData{$id}{RefDes}}),43), join("\n",@{$BomData{$id}{Files}}));

}

printf $out "file generated at %s\n\n", scalar localtime(time());

print $out $bomtable->rule('-','+');

print $out $bomtable->title();

print $out $bomtable->rule('-','+');

print $out $bomtable->body();

print $out $bomtable->rule('-','+');

printf $out "\nTotal cost: %.3f\n\n\n", $cost;

$pn = 1;

foreach my $fkey (sort keys %Files) {

        my $rowblock = 0;

        foreach my $id ( sort {my $p = $Inv[$a]{Manufacturer} cmp $Inv[$b]{Manufacturer}; if ($p == 0) {

                return $Inv[$a]{Description} cmp $Inv[$b]{Description}}; return $p; }  keys %{$Files{$fkey}}) {

                $parttable->add($pn++, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $BomData{$id}{Footprint},

                        strbreak(join (', ', sort @{$Files{$fkey}{$id}{RefDes}}),43), $fkey);

        }

        $parttable->add('--','=========','==========','==========','==========','==========');

}

print $out $parttable->rule('-','+');

print $out $parttable->title();

print $out $parttable->rule('-','+');

print $out $parttable->body();

print $out $parttable->rule('-','+');

#close PARTMAP;

printf STDERR "\tFinished, output saved in %s\n", $Config{outfile};