WebSVN - OpenARM Single-board Computer - Diff - Rev 419 and 428



#!/usr/bin/perl -w
use strict;
# $Id: inventory.pl 428 2009-07-15 21:37:16Z 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 Data::Dumper qw/Dumper/;

        $value =~ s/^[  ]+//;
        $value =~ s/[   ]+$//;
        return $value;
}

# break string at $lim character (or bit before) 
# but only on whitespaces
sub strbreak($$) {
        my ($str,$lim) = @_;
        my @p = split /\ /,$str;
        $str = '';
        my $l = 0;

                wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno});
                return 0.0;
        }

        if (ref $Inv[$id]{Price} eq 'ARRAY') { # handle structured prices
                my ($ret,$li) = (0,0);
                foreach my $pd (@{$Inv[$id]{Price}}) {
                        if (ref $pd eq 'ARRAY') {
                                my ($rmin,$rmax) = split '-', $pd->[0];
                                if ($rmin > $li && $quantity >= $rmin) {
                                        $ret = $pd->[1];
                                        $li = $rmin;
                                }
                                #inf_printf("Debuging %s, %s %d",$pd->[0], $ret, $quantity);
                        }
                }
                return $ret;
        }


# this subroutine is used as callback function
# executed by file_lookup
sub parse_ifile($) {
        my ($filepath) = @_;

 
        open(IN, $filepath) or return 1;

        my %data;

        $file_name = $filepath;

                        }
                } elsif ($line =~ /^([A-Za-z ]+)[ \t]*\(([A-Za-z 0-9\(\)\-]+)\)[ \t]*:(.*)$/) {
                        my ($name, $extdata, $value) = (lc etrim($1),etrim($2),etrim($3));
                        if ($name =~ /^price$/) {
                                $extdata =~ s/ //g;
                                #wrn_printf("Extended-Price <%s> <%s> at %s:%d", $extdata, $value, shortdir($filepath), $file_line);
                                $data{price} = [] if (!defined $data{price});

                                if(ref $data{price} eq 'ARRAY') {
                                        $value =~ s/[^0-9\.\,]//g; # remove any characters beside DIGITS
                                        if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) {


sub gen_bomfile ($) { # {{{1
        my $outfile = shift @_;

        if (-e $outfile) {
                wrn_printf("File already exist, will overwrite");
        }

        my $out = new IO::File $outfile, 'w';

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


sub gen_mapfile ($) { # {{{1
        my $outfile = shift @_;

        if (-e $outfile) {
                wrn_printf("File already exist, will overwrite");
        }

        my $out = new IO::File $outfile, 'w';

        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 => 'left' },
                { title => ' | ', is_sep => 1 },
                { title => 'manufacturer partid', align => 'left', align_title => 'left' },
                { title => ' | ', is_sep => 1 },
                { title => 'footprint', align => 'left', align_title => 'left' },
                { title => ' | ', is_sep => 1 },
                { title => 'refdes', align => 'left', align_title => 'left' },
                { title => ' | ', is_sep => 1 },
                { title => 'sheet', align => 'left', align_title => 'left' },
                { title => ' |', is_sep => 1 },
        );
       
        my ($pn) = (1);
       

Rev 419	Rev 428
Line 1...	Line 1...
1	#!/usr/bin/perl -w	1	#!/usr/bin/perl -w
2	use strict;	2	use strict;
3	# $Id: inventory.pl 419 2009-05-16 00:01:56Z agaran $	3	# $Id: inventory.pl 428 2009-07-15 21:37:16Z 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		-
10	use Getopt::Long qw//;	9	use Getopt::Long qw//;
11	use File::Basename qw/basename/;	10	use File::Basename qw/basename/;
12	use IO::Dir;	11	use IO::Dir;
13	use IO::File;	12	use IO::File;
14	use Data::Dumper qw/Dumper/;	13	use Data::Dumper qw/Dumper/;
Line 157...	Line 156...
157	$value =~ s/^[ ]+//;	156	$value =~ s/^[ ]+//;
158	$value =~ s/[ ]+$//;	157	$value =~ s/[ ]+$//;
159	return $value;	158	return $value;
160	}	159	}
161		160
-		161	# break string at $lim character (or bit before)
-		162	# but only on whitespaces
162	sub strbreak($$) {	163	sub strbreak($$) {
163	my ($str,$lim) = @_;	164	my ($str,$lim) = @_;
164	my @p = split /\ /,$str;	165	my @p = split /\ /,$str;
165	$str = '';	166	$str = '';
166	my $l = 0;	167	my $l = 0;
Line 186...	Line 187...
186	wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno});	187	wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno});
187	return 0.0;	188	return 0.0;
188	}	189	}
189		190
190	if (ref $Inv[$id]{Price} eq 'ARRAY') { # handle structured prices	191	if (ref $Inv[$id]{Price} eq 'ARRAY') { # handle structured prices
191	my $ret = 0;	192	my ($ret,$li) = (0,0);
192	foreach my $pd (@{$Inv[$id]{Price}}) {	193	foreach my $pd (@{$Inv[$id]{Price}}) {
193	if (ref $pd eq 'ARRAY') {	194	if (ref $pd eq 'ARRAY') {
194	my ($rmin,$rmax) = split '-', $pd->[0];	195	my ($rmin,$rmax) = split '-', $pd->[0];
195	$ret = $pd->[1] if ($quantity >= $rmin);	196	if ($rmin > $li && $quantity >= $rmin) {
-		197	$ret = $pd->[1];
-		198	$li = $rmin;
-		199	}
-		200	#inf_printf("Debuging %s, %s %d",$pd->[0], $ret, $quantity);
196	}	201	}
197	}	202	}
198	return $ret;	203	return $ret;
199	}	204	}
200		205
Line 206...	Line 211...
206	# this subroutine is used as callback function	211	# this subroutine is used as callback function
207	# executed by file_lookup	212	# executed by file_lookup
208	sub parse_ifile($) {	213	sub parse_ifile($) {
209	my ($filepath) = @_;	214	my ($filepath) = @_;
210		215
211		-
212	open(IN, $filepath) or return 1;	216	open(IN, $filepath) or return 1;
213		217
214	my %data;	218	my %data;
215		219
216	$file_name = $filepath;	220	$file_name = $filepath;
Line 296...	Line 300...
296	}	300	}
297	} elsif ($line =~ /^([A-Za-z ]+)[ \t]\(([A-Za-z 0-9\(\)\-]+)\)[ \t]:(.*)$/) {	301	} elsif ($line =~ /^([A-Za-z ]+)[ \t]\(([A-Za-z 0-9\(\)\-]+)\)[ \t]:(.*)$/) {
298	my ($name, $extdata, $value) = (lc etrim($1),etrim($2),etrim($3));	302	my ($name, $extdata, $value) = (lc etrim($1),etrim($2),etrim($3));
299	if ($name =~ /^price$/) {	303	if ($name =~ /^price$/) {
300	$extdata =~ s/ //g;	304	$extdata =~ s/ //g;
301	#wrn_printf("Extended-Price <%s> <%s> at %s:%d", $extdata, $value, shortdir($filepath), $lineno);	305	#wrn_printf("Extended-Price <%s> <%s> at %s:%d", $extdata, $value, shortdir($filepath), $file_line);
302	$data{price} = [] if (!defined $data{price});	306	$data{price} = [] if (!defined $data{price});
303		307
304	if(ref $data{price} eq 'ARRAY') {	308	if(ref $data{price} eq 'ARRAY') {
305	$value =~ s/[^0-9\.\,]//g; # remove any characters beside DIGITS	309	$value =~ s/[^0-9\.\,]//g; # remove any characters beside DIGITS
306	if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) {	310	if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) {
Line 488...	Line 492...
488		492
489	sub gen_bomfile ($) { # {{{1	493	sub gen_bomfile ($) { # {{{1
490	my $outfile = shift @_;	494	my $outfile = shift @_;
491		495
492	if (-e $outfile) {	496	if (-e $outfile) {
493	wrn_printf("File already exist");	497	wrn_printf("File already exist, will overwrite");
494	}	498	}
495		499
496	my $out = new IO::File $outfile, 'w';	500	my $out = new IO::File $outfile, 'w';
497		501
498	my $bomtable = Text::Table->new(	502	my $bomtable = Text::Table->new(
Line 571...	Line 575...
571		575
572	sub gen_mapfile ($) { # {{{1	576	sub gen_mapfile ($) { # {{{1
573	my $outfile = shift @_;	577	my $outfile = shift @_;
574		578
575	if (-e $outfile) {	579	if (-e $outfile) {
576	wrn_printf("File already exist");	580	wrn_printf("File already exist, will overwrite");
577	}	581	}
578		582
579	my $out = new IO::File $outfile, 'w';	583	my $out = new IO::File $outfile, 'w';
580		584
581	my $parttable = Text::Table->new(	585	my $parttable = Text::Table->new(
582	{ title => '\| ', is_sep => 1 },	586	{ title => '\| ', is_sep => 1 },
583	{ title => 'id', align => 'right', align_title => 'center' },	587	{ title => 'id', align => 'right', align_title => 'center' },
584	{ title => ' \| ', is_sep => 1 },	588	{ title => ' \| ', is_sep => 1 },
585	{ title => 'description', align => 'left', align_title => 'center' },	589	{ title => 'description', align => 'left', align_title => 'left' },
586	{ title => ' \| ', is_sep => 1 },	590	{ title => ' \| ', is_sep => 1 },
587	{ title => 'manufacturer partid', align => 'left', align_title => 'center' },	591	{ title => 'manufacturer partid', align => 'left', align_title => 'left' },
588	{ title => ' \| ', is_sep => 1 },	592	{ title => ' \| ', is_sep => 1 },
589	{ title => 'footprint', align => 'left', align_title => 'center' },	593	{ title => 'footprint', align => 'left', align_title => 'left' },
590	{ title => ' \| ', is_sep => 1 },	594	{ title => ' \| ', is_sep => 1 },
591	{ title => 'refdes', align => 'left', align_title => 'center' },	595	{ title => 'refdes', align => 'left', align_title => 'left' },
592	{ title => ' \| ', is_sep => 1 },	596	{ title => ' \| ', is_sep => 1 },
593	{ title => 'sheet', align => 'left', align_title => 'center' },	597	{ title => 'sheet', align => 'left', align_title => 'left' },
594	{ title => ' \|', is_sep => 1 },	598	{ title => ' \|', is_sep => 1 },
595	);	599	);
596		600
597	my ($pn) = (1);	601	my ($pn) = (1);
598		602

Subversion Repositories OpenARM Single-board Computer

(root)/trunk/working/scripts/inventory.pl - Rev 419 → 428