Rev 417 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed
| Rev 417 | Rev 419 | ||
|---|---|---|---|
| Line 1... | Line 1... | ||
| 1 | #!/usr/bin/perl -w
|
1 | #!/usr/bin/perl -w
|
| 2 | use strict; |
2 | use strict; |
| 3 | # $Id: inventory.pl 417 2009-05-15 17:21:21Z agaran $
|
3 | # $Id: inventory.pl 419 2009-05-16 00:01:56Z 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 | ||
| Line 17... | Line 17... | ||
| 17 | use Text::Table; |
17 | use Text::Table; |
| 18 | 18 | ||
| 19 | 19 | ||
| 20 | my %Config; |
20 | my %Config; |
| 21 | 21 | ||
| 22 | # ==================================================
|
22 | # ===[ SETUP DEFAULTS ]=============================
|
| 23 | $Config{docdir} = '.'; |
23 | $Config{docdir} = '.'; |
| 24 | $Config{bomdir} = '.'; |
24 | $Config{bomdir} = '.'; |
| 25 | $Config{verbose} = 1; |
25 | $Config{verbose} = 1; |
| 26 | 26 | ||
| 27 | # 0 mean not show, -1 show all, positive value limits depth of shown
|
27 | # 0 mean not show, -1 show all, positive value limits depth of shown
|
| 28 | $Config{dbg_showdirs} = 0; |
28 | $Config{dbg_showdirs} = 0; |
| 29 | 29 | ||
| 30 | 30 | ||
| 31 | # modes
|
31 | # modes
|
| 32 | my $build_inventory = 0; |
- | |
| 33 | my $build_bom = 0; |
- | |
| 34 | my $show_conf = 0; |
32 | my $show_conf = 0; |
| 35 | my $show_help = 0; |
33 | my $show_help = 0; |
| 36 | 34 | ||
| 37 | # ==================================================
|
35 | # ==================================================
|
| 38 | 36 | ||
| 39 | my %Inv_By_PartNo; |
37 | my %Inv_By_PartNo; |
| 40 | my @Inv; |
38 | my @Inv; |
| 41 | my %BomData; |
39 | my %BomData; |
| 42 | my %Files; |
40 | my %Files; |
| - | 41 | my ($file_name, $file_line); |
|
| 43 | 42 | ||
| 44 | sub err_printf($@) { |
43 | sub err_printf($@) { |
| 45 | my ($format, @args) = @_; |
44 | my ($format, @args) = @_; |
| 46 | 45 | ||
| - | 46 | if (defined $file_name && defined $file_line) { |
|
| - | 47 | $format = '(%s:%d) '.$format; |
|
| - | 48 | unshift @args, shortdir($file_name), $file_line; |
|
| - | 49 | }
|
|
| - | 50 | ||
| 47 | printf STDERR "-E- ".$format."\n", @args; |
51 | printf STDERR "-E- ".$format."\n", @args; |
| 48 | # exit? or fail-exit here
|
52 | # exit? or fail-exit here
|
| 49 | }
|
53 | }
|
| 50 | 54 | ||
| 51 | sub wrn_printf($@) { |
55 | sub wrn_printf($@) { |
| 52 | my ($format, @args) = @_; |
56 | my ($format, @args) = @_; |
| 53 | return if ($Config{verbose} <= 1) ; |
57 | return if ($Config{verbose} <= 1) ; |
| - | 58 | ||
| - | 59 | if (defined $file_name && defined $file_line) { |
|
| - | 60 | $format = '(%s:%d) '.$format; |
|
| - | 61 | unshift @args, shortdir($file_name), $file_line; |
|
| - | 62 | }
|
|
| - | 63 | ||
| 54 | printf STDERR "-W- ".$format."\n", @args; |
64 | printf STDERR "-W- ".$format."\n", @args; |
| 55 | }
|
65 | }
|
| 56 | 66 | ||
| 57 | sub inf_printf($@) { |
67 | sub inf_printf($@) { |
| 58 | my ($format, @args) = @_; |
68 | my ($format, @args) = @_; |
| 59 | return if ($Config{verbose} <= 2) ; |
69 | return if ($Config{verbose} <= 2) ; |
| - | 70 | ||
| - | 71 | if (defined $file_name && defined $file_line) { |
|
| - | 72 | $format = '(%s:%d) '.$format; |
|
| - | 73 | unshift @args, shortdir($file_name), $file_line; |
|
| - | 74 | }
|
|
| - | 75 | ||
| 60 | printf STDERR "-I- ".$format."\n", @args; |
76 | printf STDERR "-I- ".$format."\n", @args; |
| 61 | }
|
77 | }
|
| 62 | 78 | ||
| - | 79 | sub nfo_printf($@) { |
|
| - | 80 | my ($format, @args) = @_; |
|
| - | 81 | ||
| - | 82 | return if ($Config{verbose} <= 0) ; |
|
| - | 83 | ||
| - | 84 | if (defined $file_name && defined $file_line) { |
|
| - | 85 | $format = '(%s:%d) '.$format; |
|
| - | 86 | unshift @args, shortdir($file_name), $file_line; |
|
| - | 87 | }
|
|
| - | 88 | ||
| - | 89 | printf STDERR "-N- ".$format."\n", @args; |
|
| - | 90 | # exit? or fail-exit here
|
|
| - | 91 | }
|
|
| - | 92 | ||
| - | 93 | ||
| - | 94 | ||
| 63 | sub Config_Show { |
95 | sub Config_Show { |
| 64 | printf "Config for %s\n----------------------------------------\n", basename($0); |
96 | printf "Config for %s\n----------------------------------------\n", basename($0); |
| 65 | foreach my $name (sort keys %Config) { |
97 | foreach my $name (sort keys %Config) { |
| 66 | printf "%-20s %s\n", $name, $Config{$name}; |
98 | printf "%-20s %s\n", $name, $Config{$name}; |
| 67 | }
|
99 | }
|
| Line 71... | Line 103... | ||
| 71 | printf "Help for %s\n----------------------------------------\n", basename($0); |
103 | printf "Help for %s\n----------------------------------------\n", basename($0); |
| 72 | unless (defined($_[1]) && length($_[1]) != 0) { |
104 | unless (defined($_[1]) && length($_[1]) != 0) { |
| 73 | print "Basic help\n\t--showrc|showconf shows current configuration\n". |
105 | 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". |
106 | "\t--docdir|-d <dir> tells script where information.txt files should be searched\n". |
| 75 | "\t--define <something>=<somethingelseornot> defines some configration value\n". |
107 | "\t--define <something>=<somethingelseornot> defines some configration value\n". |
| 76 | "\t--verbose|-v [level] sets verbosity level\nOrder of options DOES matter\n". |
108 | "\t--verbose|-v [level] increases or sets verbosity level\nOrder of options DOES matter\n". |
| 77 | "\t--bomdir|-b <dir> tells script where boms should be searched\n". |
109 | "\t--bomdir|-b <dir> tells script where boms should be searched\n". |
| 78 | "\t--outfile|-o <file> tells where script shall save output data\n". |
110 | "\t--outfile|-o <file> tells where script shall save output data\n". |
| 79 | "\t--force|-f forces script to save data even if file exist already\n". |
111 | "\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"; |
112 | "\t-l <num> repeat title for output tables every <num> rows\n"; |
| 81 | 113 | ||
| Line 178... | Line 210... | ||
| 178 | 210 | ||
| 179 | 211 | ||
| 180 | open(IN, $filepath) or return 1; |
212 | open(IN, $filepath) or return 1; |
| 181 | 213 | ||
| 182 | my %data; |
214 | my %data; |
| - | 215 | ||
| - | 216 | $file_name = $filepath; |
|
| 183 | my $lineno = 0; |
217 | $file_line = 0; |
| 184 | 218 | ||
| 185 | my $_ok; |
219 | my $_ok; |
| 186 | 220 | ||
| 187 | while (not eof IN) { |
221 | while (not eof IN) { |
| 188 | my $line = <IN>; |
222 | my $line = <IN>; |
| 189 | $lineno++; |
223 | $file_line++; |
| 190 | 224 | ||
| 191 | chomp $line; |
225 | chomp $line; |
| 192 | 226 | ||
| 193 | next if ($line =~ /^[ ]*$/); |
227 | next if ($line =~ /^[ ]*$/); |
| 194 | next if ($line =~ /^;/); |
228 | next if ($line =~ /^;/); |
| Line 204... | Line 238... | ||
| 204 | # printf STDERR "Price %.3f\n", $value;
|
238 | # printf STDERR "Price %.3f\n", $value;
|
| 205 | if (!defined($data{price})) { |
239 | if (!defined($data{price})) { |
| 206 | $data{price} = $value; |
240 | $data{price} = $value; |
| 207 | $_ok->{$name} = 1; |
241 | $_ok->{$name} = 1; |
| 208 | } else { |
242 | } else { |
| 209 | wrn_printf("Duplicated price field in file %s", shortdir($filepath)); |
243 | wrn_printf("Duplicated price field."); |
| 210 | }
|
244 | }
|
| 211 | } else { |
245 | } else { |
| 212 | err_printf("Bad price field in file %s", shortdir($filepath)); |
246 | err_printf("Bad data in price field."); |
| 213 | }
|
247 | }
|
| 214 | } elsif ($name =~ /^manufacturer$/i) { |
248 | } elsif ($name =~ /^manufacturer$/i) { |
| 215 | # printf STDERR "Manufacturer %s\n", $value;
|
249 | # printf STDERR "Manufacturer %s\n", $value;
|
| 216 | if (!defined($data{manufacturer})) { |
250 | if (!defined($data{manufacturer})) { |
| 217 | $data{manufacturer} = $value; |
251 | $data{manufacturer} = $value; |
| 218 | $_ok->{$name} = 1; |
252 | $_ok->{$name} = 1; |
| 219 | } else { |
253 | } else { |
| 220 | wrn_printf("Duplicated manufacturer field in file %s", shortdir($filepath)); |
254 | wrn_printf("Duplicated manufacturer field."); |
| 221 | }
|
255 | }
|
| 222 | } elsif ($name =~ /^manufacturer part no$/ ) { |
256 | } elsif ($name =~ /^manufacturer part no$/ ) { |
| 223 | # printf STDERR "ManPartNo %s\n", $value;
|
257 | # printf STDERR "ManPartNo %s\n", $value;
|
| 224 | if (!defined($data{manufact_partno})) { |
258 | if (!defined($data{manufact_partno})) { |
| 225 | $data{manufact_partno} = trim($value); |
259 | $data{manufact_partno} = trim($value); |
| 226 | $_ok->{$name} = 1; |
260 | $_ok->{$name} = 1; |
| 227 | } else { |
261 | } else { |
| 228 | wrn_printf("Duplicated manufacturer part no field in file %s", |
262 | wrn_printf("Duplicated manufacturer part no field."); |
| 229 | shortdir($filepath)); |
- | |
| 230 | }
|
263 | }
|
| 231 | } elsif ($name =~ /^description$/i) { |
264 | } elsif ($name =~ /^description$/i) { |
| 232 | if (!defined($data{desc})) { |
265 | if (!defined($data{desc})) { |
| 233 | $data{desc} = $value; |
266 | $data{desc} = $value; |
| 234 | } else { |
267 | } else { |
| 235 | wrn_printf("Duplicated description no field in file %s", |
268 | wrn_printf("Duplicated description no field."); |
| 236 | shortdir($filepath)); |
- | |
| 237 | }
|
269 | }
|
| 238 | } elsif ($name =~ /^datasheet$/i) { |
270 | } elsif ($name =~ /^datasheet$/i) { |
| 239 | $data{datasheet} = [] unless defined $data{datasheet}; |
271 | $data{datasheet} = [] unless defined $data{datasheet}; |
| 240 | push @{$data{datasheet}}, $value; |
272 | push @{$data{datasheet}}, $value; |
| 241 | # printf STDERR "Datasheet %s\n", $value;
|
273 | # printf STDERR "Datasheet %s\n", $value;
|
| Line 243... | Line 275... | ||
| 243 | # printf STDERR "Supplier %s\n", $value;
|
275 | # printf STDERR "Supplier %s\n", $value;
|
| 244 | if (!defined($data{supplier})) { |
276 | if (!defined($data{supplier})) { |
| 245 | $data{supplier} = $value; |
277 | $data{supplier} = $value; |
| 246 | $_ok->{$name} = 1; |
278 | $_ok->{$name} = 1; |
| 247 | } else { |
279 | } else { |
| 248 | wrn_printf("Duplicated supplier field in file %s", |
280 | wrn_printf("Duplicated supplier field."); |
| 249 | shortdir($filepath)); |
- | |
| 250 | }
|
281 | }
|
| 251 | } elsif ($name =~ /^order code$/) { |
282 | } elsif ($name =~ /^order code$/) { |
| 252 | # printf STDERR "Order Code %s\n", $value;
|
- | |
| 253 | if (!defined($data{ordercode})) { |
283 | if (!defined($data{ordercode})) { |
| 254 | $data{ordercode} = $value; |
284 | $data{ordercode} = $value; |
| 255 | $_ok->{$name} = 1; |
285 | $_ok->{$name} = 1; |
| 256 | } else { |
286 | } else { |
| 257 | wrn_printf("Duplicated order code field in file %s", |
287 | wrn_printf("Duplicated order code field."); |
| 258 | shortdir($filepath)); |
- | |
| 259 | }
|
288 | }
|
| 260 | #push @DATA, { $name => $value };
|
289 | #push @DATA, { $name => $value };
|
| 261 | } elsif ($name =~ /^url .*$/) { |
290 | } elsif ($name =~ /^url .*$/) { |
| 262 | # printf STDERR "URL %s\n", $value;
|
291 | # printf STDERR "URL %s\n", $value;
|
| 263 | } elsif ($name =~ /^catalog(ue|) page$/) { |
292 | } elsif ($name =~ /^catalog(ue|) page$/) { |
| 264 | # printf STDERR "Catalogue Page %s\n", $value;
|
293 | # printf STDERR "Catalogue Page %s\n", $value;
|
| 265 | } else { |
294 | } else { |
| 266 | err_printf("Unhandled field %s in file %s", $name, |
295 | err_printf("Unhandled field type `%s'.",$name); |
| 267 | shortdir($filepath)); |
- | |
| 268 | }
|
296 | }
|
| 269 | } elsif ($line =~ /^([A-Za-z ]+)[ \t]*\(([A-Za-z 0-9\(\)\-]+)\)[ \t]*:(.*)$/) { |
297 | } elsif ($line =~ /^([A-Za-z ]+)[ \t]*\(([A-Za-z 0-9\(\)\-]+)\)[ \t]*:(.*)$/) { |
| 270 | my ($name, $extdata, $value) = (lc etrim($1),etrim($2),etrim($3)); |
298 | my ($name, $extdata, $value) = (lc etrim($1),etrim($2),etrim($3)); |
| 271 | if ($name =~ /^price$/) { |
299 | if ($name =~ /^price$/) { |
| 272 | $extdata =~ s/ //g; |
300 | $extdata =~ s/ //g; |
| Line 277... | Line 305... | ||
| 277 | $value =~ s/[^0-9\.\,]//g; # remove any characters beside DIGITS |
305 | $value =~ s/[^0-9\.\,]//g; # remove any characters beside DIGITS |
| 278 | if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) { |
306 | if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) { |
| 279 | push @{$data{price}}, [ $extdata, $value ]; |
307 | push @{$data{price}}, [ $extdata, $value ]; |
| 280 | $_ok->{$name} = 1; |
308 | $_ok->{$name} = 1; |
| 281 | } else { |
309 | } else { |
| 282 | err_printf("Bad price field in file %s:%d", shortdir($filepath), $lineno); |
310 | err_printf("Bad extended price field."); |
| 283 | }
|
311 | }
|
| 284 | }
|
312 | }
|
| 285 | } else { |
313 | } else { |
| 286 | wrn_printf("Got: <%s> <%s> <%s> at %s:%s", $name, $extdata, $value, $line, shortdir($filepath)); |
314 | wrn_printf("Unrecognized extended data `%s'.", $name); |
| 287 | }
|
315 | }
|
| 288 | } else { |
316 | } else { |
| 289 | wrn_printf("Unparseable line `%s', forgot ; to set it as comment in file %s", $line, |
317 | wrn_printf("Unparseable line, is it an comment?"); |
| 290 | shortdir($filepath)); |
- | |
| 291 | }
|
318 | }
|
| 292 | }
|
319 | }
|
| 293 | close(IN); |
320 | close(IN); |
| 294 | 321 | ||
| 295 | if (scalar keys %data == 0) { |
322 | if (scalar keys %data == 0) { |
| 296 | inf_printf("Skipping file %s because contain no data for me", shortdir($filepath)); |
323 | inf_printf("No data for me, skipping."); |
| 297 | return; |
324 | return; |
| 298 | }
|
325 | }
|
| 299 | 326 | ||
| 300 | foreach my $field (split /\!/, q/price!manufacturer part no!order code/) { |
327 | 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}); |
328 | wrn_printf("Missing required field `".(ucfirst $field)."'.") unless ($_ok->{$field}); |
| 302 | }
|
329 | }
|
| 303 | 330 | ||
| 304 | 331 | ||
| 305 | my $id = scalar @Inv; |
332 | my $id = scalar @Inv; |
| 306 | 333 | ||
| Line 321... | Line 348... | ||
| 321 | $Inv[$id]{Manufacturer_Partno}, $id); |
348 | $Inv[$id]{Manufacturer_Partno}, $id); |
| 322 | }
|
349 | }
|
| 323 | 350 | ||
| 324 | #inf_printf("Part %s defined in file %s", $Inv[$id]{Manufacturer_Partno}, shortdir($filepath));
|
351 | #inf_printf("Part %s defined in file %s", $Inv[$id]{Manufacturer_Partno}, shortdir($filepath));
|
| 325 | 352 | ||
| 326 | wrn_printf("Unhandled data from parsing: %s", Dumper(\%data)) if (scalar keys %data > 0); |
353 | wrn_printf("Bug in parser, please report: %s", Dumper(\%data)) if (scalar keys %data > 0); |
| 327 | }
|
354 | }
|
| 328 | 355 | ||
| 329 | 356 | ||
| 330 | sub parse_bom ($) { |
357 | sub parse_bom ($) { |
| 331 | my ($filepath) = @_; |
358 | my ($filepath) = @_; |
| 332 | 359 | ||
| 333 | open(IN, $filepath) or return 1; |
360 | open(IN, $filepath) or return 1; |
| 334 | my $fkey = substr(basename($filepath),0,length(basename($filepath))-4); |
361 | my $fkey = substr(basename($filepath),0,length(basename($filepath))-4); |
| 335 | 362 | ||
| - | 363 | $file_name = $filepath; |
|
| - | 364 | $file_line = 0; |
|
| - | 365 | ||
| 336 | #wrn_printf("GotARg: %s", shortdir($filepath));
|
366 | #wrn_printf("GotARg: %s", shortdir($filepath));
|
| 337 | 367 | ||
| 338 | my @Fields; |
368 | my @Fields; |
| 339 | 369 | ||
| 340 | my %data; |
370 | my %data; |
| 341 | my $v = ''; |
371 | my $v = ''; |
| 342 | while (not eof IN) { |
372 | while (not eof IN) { |
| 343 | my $line = <IN>; |
373 | my $line = <IN>; |
| - | 374 | $file_line++; |
|
| 344 | 375 | ||
| 345 | chomp $line; |
376 | chomp $line; |
| 346 | 377 | ||
| 347 | if ($line =~ /^\.START$/) { |
378 | if ($line =~ /^\.START$/) { |
| 348 | $v = 'boms'; |
379 | $v = 'boms'; |
| Line 368... | Line 399... | ||
| 368 | $device = trim($device); |
399 | $device = trim($device); |
| 369 | 400 | ||
| 370 | # wrn_printf("Device: %s (value: %s) at refdes %s, %d pcs", $device, $value, $refdes, $quantity);
|
401 | # wrn_printf("Device: %s (value: %s) at refdes %s, %d pcs", $device, $value, $refdes, $quantity);
|
| 371 | 402 | ||
| 372 | if (!defined $Inv_By_PartNo{$device}) { |
403 | if (!defined $Inv_By_PartNo{$device}) { |
| 373 | wrn_printf("Device %s not found in inventory in file %s", $device, shortdir($filepath)); |
404 | wrn_printf("Device %s not found in inventory.", $device); |
| 374 | next; |
405 | next; |
| 375 | }
|
406 | }
|
| 376 | my $id = $Inv_By_PartNo{$device}; |
407 | my $id = $Inv_By_PartNo{$device}; |
| 377 | next if ($Inv[$id]{Manufacturer} =~ /none/i); # skip parts whose manufacturer is none |
408 | 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});
|
409 | #inf_printf("Found in Inventory at %d %s", $id, $Inv[$id]{Manufacturer_Partno});
|
| Line 389... | Line 420... | ||
| 389 | }
|
420 | }
|
| 390 | }
|
421 | }
|
| 391 | close(IN); |
422 | close(IN); |
| 392 | 423 | ||
| 393 | if (scalar keys %data == 0) { |
424 | if (scalar keys %data == 0) { |
| 394 | inf_printf("Skipping file %s because contain no data for me", |
425 | inf_printf("No data for me, skipping."); |
| 395 | shortdir($filepath)); |
- | |
| 396 | return; |
426 | return; |
| 397 | }
|
427 | }
|
| 398 | 428 | ||
| 399 | foreach my $id (keys %data) { |
429 | foreach my $id (keys %data) { |
| 400 | my %tmp; |
430 | my %tmp; |
| Line 418... | Line 448... | ||
| 418 | # %BomData{ById}{$id}{RefDes}
|
448 | # %BomData{ById}{$id}{RefDes}
|
| 419 | }
|
449 | }
|
| 420 | }
|
450 | }
|
| 421 | 451 | ||
| 422 | sub file_lookup ($$$$) ; |
452 | sub file_lookup ($$$$) ; |
| 423 | sub file_lookup ($$$$) { |
453 | sub file_lookup ($$$$) { # {{{1 |
| 424 | my ($dir, $depth, $regexp, $callback) = @_; |
454 | my ($dir, $depth, $regexp, $callback) = @_; |
| 425 | 455 | ||
| 426 | err_printf("Sorry, callback must be CODE ref") unless (ref $callback eq 'CODE'); |
456 | err_printf("BUG: Sorry, callback must be CODE ref") unless (ref $callback eq 'CODE'); |
| 427 | 457 | ||
| 428 | if ( -d $dir) { |
458 | if ( -d $dir) { |
| 429 | my $d = IO::Dir->new($dir); |
459 | my $d = IO::Dir->new($dir); |
| 430 | return 1 if (!defined $d); |
460 | return 1 if (!defined $d); |
| 431 | 461 | ||
| Line 433... | Line 463... | ||
| 433 | while (defined(my $e = $d->read)) { |
463 | while (defined(my $e = $d->read)) { |
| 434 | my $fe = $dir .'/'. $e; |
464 | my $fe = $dir .'/'. $e; |
| 435 | if ( -f $fe) { |
465 | if ( -f $fe) { |
| 436 | if ($fe =~ $regexp) { |
466 | if ($fe =~ $regexp) { |
| 437 | &$callback($fe); |
467 | &$callback($fe); |
| - | 468 | $file_name = undef; |
|
| 438 | }
|
469 | }
|
| 439 | } elsif (-d $fe) { # now its dir... |
470 | } elsif (-d $fe) { # now its dir... |
| 440 | if ($e eq '.svn') { # if entry name is equal to svn |
471 | if ($e eq '.svn') { # if entry name is equal to svn |
| 441 | next; # go to next entry in foreach loop |
472 | next; # go to next entry in foreach loop |
| 442 | }
|
473 | }
|
| 443 | next if ($e eq '.' or $e eq '..'); # skip to next if dir entry is . or .. |
474 | next if ($e eq '.' or $e eq '..'); # skip to next if dir entry is . or .. |
| 444 | 475 | ||
| 445 | if ($Config{dbg_showdirs} == -1 or $Config{dbg_showdirs} > $depth) { |
476 | if ($Config{dbg_showdirs} == -1 or $Config{dbg_showdirs} > $depth) { |
| - | 477 | $file_name = undef; |
|
| 446 | printf STDERR "Entering directory %s\n", shortdir($fe); |
478 | dbg_printf("Entering directory %s", shortdir($fe)); |
| 447 | }
|
479 | }
|
| 448 | return 1 if (file_lookup($fe, $depth+1, $regexp, $callback) == 1); |
480 | return 1 if (file_lookup($fe, $depth+1, $regexp, $callback) == 1); |
| 449 | } else { |
481 | } else { |
| 450 | # symlink or other mysterius beast
|
482 | # symlink or other mysterius beast
|
| 451 | }
|
483 | }
|
| 452 | }
|
484 | }
|
| 453 | }
|
485 | }
|
| 454 | return 0; |
486 | return 0; |
| - | 487 | } # }}} |
|
| - | 488 | ||
| - | 489 | sub gen_bomfile ($) { # {{{1 |
|
| - | 490 | my $outfile = shift @_; |
|
| - | 491 | ||
| - | 492 | if (-e $outfile) { |
|
| - | 493 | wrn_printf("File already exist"); |
|
| - | 494 | }
|
|
| - | 495 | ||
| - | 496 | my $out = new IO::File $outfile, 'w'; |
|
| - | 497 | ||
| - | 498 | my $bomtable = Text::Table->new( |
|
| - | 499 | { title => '| ', is_sep => 1 }, |
|
| - | 500 | { title => 'id', align => 'right', align_title => 'left' }, |
|
| - | 501 | { title => ' | ', is_sep => 1 }, |
|
| - | 502 | { title => 'description', align => 'left', align_title => 'left' }, |
|
| - | 503 | { title => ' | ', is_sep => 1 }, |
|
| - | 504 | { title => 'manufacturer partid', align => 'left', align_title => 'left' }, |
|
| - | 505 | { title => ' | ', is_sep => 1 }, |
|
| - | 506 | { title => 'manufacturer', align => 'left', align_title => 'left' }, |
|
| - | 507 | { title => ' | ', is_sep => 1 }, |
|
| - | 508 | { title => 'order code', align => 'left', align_title => 'left' }, |
|
| - | 509 | { title => ' | ', is_sep => 1 }, |
|
| - | 510 | { title => 'quantity', align => 'right', align_title => 'left' }, |
|
| - | 511 | { title => ' | ', is_sep => 1 }, |
|
| - | 512 | { title => "price", align => 'right', align_title => 'left' }, |
|
| - | 513 | { title => ' | ', is_sep => 1 }, |
|
| - | 514 | { title => "cost", align => 'right', align_title => 'left' }, |
|
| - | 515 | { title => ' |', is_sep => 1 }, |
|
| - | 516 | ); |
|
| - | 517 | ||
| - | 518 | # counters
|
|
| - | 519 | my ($bn,$totalcost,$partcount) = (1,0,0); |
|
| - | 520 | ||
| - | 521 | foreach my $id ( sort {my $p = $Inv[$a]{Manufacturer} cmp $Inv[$b]{Manufacturer}; if ($p == 0) { |
|
| - | 522 | # return $Inv[$a]{Manufacturer_Partno} cmp $Inv[$b]{Manufacturer_Partno}}; return $p; } keys %BomData) {
|
|
| - | 523 | return $Inv[$a]{Description} cmp $Inv[$b]{Description}}; return $p; } keys %BomData) { |
|
| - | 524 | my %tmp; |
|
| - | 525 | ||
| - | 526 | map { $tmp{$_} = 1 } @{$BomData{$id}{RefDes}}; # duplicated refdes removal |
|
| - | 527 | @{$BomData{$id}{RefDes}} = keys %tmp; |
|
| - | 528 | ||
| - | 529 | my $quant = scalar @{$BomData{$id}{RefDes}}; # quantity based on number of refdes.. |
|
| - | 530 | ||
| - | 531 | my $price = get_price($id,$quant); |
|
| - | 532 | if ($price == 0) { |
|
| - | 533 | wrn_printf("%s has zero price", $Inv[$id]{Manufacturer_Partno}); |
|
| - | 534 | }
|
|
| - | 535 | my $icost = $quant * $price; |
|
| - | 536 | ||
| - | 537 | $bomtable->add($bn++, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $Inv[$id]{Manufacturer}, |
|
| - | 538 | $Inv[$id]{Ordercode},$quant, sprintf("%.3f",$price), sprintf("%.3f", $icost)); |
|
| - | 539 | ||
| - | 540 | $totalcost += $icost; |
|
| - | 541 | $partcount += $quant; |
|
| - | 542 | }
|
|
| - | 543 | ||
| - | 544 | printf $out "file generated at %s\n\n", scalar localtime(time()); |
|
| - | 545 | ||
| - | 546 | print $out $bomtable->rule('-','+'); |
|
| - | 547 | print $out $bomtable->title(); |
|
| - | 548 | print $out $bomtable->rule('-','+'); |
|
| - | 549 | ||
| - | 550 | # repeat header every NTH lines or not
|
|
| - | 551 | unless (defined $Config{'lines'}) { |
|
| - | 552 | print $out $bomtable->body(); |
|
| - | 553 | } else { |
|
| - | 554 | my @p = split(/\n/,$bomtable->body()); |
|
| - | 555 | while (@p) { |
|
| - | 556 | my @sub = splice @p,0,$Config{'lines'}; |
|
| - | 557 | print $out join("\n",@sub)."\n"; |
|
| - | 558 | if (scalar @p > 0) { |
|
| - | 559 | print $out $bomtable->rule('-','+'); |
|
| - | 560 | print $out $bomtable->title(); |
|
| - | 561 | print $out $bomtable->rule('-','+'); |
|
| - | 562 | }
|
|
| - | 563 | }
|
|
| - | 564 | }
|
|
| - | 565 | print $out $bomtable->rule('-','+'); |
|
| - | 566 | ||
| - | 567 | printf $out "\nTotal cost: %.3f\nTotal part count: %d\n\n", $totalcost, $partcount; |
|
| - | 568 | ||
| - | 569 | $out->close; |
|
| - | 570 | } # }}} |
|
| - | 571 | ||
| - | 572 | sub gen_mapfile ($) { # {{{1 |
|
| - | 573 | my $outfile = shift @_; |
|
| - | 574 | ||
| - | 575 | if (-e $outfile) { |
|
| - | 576 | wrn_printf("File already exist"); |
|
| - | 577 | }
|
|
| - | 578 | ||
| - | 579 | my $out = new IO::File $outfile, 'w'; |
|
| - | 580 | ||
| - | 581 | my $parttable = Text::Table->new( |
|
| - | 582 | { title => '| ', is_sep => 1 }, |
|
| - | 583 | { title => 'id', align => 'right', align_title => 'center' }, |
|
| - | 584 | { title => ' | ', is_sep => 1 }, |
|
| - | 585 | { title => 'description', align => 'left', align_title => 'center' }, |
|
| - | 586 | { title => ' | ', is_sep => 1 }, |
|
| - | 587 | { title => 'manufacturer partid', align => 'left', align_title => 'center' }, |
|
| - | 588 | { title => ' | ', is_sep => 1 }, |
|
| - | 589 | { title => 'footprint', align => 'left', align_title => 'center' }, |
|
| - | 590 | { title => ' | ', is_sep => 1 }, |
|
| - | 591 | { title => 'refdes', align => 'left', align_title => 'center' }, |
|
| - | 592 | { title => ' | ', is_sep => 1 }, |
|
| - | 593 | { title => 'sheet', align => 'left', align_title => 'center' }, |
|
| - | 594 | { title => ' |', is_sep => 1 }, |
|
| - | 595 | ); |
|
| - | 596 | ||
| - | 597 | my ($pn) = (1); |
|
| - | 598 | ||
| - | 599 | foreach my $fkey (sort keys %Files) { |
|
| - | 600 | my $rowblock = 0; |
|
| - | 601 | foreach my $id ( sort {my $p = $Inv[$a]{Manufacturer} cmp $Inv[$b]{Manufacturer}; if ($p == 0) { |
|
| - | 602 | return $Inv[$a]{Description} cmp $Inv[$b]{Description}}; return $p; } keys %{$Files{$fkey}}) { |
|
| - | 603 | ||
| - | 604 | if ($Config{'no-repeat-columns'}) { |
|
| - | 605 | my @p = split(/\n/, strbreak(join (', ', sort @{$Files{$fkey}{$id}{RefDes}}),43)); |
|
| - | 606 | ||
| - | 607 | $parttable->add($pn, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $BomData{$id}{Footprint}, |
|
| - | 608 | etrim(trim(shift @p)), $fkey); |
|
| - | 609 | ||
| - | 610 | while (@p) { |
|
| - | 611 | $parttable->add('++', '', '', '', etrim(trim(shift @p)), ''); |
|
| - | 612 | }
|
|
| - | 613 | } else { |
|
| - | 614 | my @p = split(/\n/, strbreak(join (', ', sort @{$Files{$fkey}{$id}{RefDes}}),43)); |
|
| - | 615 | while (@p) { |
|
| - | 616 | $parttable->add($pn, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $BomData{$id}{Footprint}, |
|
| - | 617 | etrim(trim(shift @p)), $fkey); |
|
| - | 618 | }
|
|
| - | 619 | }
|
|
| - | 620 | ||
| - | 621 | ||
| - | 622 | $pn++; |
|
| - | 623 | }
|
|
| - | 624 | $parttable->add('--','=========','==========','==========','==========','=========='); |
|
| - | 625 | }
|
|
| - | 626 | ||
| - | 627 | print $out $parttable->rule('-','+'); |
|
| - | 628 | print $out $parttable->title(); |
|
| - | 629 | print $out $parttable->rule('-','+'); |
|
| - | 630 | unless (defined $Config{'lines'}) { |
|
| - | 631 | print $out $parttable->body(); |
|
| - | 632 | } else { |
|
| - | 633 | my @p = split(/\n/,$parttable->body()); |
|
| - | 634 | while (@p) { |
|
| - | 635 | my @sub = splice @p,0,$Config{'lines'}; |
|
| - | 636 | print $out join("\n",@sub)."\n"; |
|
| - | 637 | if (scalar @p > 0) { |
|
| - | 638 | print $out $parttable->rule('-','+'); |
|
| - | 639 | print $out $parttable->title(); |
|
| - | 640 | print $out $parttable->rule('-','+'); |
|
| - | 641 | }
|
|
| - | 642 | }
|
|
| 455 | }
|
643 | }
|
| - | 644 | print $out $parttable->rule('-','+'); |
|
| - | 645 | ||
| - | 646 | $out->close(); |
|
| - | 647 | } #}}}1 |
|
| 456 | 648 | ||
| 457 | Getopt::Long::Configure("bundling"); |
649 | Getopt::Long::Configure("bundling"); |
| 458 | 650 | ||
| 459 | if (scalar @ARGV == 0) { |
651 | if (scalar @ARGV == 0) { |
| 460 | Help_Show(); |
652 | Help_Show(); |
| Line 464... | Line 656... | ||
| 464 | my $result = Getopt::Long::GetOptions ( |
656 | my $result = Getopt::Long::GetOptions ( |
| 465 | "showrc|showconf" => sub { $show_conf = 1 }, |
657 | "showrc|showconf" => sub { $show_conf = 1 }, |
| 466 | "docdir|d=s" => sub { $Config{docdir} = $_[1]; }, |
658 | "docdir|d=s" => sub { $Config{docdir} = $_[1]; }, |
| 467 | # not sure if bomdir or SCH dir
|
659 | # 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 |
660 | "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; }, |
661 | "define|D=s" => sub { my ($p,$q) = split(/=/,$_[1],2); $Config{$p} = ($q||1); }, |
| 470 | "verbose|v:+" => sub { $Config{$_[0]} = ($_[1]>1?0:$Config{$_[0]}) + $_[1]; }, |
662 | "verbose|v:+" => \$Config{'verbose'}, |
| 471 | "help|h|?:s" => sub { $show_help = 1; }, |
663 | "help|h|?:s" => sub { $show_help = 1; }, |
| 472 | "outfile|o=s" => sub { $Config{$_[0]} = $_[1]; }, |
664 | "outfile|o=s" => sub { $Config{$_[0]} = $_[1]; }, |
| 473 | "force|f" => sub { $Config{$_[0]} = 1 }, |
665 | "force|f" => sub { $Config{$_[0]} = 1 }, |
| 474 | "lines|l=i" => sub { $Config{$_[0]} = abs(int($_[1]));}, |
666 | "lines|l=i" => sub { $Config{$_[0]} = abs(int($_[1]));}, |
| 475 | 667 | ||
| Line 496... | Line 688... | ||
| 496 | Config_Show(); |
688 | Config_Show(); |
| 497 | exit; |
689 | exit; |
| 498 | }
|
690 | }
|
| 499 | 691 | ||
| 500 | # make Inventory
|
692 | # make Inventory
|
| 501 | printf STDERR "Indexing information.txt (under %s)\n",shortdir($Config{docdir}); |
693 | nfo_printf("Fetching data from information.txt (under %s)",shortdir($Config{docdir})); |
| 502 | file_lookup($Config{docdir}, 0, qr/\/information.txt$/, \&parse_ifile); |
694 | file_lookup($Config{docdir}, 0, qr/\/information.txt$/, \&parse_ifile); |
| 503 | printf STDERR "\tFinished, %d entries loaded\n", scalar(@Inv)+1; |
695 | nfo_printf("Finished, %d entries loaded.", scalar(@Inv)+1); |
| 504 | 696 | ||
| 505 | # process BOM files
|
697 | # process BOM files
|
| 506 | printf STDERR "Loading bom data from %s\n", shortdir($Config{bomdir}); |
698 | nfo_printf("Fetching BOM data from %s", shortdir($Config{bomdir})); |
| 507 | file_lookup($Config{bomdir}, 0, qr/\.bom$/, \&parse_bom); |
699 | file_lookup($Config{bomdir}, 0, qr/\.bom$/, \&parse_bom); |
| 508 | printf STDERR "\tLoaded, now processing\n"; |
700 | nfo_printf("Finished, %d entries loaded.", scalar keys %BomData); |
| 509 | - | ||
| 510 | my ($bn,$pn) = (1,1); |
- | |
| 511 | my $cost = 0.0; |
- | |
| 512 | 701 | ||
| 513 | my $out; |
- | |
| 514 | if (!defined $Config{outfile}) { |
702 | if (!defined $Config{outfile}) { |
| 515 | $Config{outfile} = './output.txt'; |
703 | $Config{outfile} = './output'; |
| 516 | wrn_printf("Output file not specified, saving out in ".$Config{outfile}); |
704 | wrn_printf("Output file not specified, saving out in ".$Config{outfile}); |
| 517 | }
|
705 | }
|
| 518 | 706 | ||
| 519 | if ( -e $Config{outfile}) { |
707 | if ($Config{outfile} =~ /^(.*)\.txt$/) { |
| 520 | unless (defined $Config{force} && $Config{force} == 1) { |
- | |
| 521 | inf_printf("Unlinking output.txt before owrewriting"); |
- | |
| 522 | unlink($Config{outfile}); |
708 | $Config{outfile} = $1; |
| 523 | } else { |
- | |
| 524 | wrn_printf("Output file already exist, add --force if i shall overwrite it"); |
709 | inf_printf("Please specify output name without extension, -bom.txt and -map.txt will be added automatically"); |
| 525 | exit; |
- | |
| 526 | }
|
- | |
| 527 | }
|
710 | }
|
| 528 | 711 | ||
| 529 | $out = new IO::File $Config{outfile}, 'w'; |
712 | gen_bomfile($Config{'outfile'}.'-bom.txt'); |
| 530 | 713 | ||
| 531 | my $bomtable = Text::Table->new( |
- | |
| 532 | { title => '| ', is_sep => 1 }, |
- | |
| 533 | { title => 'id', align => 'right', align_title => 'left' }, |
- | |
| 534 | { title => ' | ', is_sep => 1 }, |
- | |
| 535 | { title => 'description', align => 'left', align_title => 'left' }, |
- | |
| 536 | { title => ' | ', is_sep => 1 }, |
- | |
| 537 | { title => 'manufacturer partid', align => 'left', align_title => 'left' }, |
- | |
| 538 | { title => ' | ', is_sep => 1 }, |
- | |
| 539 | { title => 'manufacturer', align => 'left', align_title => 'left' }, |
- | |
| 540 | { title => ' | ', is_sep => 1 }, |
- | |
| 541 | { title => 'order code', align => 'left', align_title => 'left' }, |
- | |
| 542 | { title => ' | ', is_sep => 1 }, |
- | |
| 543 | { title => 'quantity', align => 'right', align_title => 'left' }, |
- | |
| 544 | { title => ' | ', is_sep => 1 }, |
- | |
| 545 | { title => "price", align => 'right', align_title => 'left' }, |
- | |
| 546 | { title => ' | ', is_sep => 1 }, |
- | |
| 547 | { title => "cost", align => 'right', align_title => 'left' }, |
- | |
| 548 | { title => ' |', is_sep => 1 }, |
- | |
| 549 | ); |
- | |
| 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 }, |
- | |
| 557 | { title => 'manufacturer partid', align => 'left', align_title => 'center' }, |
- | |
| 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 | ); |
- | |
| 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) { |
- | |
| 570 | my %tmp; |
- | |
| 571 | map { $tmp{$_} = 1 } @{$BomData{$id}{RefDes}}; |
- | |
| 572 | @{$BomData{$id}{RefDes}} = keys %tmp; |
- | |
| 573 | my $quant = scalar @{$BomData{$id}{RefDes}}; |
- | |
| 574 | my $price = get_price($id,$quant); |
714 | gen_mapfile($Config{'outfile'}.'-map.txt'); |
| 575 | if ($price == 0) { |
- | |
| 576 | wrn_printf("%s has zero price", $Inv[$id]{Manufacturer_Partno}); |
- | |
| 577 | }
|
- | |
| 578 | my $icost = $quant * $price; |
- | |
| 579 | - | ||
| 580 | # printf PARTMAP "%-35s|%s\n", shortstring($Inv[$id]{Description},35), join (', ', sort @{$BomData{$id}{RefDes}});
|
- | |
| 581 | $cost += $icost; |
- | |
| 582 | # %BomData{ById}{$id}{RefDes}
|
- | |
| 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));
|
- | |
| 585 | $bomtable->add($bn++, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $Inv[$id]{Manufacturer}, |
- | |
| 586 | $Inv[$id]{Ordercode},$quant, sprintf("%.3f",$price), sprintf("%.3f",$icost)); |
- | |
| 587 | - | ||
| 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}}));
|
- | |
| 590 | }
|
- | |
| 591 | 715 | ||
| - | 716 | nfo_printf("Script finished, output saved in %s-{map,bom}.txt", $Config{outfile}); |
|
| 592 | 717 | ||
| 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('-','+'); |
- | |
| 598 | unless (defined $Config{'lines'}) { |
- | |
| 599 | print $out $bomtable->body(); |
- | |
| 600 | } else { |
718 | __END__
|
| 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 | }
|
- | |
| 612 | print $out $bomtable->rule('-','+'); |
- | |
| 613 | - | ||
| 614 | printf $out "\nTotal cost: %.3f\n\n\n", $cost; |
- | |
| 615 | - | ||
| 616 | - | ||
| 617 | $pn = 1; |
- | |
| 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 | 719 | ||
| 623 | my @p = split(/\n/, strbreak(join (', ', sort @{$Files{$fkey}{$id}{RefDes}}),43)); |
- | |
| 624 | while (@p) { |
720 | if ( -e $Config{outfile}) { |
| 625 | $parttable->add($pn, $Inv[$id]{Description}, $Inv[$id]{Manufacturer_Partno}, $BomData{$id}{Footprint}, |
- | |
| 626 | etrim(trim(shift @p)), $fkey); |
721 | unless (defined $Config{force} && $Config{force} == 1) { |
| 627 | }
|
- | |
| 628 | - | ||
| 629 | $pn++; |
- | |
| 630 | }
|
- | |
| 631 | $parttable->add('--','=========','==========','==========','==========','=========='); |
- | |
| 632 | }
|
- | |
| 633 | - | ||
| 634 | print $out $parttable->rule('-','+'); |
- | |
| 635 | print $out $parttable->title(); |
- | |
| 636 | print $out $parttable->rule('-','+'); |
722 | inf_printf("Unlinking output.txt before owrewriting"); |
| 637 | unless (defined $Config{'lines'}) { |
723 | unlink($Config{outfile}); |
| 638 | print $out $parttable->body(); |
- | |
| 639 | } else { |
724 | } else { |
| 640 | my @p = split(/\n/,$parttable->body()); |
725 | wrn_printf("Output file already exist, add --force if i shall overwrite it"); |
| 641 | while (@p) { |
726 | exit; |
| 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 | }
|
727 | }
|
| 649 | }
|
728 | }
|
| 650 | }
|
- | |
| 651 | print $out $parttable->rule('-','+'); |
- | |
| 652 | - | ||
| 653 | - | ||
| 654 | #close PARTMAP;
|
- | |
| 655 | - | ||
| 656 | printf STDERR "\tFinished, output saved in %s\n", $Config{outfile}; |
- | |