Rev 417 | 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 419 2009-05-16 00:01:56Z 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 | |
| 419 | agaran | 22 | # ===[ SETUP DEFAULTS ]============================= |
| 313 | agaran | 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 $show_conf = 0; |
||
| 33 | my $show_help = 0; |
||
| 34 | |||
| 35 | # ================================================== |
||
| 36 | |||
| 37 | my %Inv_By_PartNo; |
||
| 38 | my @Inv; |
||
| 325 | agaran | 39 | my %BomData; |
| 332 | agaran | 40 | my %Files; |
| 419 | agaran | 41 | my ($file_name, $file_line); |
| 313 | agaran | 42 | |
| 293 | agaran | 43 | sub err_printf($@) { |
| 44 | my ($format, @args) = @_; |
||
| 280 | agaran | 45 | |
| 419 | agaran | 46 | if (defined $file_name && defined $file_line) { |
| 47 | $format = '(%s:%d) '.$format; |
||
| 48 | unshift @args, shortdir($file_name), $file_line; |
||
| 49 | } |
||
| 50 | |||
| 313 | agaran | 51 | printf STDERR "-E- ".$format."\n", @args; |
| 52 | # exit? or fail-exit here |
||
| 280 | agaran | 53 | } |
| 54 | |||
| 293 | agaran | 55 | sub wrn_printf($@) { |
| 56 | my ($format, @args) = @_; |
||
| 328 | agaran | 57 | return if ($Config{verbose} <= 1) ; |
| 419 | agaran | 58 | |
| 59 | if (defined $file_name && defined $file_line) { |
||
| 60 | $format = '(%s:%d) '.$format; |
||
| 61 | unshift @args, shortdir($file_name), $file_line; |
||
| 62 | } |
||
| 63 | |||
| 293 | agaran | 64 | printf STDERR "-W- ".$format."\n", @args; |
| 65 | } |
||
| 66 | |||
| 67 | sub inf_printf($@) { |
||
| 68 | my ($format, @args) = @_; |
||
| 328 | agaran | 69 | return if ($Config{verbose} <= 2) ; |
| 419 | agaran | 70 | |
| 71 | if (defined $file_name && defined $file_line) { |
||
| 72 | $format = '(%s:%d) '.$format; |
||
| 73 | unshift @args, shortdir($file_name), $file_line; |
||
| 74 | } |
||
| 75 | |||
| 293 | agaran | 76 | printf STDERR "-I- ".$format."\n", @args; |
| 77 | } |
||
| 78 | |||
| 419 | agaran | 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 | |||
| 313 | agaran | 95 | sub Config_Show { |
| 96 | printf "Config for %s\n----------------------------------------\n", basename($0); |
||
| 97 | foreach my $name (sort keys %Config) { |
||
| 98 | printf "%-20s %s\n", $name, $Config{$name}; |
||
| 99 | } |
||
| 100 | } |
||
| 101 | |||
| 102 | sub Help_Show { |
||
| 103 | printf "Help for %s\n----------------------------------------\n", basename($0); |
||
| 104 | unless (defined($_[1]) && length($_[1]) != 0) { |
||
| 105 | print "Basic help\n\t--showrc|showconf shows current configuration\n". |
||
| 106 | "\t--docdir|-d <dir> tells script where information.txt files should be searched\n". |
||
| 107 | "\t--define <something>=<somethingelseornot> defines some configration value\n". |
||
| 419 | agaran | 108 | "\t--verbose|-v [level] increases or sets verbosity level\nOrder of options DOES matter\n". |
| 330 | agaran | 109 | "\t--bomdir|-b <dir> tells script where boms should be searched\n". |
| 331 | agaran | 110 | "\t--outfile|-o <file> tells where script shall save output data\n". |
| 337 | agaran | 111 | "\t--force|-f forces script to save data even if file exist already\n". |
| 112 | "\t-l <num> repeat title for output tables every <num> rows\n"; |
||
| 319 | agaran | 113 | |
| 114 | print "\t\e[0;31mThis Help Is created especially for \e[0;33mJelle\e[0;29m\n". |
||
| 115 | "\tThis script search all directories below specified ones to find interesting files\n"; |
||
| 313 | agaran | 116 | return; |
| 117 | } |
||
| 118 | if ($_[1] =~ /^foo$/) { |
||
| 119 | print "Noo, there is no foo's here\n"; |
||
| 120 | } else { |
||
| 121 | printf "Sorry, help for `%s' don't exist (eventually) yet\n", $_[1]; |
||
| 122 | } |
||
| 123 | exit; |
||
| 124 | } |
||
| 125 | |||
| 126 | sub fix_dir ($) { |
||
| 127 | my $dir = shift @_; |
||
| 128 | |||
| 129 | $dir =~ s/\/$//; |
||
| 130 | |||
| 131 | if (! -d $dir) { |
||
| 132 | err_printf("Sorry `%s' is not valid directory, exiting", $dir); |
||
| 133 | } |
||
| 134 | |||
| 135 | return $dir; |
||
| 136 | } |
||
| 137 | |||
| 138 | sub shortdir ($) { |
||
| 139 | my $path = shift @_; |
||
| 140 | |||
| 141 | return substr($path, 2) if ($path =~ /^\.\//) ; |
||
| 142 | return $path; |
||
| 143 | } |
||
| 144 | |||
| 145 | |||
| 146 | sub trim($) { |
||
| 147 | my ($value) = @_; |
||
| 148 | |||
| 149 | $value =~ s/^ +//; |
||
| 150 | $value =~ s/ +$//; |
||
| 151 | return $value; |
||
| 152 | } |
||
| 153 | |||
| 154 | sub etrim($) { |
||
| 155 | my ($value) = @_; |
||
| 156 | |||
| 157 | $value =~ s/^[ ]+//; |
||
| 158 | $value =~ s/[ ]+$//; |
||
| 159 | return $value; |
||
| 160 | } |
||
| 161 | |||
| 330 | agaran | 162 | sub strbreak($$) { |
| 325 | agaran | 163 | my ($str,$lim) = @_; |
| 334 | agaran | 164 | my @p = split /\ /,$str; |
| 330 | agaran | 165 | $str = ''; |
| 166 | my $l = 0; |
||
| 167 | while (@p) { |
||
| 168 | my $e = shift @p; |
||
| 169 | if ($l + length ($e) +1 > $lim) { |
||
| 170 | $str .= "\n".$e; |
||
| 171 | $l = length $e; |
||
| 172 | } else { |
||
| 173 | $str .= " ".$e; |
||
| 174 | $l += length($e) + 1; |
||
| 175 | } |
||
| 176 | } |
||
| 325 | agaran | 177 | return $str; |
| 178 | } |
||
| 179 | |||
| 417 | agaran | 180 | # this function return price of single item |
| 181 | # quantity is needed to cope with quantity-based prices |
||
| 182 | sub get_price($$) { |
||
| 183 | my ($id, $quantity) = @_; |
||
| 184 | |||
| 185 | if (!defined $Inv[$id]{Price}) { |
||
| 186 | wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno}); |
||
| 187 | return 0.0; |
||
| 188 | } |
||
| 189 | |||
| 190 | if (ref $Inv[$id]{Price} eq 'ARRAY') { # handle structured prices |
||
| 191 | my $ret = 0; |
||
| 192 | foreach my $pd (@{$Inv[$id]{Price}}) { |
||
| 193 | if (ref $pd eq 'ARRAY') { |
||
| 194 | my ($rmin,$rmax) = split '-', $pd->[0]; |
||
| 195 | $ret = $pd->[1] if ($quantity >= $rmin); |
||
| 196 | } |
||
| 197 | } |
||
| 198 | return $ret; |
||
| 199 | } |
||
| 200 | |||
| 201 | return $Inv[$id]{Price}; |
||
| 202 | } |
||
| 203 | |||
| 204 | |||
| 205 | |||
| 313 | agaran | 206 | # this subroutine is used as callback function |
| 207 | # executed by file_lookup |
||
| 280 | agaran | 208 | sub parse_ifile($) { |
| 293 | agaran | 209 | my ($filepath) = @_; |
| 280 | agaran | 210 | |
| 318 | agaran | 211 | |
| 293 | agaran | 212 | open(IN, $filepath) or return 1; |
| 280 | agaran | 213 | |
| 293 | agaran | 214 | my %data; |
| 280 | agaran | 215 | |
| 419 | agaran | 216 | $file_name = $filepath; |
| 217 | $file_line = 0; |
||
| 218 | |||
| 417 | agaran | 219 | my $_ok; |
| 220 | |||
| 293 | agaran | 221 | while (not eof IN) { |
| 222 | my $line = <IN>; |
||
| 419 | agaran | 223 | $file_line++; |
| 280 | agaran | 224 | |
| 293 | agaran | 225 | chomp $line; |
| 280 | agaran | 226 | |
| 293 | agaran | 227 | next if ($line =~ /^[ ]*$/); |
| 228 | next if ($line =~ /^;/); |
||
| 229 | |||
| 230 | last if ($line =~ /^--/); |
||
| 231 | |||
| 232 | if ($line =~ /^([A-Za-z ]+):(.*)$/) { |
||
| 313 | agaran | 233 | my ($name,$value) = (lc etrim($1),etrim($2)); |
| 293 | agaran | 234 | |
| 235 | if ($name =~ /^price$/) { |
||
| 417 | agaran | 236 | $value =~ s/[^0-9\.\,]//g; # remove any characters beside DIGITS |
| 293 | agaran | 237 | if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) { |
| 238 | # printf STDERR "Price %.3f\n", $value; |
||
| 239 | if (!defined($data{price})) { |
||
| 240 | $data{price} = $value; |
||
| 417 | agaran | 241 | $_ok->{$name} = 1; |
| 293 | agaran | 242 | } else { |
| 419 | agaran | 243 | wrn_printf("Duplicated price field."); |
| 293 | agaran | 244 | } |
| 245 | } else { |
||
| 419 | agaran | 246 | err_printf("Bad data in price field."); |
| 293 | agaran | 247 | } |
| 248 | } elsif ($name =~ /^manufacturer$/i) { |
||
| 249 | # printf STDERR "Manufacturer %s\n", $value; |
||
| 250 | if (!defined($data{manufacturer})) { |
||
| 251 | $data{manufacturer} = $value; |
||
| 417 | agaran | 252 | $_ok->{$name} = 1; |
| 293 | agaran | 253 | } else { |
| 419 | agaran | 254 | wrn_printf("Duplicated manufacturer field."); |
| 293 | agaran | 255 | } |
| 256 | } elsif ($name =~ /^manufacturer part no$/ ) { |
||
| 257 | # printf STDERR "ManPartNo %s\n", $value; |
||
| 258 | if (!defined($data{manufact_partno})) { |
||
| 313 | agaran | 259 | $data{manufact_partno} = trim($value); |
| 417 | agaran | 260 | $_ok->{$name} = 1; |
| 293 | agaran | 261 | } else { |
| 419 | agaran | 262 | wrn_printf("Duplicated manufacturer part no field."); |
| 293 | agaran | 263 | } |
| 264 | } elsif ($name =~ /^description$/i) { |
||
| 313 | agaran | 265 | if (!defined($data{desc})) { |
| 266 | $data{desc} = $value; |
||
| 267 | } else { |
||
| 419 | agaran | 268 | wrn_printf("Duplicated description no field."); |
| 313 | agaran | 269 | } |
| 293 | agaran | 270 | } elsif ($name =~ /^datasheet$/i) { |
| 271 | $data{datasheet} = [] unless defined $data{datasheet}; |
||
| 272 | push @{$data{datasheet}}, $value; |
||
| 273 | # printf STDERR "Datasheet %s\n", $value; |
||
| 274 | } elsif ($name =~ /^supplier$/i) { |
||
| 275 | # printf STDERR "Supplier %s\n", $value; |
||
| 276 | if (!defined($data{supplier})) { |
||
| 277 | $data{supplier} = $value; |
||
| 417 | agaran | 278 | $_ok->{$name} = 1; |
| 293 | agaran | 279 | } else { |
| 419 | agaran | 280 | wrn_printf("Duplicated supplier field."); |
| 293 | agaran | 281 | } |
| 282 | } elsif ($name =~ /^order code$/) { |
||
| 283 | if (!defined($data{ordercode})) { |
||
| 284 | $data{ordercode} = $value; |
||
| 417 | agaran | 285 | $_ok->{$name} = 1; |
| 293 | agaran | 286 | } else { |
| 419 | agaran | 287 | wrn_printf("Duplicated order code field."); |
| 293 | agaran | 288 | } |
| 289 | #push @DATA, { $name => $value }; |
||
| 290 | } elsif ($name =~ /^url .*$/) { |
||
| 291 | # printf STDERR "URL %s\n", $value; |
||
| 292 | } elsif ($name =~ /^catalog(ue|) page$/) { |
||
| 293 | # printf STDERR "Catalogue Page %s\n", $value; |
||
| 294 | } else { |
||
| 419 | agaran | 295 | err_printf("Unhandled field type `%s'.",$name); |
| 293 | agaran | 296 | } |
| 417 | agaran | 297 | } elsif ($line =~ /^([A-Za-z ]+)[ \t]*\(([A-Za-z 0-9\(\)\-]+)\)[ \t]*:(.*)$/) { |
| 298 | my ($name, $extdata, $value) = (lc etrim($1),etrim($2),etrim($3)); |
||
| 299 | if ($name =~ /^price$/) { |
||
| 300 | $extdata =~ s/ //g; |
||
| 301 | #wrn_printf("Extended-Price <%s> <%s> at %s:%d", $extdata, $value, shortdir($filepath), $lineno); |
||
| 302 | $data{price} = [] if (!defined $data{price}); |
||
| 293 | agaran | 303 | |
| 417 | agaran | 304 | if(ref $data{price} eq 'ARRAY') { |
| 305 | $value =~ s/[^0-9\.\,]//g; # remove any characters beside DIGITS |
||
| 306 | if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) { |
||
| 307 | push @{$data{price}}, [ $extdata, $value ]; |
||
| 308 | $_ok->{$name} = 1; |
||
| 309 | } else { |
||
| 419 | agaran | 310 | err_printf("Bad extended price field."); |
| 417 | agaran | 311 | } |
| 312 | } |
||
| 313 | } else { |
||
| 419 | agaran | 314 | wrn_printf("Unrecognized extended data `%s'.", $name); |
| 417 | agaran | 315 | } |
| 293 | agaran | 316 | } else { |
| 419 | agaran | 317 | wrn_printf("Unparseable line, is it an comment?"); |
| 293 | agaran | 318 | } |
| 319 | } |
||
| 320 | close(IN); |
||
| 321 | |||
| 322 | if (scalar keys %data == 0) { |
||
| 419 | agaran | 323 | inf_printf("No data for me, skipping."); |
| 293 | agaran | 324 | return; |
| 325 | } |
||
| 326 | |||
| 417 | agaran | 327 | foreach my $field (split /\!/, q/price!manufacturer part no!order code/) { |
| 419 | agaran | 328 | wrn_printf("Missing required field `".(ucfirst $field)."'.") unless ($_ok->{$field}); |
| 293 | agaran | 329 | } |
| 313 | agaran | 330 | |
| 331 | |||
| 332 | my $id = scalar @Inv; |
||
| 333 | |||
| 334 | $Inv[$id] = {}; |
||
| 335 | |||
| 336 | $Inv[$id]{Datasheet} = delete $data{'datasheet'} if defined $data{'datasheet'}; |
||
| 334 | agaran | 337 | $Inv[$id]{Manufacturer} = etrim(trim(delete $data{'manufacturer'})) if defined $data{'manufacturer'}; |
| 338 | $Inv[$id]{Description} = etrim(trim(delete $data{'desc'})) if defined $data{'desc'}; |
||
| 313 | agaran | 339 | $Inv[$id]{Price} = delete $data{'price'} if defined $data{'price'}; |
| 334 | agaran | 340 | $Inv[$id]{Ordercode} = etrim(trim(delete $data{'ordercode'})) if defined $data{'ordercode'}; |
| 341 | $Inv[$id]{Manufacturer_Partno} = etrim(trim(delete $data{'manufact_partno'})) if defined $data{'manufact_partno'}; |
||
| 313 | agaran | 342 | $Inv[$id]{Supplier} = delete $data{'supplier'} if defined $data{'supplier'}; |
| 343 | |||
| 344 | unless (defined ($Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno}})) { |
||
| 345 | $Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno}} = $id; |
||
| 346 | } else { |
||
| 347 | wrn_printf("PartNumber %s happened more than once, using first occurence (id:%d)", |
||
| 348 | $Inv[$id]{Manufacturer_Partno}, $id); |
||
| 349 | } |
||
| 325 | agaran | 350 | |
| 313 | agaran | 351 | #inf_printf("Part %s defined in file %s", $Inv[$id]{Manufacturer_Partno}, shortdir($filepath)); |
| 293 | agaran | 352 | |
| 419 | agaran | 353 | wrn_printf("Bug in parser, please report: %s", Dumper(\%data)) if (scalar keys %data > 0); |
| 280 | agaran | 354 | } |
| 355 | |||
| 356 | |||
| 313 | agaran | 357 | sub parse_bom ($) { |
| 358 | my ($filepath) = @_; |
||
| 280 | agaran | 359 | |
| 313 | agaran | 360 | open(IN, $filepath) or return 1; |
| 332 | agaran | 361 | my $fkey = substr(basename($filepath),0,length(basename($filepath))-4); |
| 313 | agaran | 362 | |
| 419 | agaran | 363 | $file_name = $filepath; |
| 364 | $file_line = 0; |
||
| 365 | |||
| 313 | agaran | 366 | #wrn_printf("GotARg: %s", shortdir($filepath)); |
| 367 | |||
| 368 | my @Fields; |
||
| 369 | |||
| 370 | my %data; |
||
| 371 | my $v = ''; |
||
| 372 | while (not eof IN) { |
||
| 373 | my $line = <IN>; |
||
| 419 | agaran | 374 | $file_line++; |
| 313 | agaran | 375 | |
| 376 | chomp $line; |
||
| 377 | |||
| 378 | if ($line =~ /^\.START$/) { |
||
| 379 | $v = 'boms'; |
||
| 380 | next; |
||
| 381 | } |
||
| 382 | |||
| 383 | if ($line =~ /^\.END$/) { |
||
| 384 | $v = ''; |
||
| 385 | next; |
||
| 386 | } |
||
| 387 | |||
| 388 | if ($v eq 'boms') { |
||
| 389 | @Fields = split(/\t/, substr($line,2)); |
||
| 390 | $v = 'bom'; |
||
| 391 | # some funny way to generate field-map |
||
| 392 | # that if someone reorder bom file columns we are still on place |
||
| 393 | next; |
||
| 394 | } |
||
| 395 | |||
| 396 | if ($v eq 'bom') { |
||
| 397 | my ($refdes, $device, $value, $footprint, $quantity) = split (/\t/, $line); |
||
| 398 | |||
| 399 | $device = trim($device); |
||
| 400 | |||
| 401 | # wrn_printf("Device: %s (value: %s) at refdes %s, %d pcs", $device, $value, $refdes, $quantity); |
||
| 402 | |||
| 403 | if (!defined $Inv_By_PartNo{$device}) { |
||
| 419 | agaran | 404 | wrn_printf("Device %s not found in inventory.", $device); |
| 313 | agaran | 405 | next; |
| 406 | } |
||
| 407 | my $id = $Inv_By_PartNo{$device}; |
||
| 408 | next if ($Inv[$id]{Manufacturer} =~ /none/i); # skip parts whose manufacturer is none |
||
| 409 | #inf_printf("Found in Inventory at %d %s", $id, $Inv[$id]{Manufacturer_Partno}); |
||
| 334 | agaran | 410 | push @{$data{$id}{RefDes}}, etrim(trim($refdes)); |
| 330 | agaran | 411 | if (!defined $data{$id}{Footprint}) { |
| 412 | $data{$id}{Footprint} = $footprint; |
||
| 413 | } else { |
||
| 414 | if ($data{$id}{Footprint} ne $footprint) { |
||
| 415 | err_printf("Different footprints for same device in within single bom file, script ". |
||
| 416 | "cannot work around this, will use first one, but expect that output file ". |
||
| 417 | "might have errors."); |
||
| 418 | } |
||
| 419 | } |
||
| 313 | agaran | 420 | } |
| 421 | } |
||
| 422 | close(IN); |
||
| 423 | |||
| 424 | if (scalar keys %data == 0) { |
||
| 419 | agaran | 425 | inf_printf("No data for me, skipping."); |
| 313 | agaran | 426 | return; |
| 427 | } |
||
| 428 | |||
| 429 | foreach my $id (keys %data) { |
||
| 430 | my %tmp; |
||
| 431 | map { $tmp{$_} = 1 } @{$data{$id}{RefDes}}; |
||
| 432 | @{$data{$id}{RefDes}} = keys %tmp; |
||
| 433 | my $cnt = scalar @{$data{$id}{RefDes}}; |
||
| 318 | agaran | 434 | push @{$BomData{$id}{RefDes}}, @{$data{$id}{RefDes}}; |
| 330 | agaran | 435 | if (!defined $BomData{$id}{Footprint}) { |
| 436 | $BomData{$id}{Footprint} = $data{$id}{Footprint}; |
||
| 437 | } else { |
||
| 438 | if ($data{$id}{Footprint} ne $data{$id}{Footprint}) { |
||
| 439 | err_printf("Different footprints for same device between sheets, script cannot ". |
||
| 440 | "work around this, will use first one, but expect that output file might ". |
||
| 441 | "have errors."); |
||
| 442 | } |
||
| 443 | } |
||
| 332 | agaran | 444 | push @{$BomData{$id}{Files}}, $fkey; |
| 445 | push @{$Files{$fkey}{$id}{RefDes}}, @{$data{$id}{RefDes}}; |
||
| 318 | agaran | 446 | |
| 313 | agaran | 447 | # printf "%-20s %.4f %s\n", $Inv[$id]{Manufacturer_Partno}, $cnt, $icost, join (', ', @{$data{$id}{RefDes}}); |
| 448 | # %BomData{ById}{$id}{RefDes} |
||
| 449 | } |
||
| 450 | } |
||
| 451 | |||
| 452 | sub file_lookup ($$$$) ; |
||
| 419 | agaran | 453 | sub file_lookup ($$$$) { # {{{1 |
| 313 | agaran | 454 | my ($dir, $depth, $regexp, $callback) = @_; |
| 455 | |||
| 419 | agaran | 456 | err_printf("BUG: Sorry, callback must be CODE ref") unless (ref $callback eq 'CODE'); |
| 313 | agaran | 457 | |
| 293 | agaran | 458 | if ( -d $dir) { |
| 322 | agaran | 459 | my $d = IO::Dir->new($dir); |
| 460 | return 1 if (!defined $d); |
||
| 461 | |||
| 462 | |||
| 463 | while (defined(my $e = $d->read)) { |
||
| 293 | agaran | 464 | my $fe = $dir .'/'. $e; |
| 465 | if ( -f $fe) { |
||
| 313 | agaran | 466 | if ($fe =~ $regexp) { |
| 467 | &$callback($fe); |
||
| 419 | agaran | 468 | $file_name = undef; |
| 293 | agaran | 469 | } |
| 470 | } elsif (-d $fe) { # now its dir... |
||
| 471 | if ($e eq '.svn') { # if entry name is equal to svn |
||
| 472 | next; # go to next entry in foreach loop |
||
| 473 | } |
||
| 474 | next if ($e eq '.' or $e eq '..'); # skip to next if dir entry is . or .. |
||
| 281 | jelle | 475 | |
| 313 | agaran | 476 | if ($Config{dbg_showdirs} == -1 or $Config{dbg_showdirs} > $depth) { |
| 419 | agaran | 477 | $file_name = undef; |
| 478 | dbg_printf("Entering directory %s", shortdir($fe)); |
||
| 293 | agaran | 479 | } |
| 313 | agaran | 480 | return 1 if (file_lookup($fe, $depth+1, $regexp, $callback) == 1); |
| 293 | agaran | 481 | } else { |
| 313 | agaran | 482 | # symlink or other mysterius beast |
| 293 | agaran | 483 | } |
| 484 | } |
||
| 485 | } |
||
| 313 | agaran | 486 | return 0; |
| 419 | agaran | 487 | } # }}} |
| 280 | agaran | 488 | |
| 419 | agaran | 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 | } |
||
| 643 | } |
||
| 644 | print $out $parttable->rule('-','+'); |
||
| 645 | |||
| 646 | $out->close(); |
||
| 647 | } #}}}1 |
||
| 648 | |||
| 293 | agaran | 649 | Getopt::Long::Configure("bundling"); |
| 280 | agaran | 650 | |
| 319 | agaran | 651 | if (scalar @ARGV == 0) { |
| 652 | Help_Show(); |
||
| 653 | exit; |
||
| 654 | } |
||
| 655 | |||
| 313 | agaran | 656 | my $result = Getopt::Long::GetOptions ( |
| 657 | "showrc|showconf" => sub { $show_conf = 1 }, |
||
| 658 | "docdir|d=s" => sub { $Config{docdir} = $_[1]; }, |
||
| 659 | # not sure if bomdir or SCH dir |
||
| 660 | "bomdir|b=s" => sub { $Config{$_[0]} = $_[1]; }, # $_[0] contain basename of option, so in few cases could be (ab)used |
||
| 419 | agaran | 661 | "define|D=s" => sub { my ($p,$q) = split(/=/,$_[1],2); $Config{$p} = ($q||1); }, |
| 662 | "verbose|v:+" => \$Config{'verbose'}, |
||
| 330 | agaran | 663 | "help|h|?:s" => sub { $show_help = 1; }, |
| 664 | "outfile|o=s" => sub { $Config{$_[0]} = $_[1]; }, |
||
| 665 | "force|f" => sub { $Config{$_[0]} = 1 }, |
||
| 337 | agaran | 666 | "lines|l=i" => sub { $Config{$_[0]} = abs(int($_[1]));}, |
| 313 | agaran | 667 | |
| 668 | # options |
||
| 293 | agaran | 669 | ); |
| 670 | if (!$result) { |
||
| 671 | printf "Usage: %s [-d directory] [-v]\n",basename($0); |
||
| 672 | exit; |
||
| 673 | } |
||
| 313 | agaran | 674 | |
| 675 | # ================================================== |
||
| 676 | # processing of options/config values, checking ranges etc |
||
| 677 | # |
||
| 678 | |||
| 679 | $Config{docdir} = fix_dir ($Config{docdir}); |
||
| 680 | $Config{bomdir} = fix_dir ($Config{bomdir}); |
||
| 681 | |||
| 682 | if ( $show_help == 1) { |
||
| 683 | Help_Show(); |
||
| 684 | exit; |
||
| 293 | agaran | 685 | } |
| 686 | |||
| 313 | agaran | 687 | if ( $show_conf == 1) { |
| 688 | Config_Show(); |
||
| 689 | exit; |
||
| 690 | } |
||
| 293 | agaran | 691 | |
| 313 | agaran | 692 | # make Inventory |
| 419 | agaran | 693 | nfo_printf("Fetching data from information.txt (under %s)",shortdir($Config{docdir})); |
| 313 | agaran | 694 | file_lookup($Config{docdir}, 0, qr/\/information.txt$/, \&parse_ifile); |
| 419 | agaran | 695 | nfo_printf("Finished, %d entries loaded.", scalar(@Inv)+1); |
| 313 | agaran | 696 | |
| 697 | # process BOM files |
||
| 419 | agaran | 698 | nfo_printf("Fetching BOM data from %s", shortdir($Config{bomdir})); |
| 313 | agaran | 699 | file_lookup($Config{bomdir}, 0, qr/\.bom$/, \&parse_bom); |
| 419 | agaran | 700 | nfo_printf("Finished, %d entries loaded.", scalar keys %BomData); |
| 313 | agaran | 701 | |
| 330 | agaran | 702 | if (!defined $Config{outfile}) { |
| 419 | agaran | 703 | $Config{outfile} = './output'; |
| 330 | agaran | 704 | wrn_printf("Output file not specified, saving out in ".$Config{outfile}); |
| 705 | } |
||
| 318 | agaran | 706 | |
| 419 | agaran | 707 | if ($Config{outfile} =~ /^(.*)\.txt$/) { |
| 708 | $Config{outfile} = $1; |
||
| 709 | inf_printf("Please specify output name without extension, -bom.txt and -map.txt will be added automatically"); |
||
| 330 | agaran | 710 | } |
| 318 | agaran | 711 | |
| 419 | agaran | 712 | gen_bomfile($Config{'outfile'}.'-bom.txt'); |
| 318 | agaran | 713 | |
| 419 | agaran | 714 | gen_mapfile($Config{'outfile'}.'-map.txt'); |
| 330 | agaran | 715 | |
| 419 | agaran | 716 | nfo_printf("Script finished, output saved in %s-{map,bom}.txt", $Config{outfile}); |
| 318 | agaran | 717 | |
| 419 | agaran | 718 | __END__ |
| 332 | agaran | 719 | |
| 419 | agaran | 720 | if ( -e $Config{outfile}) { |
| 721 | unless (defined $Config{force} && $Config{force} == 1) { |
||
| 722 | inf_printf("Unlinking output.txt before owrewriting"); |
||
| 723 | unlink($Config{outfile}); |
||
| 724 | } else { |
||
| 725 | wrn_printf("Output file already exist, add --force if i shall overwrite it"); |
||
| 726 | exit; |
||
| 337 | agaran | 727 | } |
| 728 | } |