Rev 337 | Rev 419 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
280 | agaran | 1 | #!/usr/bin/perl -w |
2 | use strict; |
||
293 | agaran | 3 | # $Id: inventory.pl 417 2009-05-15 17:21:21Z agaran $ |
280 | agaran | 4 | # Thu, 13 Nov 2008 21:06:23 +0100 |
5 | # Maciej 'agaran' Pijanka <agaran@pld-linux.org> |
||
6 | # for OpenARM SBC Project |
||
7 | # license: gpl v3 |
||
8 | |||
293 | agaran | 9 | |
280 | agaran | 10 | use Getopt::Long qw//; |
293 | agaran | 11 | use File::Basename qw/basename/; |
322 | agaran | 12 | use IO::Dir; |
13 | use IO::File; |
||
417 | agaran | 14 | use Data::Dumper qw/Dumper/; |
280 | agaran | 15 | |
325 | agaran | 16 | use lib File::Basename::dirname($0).'/lib'; |
326 | agaran | 17 | use Text::Table; |
325 | agaran | 18 | |
19 | |||
313 | agaran | 20 | my %Config; |
280 | agaran | 21 | |
313 | agaran | 22 | # ================================================== |
23 | $Config{docdir} = '.'; |
||
24 | $Config{bomdir} = '.'; |
||
25 | $Config{verbose} = 1; |
||
280 | agaran | 26 | |
313 | agaran | 27 | # 0 mean not show, -1 show all, positive value limits depth of shown |
28 | $Config{dbg_showdirs} = 0; |
||
280 | agaran | 29 | |
313 | agaran | 30 | |
31 | # modes |
||
32 | my $build_inventory = 0; |
||
33 | my $build_bom = 0; |
||
34 | my $show_conf = 0; |
||
35 | my $show_help = 0; |
||
36 | |||
37 | # ================================================== |
||
38 | |||
39 | my %Inv_By_PartNo; |
||
40 | my @Inv; |
||
325 | agaran | 41 | my %BomData; |
332 | agaran | 42 | my %Files; |
313 | agaran | 43 | |
293 | agaran | 44 | sub err_printf($@) { |
45 | my ($format, @args) = @_; |
||
280 | agaran | 46 | |
313 | agaran | 47 | printf STDERR "-E- ".$format."\n", @args; |
48 | # exit? or fail-exit here |
||
280 | agaran | 49 | } |
50 | |||
293 | agaran | 51 | sub wrn_printf($@) { |
52 | my ($format, @args) = @_; |
||
328 | agaran | 53 | return if ($Config{verbose} <= 1) ; |
293 | agaran | 54 | printf STDERR "-W- ".$format."\n", @args; |
55 | } |
||
56 | |||
57 | sub inf_printf($@) { |
||
58 | my ($format, @args) = @_; |
||
328 | agaran | 59 | return if ($Config{verbose} <= 2) ; |
293 | agaran | 60 | printf STDERR "-I- ".$format."\n", @args; |
61 | } |
||
62 | |||
313 | agaran | 63 | sub Config_Show { |
64 | printf "Config for %s\n----------------------------------------\n", basename($0); |
||
65 | foreach my $name (sort keys %Config) { |
||
66 | printf "%-20s %s\n", $name, $Config{$name}; |
||
67 | } |
||
68 | } |
||
69 | |||
70 | sub Help_Show { |
||
71 | printf "Help for %s\n----------------------------------------\n", basename($0); |
||
72 | unless (defined($_[1]) && length($_[1]) != 0) { |
||
73 | print "Basic help\n\t--showrc|showconf shows current configuration\n". |
||
74 | "\t--docdir|-d <dir> tells script where information.txt files should be searched\n". |
||
75 | "\t--define <something>=<somethingelseornot> defines some configration value\n". |
||
319 | agaran | 76 | "\t--verbose|-v [level] sets verbosity level\nOrder of options DOES matter\n". |
330 | agaran | 77 | "\t--bomdir|-b <dir> tells script where boms should be searched\n". |
331 | agaran | 78 | "\t--outfile|-o <file> tells where script shall save output data\n". |
337 | agaran | 79 | "\t--force|-f forces script to save data even if file exist already\n". |
80 | "\t-l <num> repeat title for output tables every <num> rows\n"; |
||
319 | agaran | 81 | |
82 | print "\t\e[0;31mThis Help Is created especially for \e[0;33mJelle\e[0;29m\n". |
||
83 | "\tThis script search all directories below specified ones to find interesting files\n"; |
||
313 | agaran | 84 | return; |
85 | } |
||
86 | if ($_[1] =~ /^foo$/) { |
||
87 | print "Noo, there is no foo's here\n"; |
||
88 | } else { |
||
89 | printf "Sorry, help for `%s' don't exist (eventually) yet\n", $_[1]; |
||
90 | } |
||
91 | exit; |
||
92 | } |
||
93 | |||
94 | sub fix_dir ($) { |
||
95 | my $dir = shift @_; |
||
96 | |||
97 | $dir =~ s/\/$//; |
||
98 | |||
99 | if (! -d $dir) { |
||
100 | err_printf("Sorry `%s' is not valid directory, exiting", $dir); |
||
101 | } |
||
102 | |||
103 | return $dir; |
||
104 | } |
||
105 | |||
106 | sub shortdir ($) { |
||
107 | my $path = shift @_; |
||
108 | |||
109 | return substr($path, 2) if ($path =~ /^\.\//) ; |
||
110 | return $path; |
||
111 | } |
||
112 | |||
113 | |||
114 | sub trim($) { |
||
115 | my ($value) = @_; |
||
116 | |||
117 | $value =~ s/^ +//; |
||
118 | $value =~ s/ +$//; |
||
119 | return $value; |
||
120 | } |
||
121 | |||
122 | sub etrim($) { |
||
123 | my ($value) = @_; |
||
124 | |||
125 | $value =~ s/^[ ]+//; |
||
126 | $value =~ s/[ ]+$//; |
||
127 | return $value; |
||
128 | } |
||
129 | |||
330 | agaran | 130 | sub strbreak($$) { |
325 | agaran | 131 | my ($str,$lim) = @_; |
334 | agaran | 132 | my @p = split /\ /,$str; |
330 | agaran | 133 | $str = ''; |
134 | my $l = 0; |
||
135 | while (@p) { |
||
136 | my $e = shift @p; |
||
137 | if ($l + length ($e) +1 > $lim) { |
||
138 | $str .= "\n".$e; |
||
139 | $l = length $e; |
||
140 | } else { |
||
141 | $str .= " ".$e; |
||
142 | $l += length($e) + 1; |
||
143 | } |
||
144 | } |
||
325 | agaran | 145 | return $str; |
146 | } |
||
147 | |||
417 | agaran | 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 | |||
313 | agaran | 174 | # this subroutine is used as callback function |
175 | # executed by file_lookup |
||
280 | agaran | 176 | sub parse_ifile($) { |
293 | agaran | 177 | my ($filepath) = @_; |
280 | agaran | 178 | |
318 | agaran | 179 | |
293 | agaran | 180 | open(IN, $filepath) or return 1; |
280 | agaran | 181 | |
293 | agaran | 182 | my %data; |
417 | agaran | 183 | my $lineno = 0; |
280 | agaran | 184 | |
417 | agaran | 185 | my $_ok; |
186 | |||
293 | agaran | 187 | while (not eof IN) { |
188 | my $line = <IN>; |
||
417 | agaran | 189 | $lineno++; |
280 | agaran | 190 | |
293 | agaran | 191 | chomp $line; |
280 | agaran | 192 | |
293 | agaran | 193 | next if ($line =~ /^[ ]*$/); |
194 | next if ($line =~ /^;/); |
||
195 | |||
196 | last if ($line =~ /^--/); |
||
197 | |||
198 | if ($line =~ /^([A-Za-z ]+):(.*)$/) { |
||
313 | agaran | 199 | my ($name,$value) = (lc etrim($1),etrim($2)); |
293 | agaran | 200 | |
201 | if ($name =~ /^price$/) { |
||
417 | agaran | 202 | $value =~ s/[^0-9\.\,]//g; # remove any characters beside DIGITS |
293 | agaran | 203 | if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) { |
204 | # printf STDERR "Price %.3f\n", $value; |
||
205 | if (!defined($data{price})) { |
||
206 | $data{price} = $value; |
||
417 | agaran | 207 | $_ok->{$name} = 1; |
293 | agaran | 208 | } else { |
313 | agaran | 209 | wrn_printf("Duplicated price field in file %s", shortdir($filepath)); |
293 | agaran | 210 | } |
211 | } else { |
||
313 | agaran | 212 | err_printf("Bad price field in file %s", shortdir($filepath)); |
293 | agaran | 213 | } |
214 | } elsif ($name =~ /^manufacturer$/i) { |
||
215 | # printf STDERR "Manufacturer %s\n", $value; |
||
216 | if (!defined($data{manufacturer})) { |
||
217 | $data{manufacturer} = $value; |
||
417 | agaran | 218 | $_ok->{$name} = 1; |
293 | agaran | 219 | } else { |
313 | agaran | 220 | wrn_printf("Duplicated manufacturer field in file %s", shortdir($filepath)); |
293 | agaran | 221 | } |
222 | } elsif ($name =~ /^manufacturer part no$/ ) { |
||
223 | # printf STDERR "ManPartNo %s\n", $value; |
||
224 | if (!defined($data{manufact_partno})) { |
||
313 | agaran | 225 | $data{manufact_partno} = trim($value); |
417 | agaran | 226 | $_ok->{$name} = 1; |
293 | agaran | 227 | } else { |
228 | wrn_printf("Duplicated manufacturer part no field in file %s", |
||
313 | agaran | 229 | shortdir($filepath)); |
293 | agaran | 230 | } |
231 | } elsif ($name =~ /^description$/i) { |
||
313 | agaran | 232 | if (!defined($data{desc})) { |
233 | $data{desc} = $value; |
||
234 | } else { |
||
235 | wrn_printf("Duplicated description no field in file %s", |
||
236 | shortdir($filepath)); |
||
237 | } |
||
293 | agaran | 238 | } elsif ($name =~ /^datasheet$/i) { |
239 | $data{datasheet} = [] unless defined $data{datasheet}; |
||
240 | push @{$data{datasheet}}, $value; |
||
241 | # printf STDERR "Datasheet %s\n", $value; |
||
242 | } elsif ($name =~ /^supplier$/i) { |
||
243 | # printf STDERR "Supplier %s\n", $value; |
||
244 | if (!defined($data{supplier})) { |
||
245 | $data{supplier} = $value; |
||
417 | agaran | 246 | $_ok->{$name} = 1; |
293 | agaran | 247 | } else { |
248 | wrn_printf("Duplicated supplier field in file %s", |
||
313 | agaran | 249 | shortdir($filepath)); |
293 | agaran | 250 | } |
251 | } elsif ($name =~ /^order code$/) { |
||
252 | # printf STDERR "Order Code %s\n", $value; |
||
253 | if (!defined($data{ordercode})) { |
||
254 | $data{ordercode} = $value; |
||
417 | agaran | 255 | $_ok->{$name} = 1; |
293 | agaran | 256 | } else { |
257 | wrn_printf("Duplicated order code field in file %s", |
||
313 | agaran | 258 | shortdir($filepath)); |
293 | agaran | 259 | } |
260 | #push @DATA, { $name => $value }; |
||
261 | } elsif ($name =~ /^url .*$/) { |
||
262 | # printf STDERR "URL %s\n", $value; |
||
263 | } elsif ($name =~ /^catalog(ue|) page$/) { |
||
264 | # printf STDERR "Catalogue Page %s\n", $value; |
||
265 | } else { |
||
266 | err_printf("Unhandled field %s in file %s", $name, |
||
313 | agaran | 267 | shortdir($filepath)); |
293 | agaran | 268 | } |
417 | agaran | 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}); |
||
293 | agaran | 275 | |
417 | agaran | 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 | } |
||
293 | agaran | 288 | } else { |
328 | agaran | 289 | wrn_printf("Unparseable line `%s', forgot ; to set it as comment in file %s", $line, |
313 | agaran | 290 | shortdir($filepath)); |
293 | agaran | 291 | } |
292 | } |
||
293 | close(IN); |
||
294 | |||
295 | if (scalar keys %data == 0) { |
||
417 | agaran | 296 | inf_printf("Skipping file %s because contain no data for me", shortdir($filepath)); |
293 | agaran | 297 | return; |
298 | } |
||
299 | |||
417 | agaran | 300 | foreach my $field (split /\!/, q/price!manufacturer part no!order code/) { |
301 | wrn_printf("Missing ".(ucfirst $field)." in file %s", shortdir($filepath)) unless ($_ok->{$field}); |
||
293 | agaran | 302 | } |
313 | agaran | 303 | |
304 | |||
305 | my $id = scalar @Inv; |
||
306 | |||
307 | $Inv[$id] = {}; |
||
308 | |||
309 | $Inv[$id]{Datasheet} = delete $data{'datasheet'} if defined $data{'datasheet'}; |
||
334 | agaran | 310 | $Inv[$id]{Manufacturer} = etrim(trim(delete $data{'manufacturer'})) if defined $data{'manufacturer'}; |
311 | $Inv[$id]{Description} = etrim(trim(delete $data{'desc'})) if defined $data{'desc'}; |
||
313 | agaran | 312 | $Inv[$id]{Price} = delete $data{'price'} if defined $data{'price'}; |
334 | agaran | 313 | $Inv[$id]{Ordercode} = etrim(trim(delete $data{'ordercode'})) if defined $data{'ordercode'}; |
314 | $Inv[$id]{Manufacturer_Partno} = etrim(trim(delete $data{'manufact_partno'})) if defined $data{'manufact_partno'}; |
||
313 | agaran | 315 | $Inv[$id]{Supplier} = delete $data{'supplier'} if defined $data{'supplier'}; |
316 | |||
317 | unless (defined ($Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno}})) { |
||
318 | $Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno}} = $id; |
||
319 | } else { |
||
320 | wrn_printf("PartNumber %s happened more than once, using first occurence (id:%d)", |
||
321 | $Inv[$id]{Manufacturer_Partno}, $id); |
||
322 | } |
||
325 | agaran | 323 | |
313 | agaran | 324 | #inf_printf("Part %s defined in file %s", $Inv[$id]{Manufacturer_Partno}, shortdir($filepath)); |
293 | agaran | 325 | |
313 | agaran | 326 | wrn_printf("Unhandled data from parsing: %s", Dumper(\%data)) if (scalar keys %data > 0); |
280 | agaran | 327 | } |
328 | |||
329 | |||
313 | agaran | 330 | sub parse_bom ($) { |
331 | my ($filepath) = @_; |
||
280 | agaran | 332 | |
313 | agaran | 333 | open(IN, $filepath) or return 1; |
332 | agaran | 334 | my $fkey = substr(basename($filepath),0,length(basename($filepath))-4); |
313 | agaran | 335 | |
336 | #wrn_printf("GotARg: %s", shortdir($filepath)); |
||
337 | |||
338 | my @Fields; |
||
339 | |||
340 | my %data; |
||
341 | my $v = ''; |
||
342 | while (not eof IN) { |
||
343 | my $line = <IN>; |
||
344 | |||
345 | chomp $line; |
||
346 | |||
347 | if ($line =~ /^\.START$/) { |
||
348 | $v = 'boms'; |
||
349 | next; |
||
350 | } |
||
351 | |||
352 | if ($line =~ /^\.END$/) { |
||
353 | $v = ''; |
||
354 | next; |
||
355 | } |
||
356 | |||
357 | if ($v eq 'boms') { |
||
358 | @Fields = split(/\t/, substr($line,2)); |
||
359 | $v = 'bom'; |
||
360 | # some funny way to generate field-map |
||
361 | # that if someone reorder bom file columns we are still on place |
||
362 | next; |
||
363 | } |
||
364 | |||
365 | if ($v eq 'bom') { |
||
366 | my ($refdes, $device, $value, $footprint, $quantity) = split (/\t/, $line); |
||
367 | |||
368 | $device = trim($device); |
||
369 | |||
370 | # wrn_printf("Device: %s (value: %s) at refdes %s, %d pcs", $device, $value, $refdes, $quantity); |
||
371 | |||
372 | if (!defined $Inv_By_PartNo{$device}) { |
||
373 | wrn_printf("Device %s not found in inventory in file %s", $device, shortdir($filepath)); |
||
374 | next; |
||
375 | } |
||
376 | my $id = $Inv_By_PartNo{$device}; |
||
377 | next if ($Inv[$id]{Manufacturer} =~ /none/i); # skip parts whose manufacturer is none |
||
378 | #inf_printf("Found in Inventory at %d %s", $id, $Inv[$id]{Manufacturer_Partno}); |
||
334 | agaran | 379 | push @{$data{$id}{RefDes}}, etrim(trim($refdes)); |
330 | agaran | 380 | if (!defined $data{$id}{Footprint}) { |
381 | $data{$id}{Footprint} = $footprint; |
||
382 | } else { |
||
383 | if ($data{$id}{Footprint} ne $footprint) { |
||
384 | err_printf("Different footprints for same device in within single bom file, script ". |
||
385 | "cannot work around this, will use first one, but expect that output file ". |
||
386 | "might have errors."); |
||
387 | } |
||
388 | } |
||
313 | agaran | 389 | } |
390 | } |
||
391 | close(IN); |
||
392 | |||
393 | if (scalar keys %data == 0) { |
||
394 | inf_printf("Skipping file %s because contain no data for me", |
||
395 | shortdir($filepath)); |
||
396 | return; |
||
397 | } |
||
398 | |||
399 | foreach my $id (keys %data) { |
||
400 | my %tmp; |
||
401 | map { $tmp{$_} = 1 } @{$data{$id}{RefDes}}; |
||
402 | @{$data{$id}{RefDes}} = keys %tmp; |
||
403 | my $cnt = scalar @{$data{$id}{RefDes}}; |
||
318 | agaran | 404 | push @{$BomData{$id}{RefDes}}, @{$data{$id}{RefDes}}; |
330 | agaran | 405 | if (!defined $BomData{$id}{Footprint}) { |
406 | $BomData{$id}{Footprint} = $data{$id}{Footprint}; |
||
407 | } else { |
||
408 | if ($data{$id}{Footprint} ne $data{$id}{Footprint}) { |
||
409 | err_printf("Different footprints for same device between sheets, script cannot ". |
||
410 | "work around this, will use first one, but expect that output file might ". |
||
411 | "have errors."); |
||
412 | } |
||
413 | } |
||
332 | agaran | 414 | push @{$BomData{$id}{Files}}, $fkey; |
415 | push @{$Files{$fkey}{$id}{RefDes}}, @{$data{$id}{RefDes}}; |
||
318 | agaran | 416 | |
313 | agaran | 417 | # printf "%-20s %.4f %s\n", $Inv[$id]{Manufacturer_Partno}, $cnt, $icost, join (', ', @{$data{$id}{RefDes}}); |
418 | # %BomData{ById}{$id}{RefDes} |
||
419 | } |
||
420 | } |
||
421 | |||
422 | sub file_lookup ($$$$) ; |
||
423 | sub file_lookup ($$$$) { |
||
424 | my ($dir, $depth, $regexp, $callback) = @_; |
||
425 | |||
426 | err_printf("Sorry, callback must be CODE ref") unless (ref $callback eq 'CODE'); |
||
427 | |||
293 | agaran | 428 | if ( -d $dir) { |
322 | agaran | 429 | my $d = IO::Dir->new($dir); |
430 | return 1 if (!defined $d); |
||
431 | |||
432 | |||
433 | while (defined(my $e = $d->read)) { |
||
293 | agaran | 434 | my $fe = $dir .'/'. $e; |
435 | if ( -f $fe) { |
||
313 | agaran | 436 | if ($fe =~ $regexp) { |
437 | &$callback($fe); |
||
293 | agaran | 438 | } |
439 | } elsif (-d $fe) { # now its dir... |
||
440 | if ($e eq '.svn') { # if entry name is equal to svn |
||
441 | next; # go to next entry in foreach loop |
||
442 | } |
||
443 | next if ($e eq '.' or $e eq '..'); # skip to next if dir entry is . or .. |
||
281 | jelle | 444 | |
313 | agaran | 445 | if ($Config{dbg_showdirs} == -1 or $Config{dbg_showdirs} > $depth) { |
446 | printf STDERR "Entering directory %s\n", shortdir($fe); |
||
293 | agaran | 447 | } |
313 | agaran | 448 | return 1 if (file_lookup($fe, $depth+1, $regexp, $callback) == 1); |
293 | agaran | 449 | } else { |
313 | agaran | 450 | # symlink or other mysterius beast |
293 | agaran | 451 | } |
452 | } |
||
453 | } |
||
313 | agaran | 454 | return 0; |
280 | agaran | 455 | } |
456 | |||
293 | agaran | 457 | Getopt::Long::Configure("bundling"); |
280 | agaran | 458 | |
319 | agaran | 459 | if (scalar @ARGV == 0) { |
460 | Help_Show(); |
||
461 | exit; |
||
462 | } |
||
463 | |||
313 | agaran | 464 | my $result = Getopt::Long::GetOptions ( |
465 | "showrc|showconf" => sub { $show_conf = 1 }, |
||
466 | "docdir|d=s" => sub { $Config{docdir} = $_[1]; }, |
||
467 | # not sure if bomdir or SCH dir |
||
468 | "bomdir|b=s" => sub { $Config{$_[0]} = $_[1]; }, # $_[0] contain basename of option, so in few cases could be (ab)used |
||
469 | "define|D=s" => sub { my ($p,$q) = split(/=/,$_[1],2); $Config{$p} = $q; }, |
||
470 | "verbose|v:+" => sub { $Config{$_[0]} = ($_[1]>1?0:$Config{$_[0]}) + $_[1]; }, |
||
330 | agaran | 471 | "help|h|?:s" => sub { $show_help = 1; }, |
472 | "outfile|o=s" => sub { $Config{$_[0]} = $_[1]; }, |
||
473 | "force|f" => sub { $Config{$_[0]} = 1 }, |
||
337 | agaran | 474 | "lines|l=i" => sub { $Config{$_[0]} = abs(int($_[1]));}, |
313 | agaran | 475 | |
476 | # options |
||
293 | agaran | 477 | ); |
478 | if (!$result) { |
||
479 | printf "Usage: %s [-d directory] [-v]\n",basename($0); |
||
480 | exit; |
||
481 | } |
||
313 | agaran | 482 | |
483 | # ================================================== |
||
484 | # processing of options/config values, checking ranges etc |
||
485 | # |
||
486 | |||
487 | $Config{docdir} = fix_dir ($Config{docdir}); |
||
488 | $Config{bomdir} = fix_dir ($Config{bomdir}); |
||
489 | |||
490 | if ( $show_help == 1) { |
||
491 | Help_Show(); |
||
492 | exit; |
||
293 | agaran | 493 | } |
494 | |||
313 | agaran | 495 | if ( $show_conf == 1) { |
496 | Config_Show(); |
||
497 | exit; |
||
498 | } |
||
293 | agaran | 499 | |
313 | agaran | 500 | # make Inventory |
328 | agaran | 501 | printf STDERR "Indexing information.txt (under %s)\n",shortdir($Config{docdir}); |
313 | agaran | 502 | file_lookup($Config{docdir}, 0, qr/\/information.txt$/, \&parse_ifile); |
328 | agaran | 503 | printf STDERR "\tFinished, %d entries loaded\n", scalar(@Inv)+1; |
313 | agaran | 504 | |
505 | # process BOM files |
||
328 | agaran | 506 | printf STDERR "Loading bom data from %s\n", shortdir($Config{bomdir}); |
313 | agaran | 507 | file_lookup($Config{bomdir}, 0, qr/\.bom$/, \&parse_bom); |
328 | agaran | 508 | printf STDERR "\tLoaded, now processing\n"; |
313 | agaran | 509 | |
330 | agaran | 510 | my ($bn,$pn) = (1,1); |
318 | agaran | 511 | my $cost = 0.0; |
512 | |||
330 | agaran | 513 | my $out; |
514 | if (!defined $Config{outfile}) { |
||
515 | $Config{outfile} = './output.txt'; |
||
516 | wrn_printf("Output file not specified, saving out in ".$Config{outfile}); |
||
517 | } |
||
318 | agaran | 518 | |
330 | agaran | 519 | if ( -e $Config{outfile}) { |
520 | unless (defined $Config{force} && $Config{force} == 1) { |
||
521 | inf_printf("Unlinking output.txt before owrewriting"); |
||
522 | unlink($Config{outfile}); |
||
523 | } else { |
||
524 | wrn_printf("Output file already exist, add --force if i shall overwrite it"); |
||
525 | exit; |
||
526 | } |
||
527 | } |
||
318 | agaran | 528 | |
330 | agaran | 529 | $out = new IO::File $Config{outfile}, 'w'; |
318 | agaran | 530 | |
325 | agaran | 531 | my $bomtable = Text::Table->new( |
327 | agaran | 532 | { title => '| ', is_sep => 1 }, |
329 | jelle | 533 | { title => 'id', align => 'right', align_title => 'left' }, |
327 | agaran | 534 | { title => ' | ', is_sep => 1 }, |
329 | jelle | 535 | { title => 'description', align => 'left', align_title => 'left' }, |
327 | agaran | 536 | { title => ' | ', is_sep => 1 }, |
329 | jelle | 537 | { title => 'manufacturer partid', align => 'left', align_title => 'left' }, |
327 | agaran | 538 | { title => ' | ', is_sep => 1 }, |
329 | jelle | 539 | { title => 'manufacturer', align => 'left', align_title => 'left' }, |
327 | agaran | 540 | { title => ' | ', is_sep => 1 }, |
329 | jelle | 541 | { title => 'order code', align => 'left', align_title => 'left' }, |
327 | agaran | 542 | { title => ' | ', is_sep => 1 }, |
329 | jelle | 543 | { title => 'quantity', align => 'right', align_title => 'left' }, |
327 | agaran | 544 | { title => ' | ', is_sep => 1 }, |
329 | jelle | 545 | { title => "price", align => 'right', align_title => 'left' }, |
327 | agaran | 546 | { title => ' | ', is_sep => 1 }, |
329 | jelle | 547 | { title => "cost", align => 'right', align_title => 'left' }, |
327 | agaran | 548 | { title => ' |', is_sep => 1 }, |
325 | agaran | 549 | ); |
330 | agaran | 550 | |
551 | my $parttable = Text::Table->new( |
||
552 | { title => '| ', is_sep => 1 }, |
||
553 | { title => 'id', align => 'right', align_title => 'center' }, |
||
554 | { title => ' | ', is_sep => 1 }, |
||
555 | { title => 'description', align => 'left', align_title => 'center' }, |
||
556 | { title => ' | ', is_sep => 1 }, |
||
335 | agaran | 557 | { title => 'manufacturer partid', align => 'left', align_title => 'center' }, |
330 | agaran | 558 | { title => ' | ', is_sep => 1 }, |
559 | { title => 'footprint', align => 'left', align_title => 'center' }, |
||
560 | { title => ' | ', is_sep => 1 }, |
||
561 | { title => 'refdes', align => 'left', align_title => 'center' }, |
||
562 | { title => ' | ', is_sep => 1 }, |
||
563 | { title => 'sheet', align => 'left', align_title => 'center' }, |
||
564 | { title => ' |', is_sep => 1 }, |
||
565 | ); |
||
325 | agaran | 566 | |
567 | foreach my $id ( sort {my $p = $Inv[$a]{Manufacturer} cmp $Inv[$b]{Manufacturer}; if ($p == 0) { |
||
568 | # return $Inv[$a]{Manufacturer_Partno} cmp $Inv[$b]{Manufacturer_Partno}}; return $p; } keys %BomData) { |
||
569 | return $Inv[$a]{Description} cmp $Inv[$b]{Description}}; return $p; } keys %BomData) { |
||
318 | agaran | 570 | my %tmp; |
571 | map { $tmp{$_} = 1 } @{$BomData{$id}{RefDes}}; |
||
572 | @{$BomData{$id}{RefDes}} = keys %tmp; |
||
325 | agaran | 573 | my $quant = scalar @{$BomData{$id}{RefDes}}; |
417 | agaran | 574 | my $price = get_price($id,$quant); |
575 | if ($price == 0) { |
||
576 | wrn_printf("%s has zero price", $Inv[$id]{Manufacturer_Partno}); |
||
318 | agaran | 577 | } |
417 | agaran | 578 | my $icost = $quant * $price; |
318 | agaran | 579 | |
330 | agaran | 580 | # printf PARTMAP "%-35s|%s\n", shortstring($Inv[$id]{Description},35), join (', ', sort @{$BomData{$id}{RefDes}}); |
318 | agaran | 581 | $cost += $icost; |
582 | # %BomData{ById}{$id}{RefDes} |
||
327 | agaran | 583 | # $bomtable->add(' '.$n.' ', $Inv[$id]{Description}.' ', $Inv[$id]{Manufacturer_Partno}.' ', $Inv[$id]{Manufacturer}.' ', |
584 | # $Inv[$id]{Ordercode}.' ', ' '.$quant.' ', sprintf("%.3f ",$Inv[$id]{Price}), sprintf("%.3f ",$icost)); |
||
330 | agaran | 585 | $bomtable->add($bn++, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $Inv[$id]{Manufacturer}, |
417 | agaran | 586 | $Inv[$id]{Ordercode},$quant, sprintf("%.3f",$price), sprintf("%.3f",$icost)); |
330 | agaran | 587 | |
332 | agaran | 588 | # $parttable->add($pn++, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $BomData{$id}{Footprint}, |
589 | # strbreak(join (', ', sort @{$BomData{$id}{RefDes}}),43), join("\n",@{$BomData{$id}{Files}})); |
||
318 | agaran | 590 | } |
591 | |||
332 | agaran | 592 | |
325 | agaran | 593 | printf $out "file generated at %s\n\n", scalar localtime(time()); |
594 | |||
595 | print $out $bomtable->rule('-','+'); |
||
596 | print $out $bomtable->title(); |
||
597 | print $out $bomtable->rule('-','+'); |
||
337 | agaran | 598 | unless (defined $Config{'lines'}) { |
599 | print $out $bomtable->body(); |
||
600 | } else { |
||
601 | my @p = split(/\n/,$bomtable->body()); |
||
602 | while (@p) { |
||
603 | my @sub = splice @p,0,$Config{'lines'}; |
||
604 | print $out join("\n",@sub)."\n"; |
||
605 | if (scalar @p > 0) { |
||
606 | print $out $bomtable->rule('-','+'); |
||
607 | print $out $bomtable->title(); |
||
608 | print $out $bomtable->rule('-','+'); |
||
609 | } |
||
610 | } |
||
611 | } |
||
325 | agaran | 612 | print $out $bomtable->rule('-','+'); |
613 | |||
330 | agaran | 614 | printf $out "\nTotal cost: %.3f\n\n\n", $cost; |
325 | agaran | 615 | |
332 | agaran | 616 | |
333 | agaran | 617 | $pn = 1; |
332 | agaran | 618 | foreach my $fkey (sort keys %Files) { |
619 | my $rowblock = 0; |
||
620 | foreach my $id ( sort {my $p = $Inv[$a]{Manufacturer} cmp $Inv[$b]{Manufacturer}; if ($p == 0) { |
||
621 | return $Inv[$a]{Description} cmp $Inv[$b]{Description}}; return $p; } keys %{$Files{$fkey}}) { |
||
622 | |||
334 | agaran | 623 | my @p = split(/\n/, strbreak(join (', ', sort @{$Files{$fkey}{$id}{RefDes}}),43)); |
624 | while (@p) { |
||
625 | $parttable->add($pn, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $BomData{$id}{Footprint}, |
||
626 | etrim(trim(shift @p)), $fkey); |
||
627 | } |
||
332 | agaran | 628 | |
334 | agaran | 629 | $pn++; |
332 | agaran | 630 | } |
631 | $parttable->add('--','=========','==========','==========','==========','=========='); |
||
632 | } |
||
633 | |||
330 | agaran | 634 | print $out $parttable->rule('-','+'); |
635 | print $out $parttable->title(); |
||
636 | print $out $parttable->rule('-','+'); |
||
337 | agaran | 637 | unless (defined $Config{'lines'}) { |
638 | print $out $parttable->body(); |
||
639 | } else { |
||
640 | my @p = split(/\n/,$parttable->body()); |
||
641 | while (@p) { |
||
642 | my @sub = splice @p,0,$Config{'lines'}; |
||
643 | print $out join("\n",@sub)."\n"; |
||
644 | if (scalar @p > 0) { |
||
645 | print $out $parttable->rule('-','+'); |
||
646 | print $out $parttable->title(); |
||
647 | print $out $parttable->rule('-','+'); |
||
648 | } |
||
649 | } |
||
650 | } |
||
330 | agaran | 651 | print $out $parttable->rule('-','+'); |
325 | agaran | 652 | |
330 | agaran | 653 | |
654 | #close PARTMAP; |
||
655 | |||
656 | printf STDERR "\tFinished, output saved in %s\n", $Config{outfile}; |