Subversion Repositories OpenARM Single-board Computer

Rev

Rev 319 | Rev 325 | 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 322 2008-12-29 11:49:00Z 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;
280 agaran 14
 
313 agaran 15
my %Config;
280 agaran 16
 
313 agaran 17
# ==================================================
18
$Config{docdir} = '.';
19
$Config{bomdir} = '.';
20
$Config{verbose} = 1;
280 agaran 21
 
313 agaran 22
# 0 mean not show, -1 show all, positive value limits depth of shown
23
$Config{dbg_showdirs} = 0;
280 agaran 24
 
313 agaran 25
 
26
# modes
27
my $build_inventory = 0;
28
my $build_bom = 0;
29
my $show_conf = 0;
30
my $show_help = 0;
31
 
32
# ==================================================
33
 
34
my %Inv_By_PartNo;
35
my @Inv;
36
 
293 agaran 37
sub err_printf($@) {
38
        my ($format, @args) = @_;
280 agaran 39
 
313 agaran 40
        printf STDERR "-E- ".$format."\n", @args;
41
        # exit? or fail-exit here
280 agaran 42
}
43
 
293 agaran 44
sub wrn_printf($@) {
45
        my ($format, @args) = @_;
46
 
47
        printf STDERR "-W- ".$format."\n", @args;
48
}
49
 
50
sub inf_printf($@) {
51
        my ($format, @args) = @_;
52
 
53
        printf STDERR "-I- ".$format."\n", @args;
54
}
55
 
313 agaran 56
sub Config_Show {
57
        printf "Config for %s\n----------------------------------------\n", basename($0);
58
        foreach my $name (sort keys %Config) {
59
                printf "%-20s %s\n", $name, $Config{$name};
60
        }
61
}
62
 
63
sub Help_Show {
64
        printf "Help for %s\n----------------------------------------\n", basename($0);
65
        unless (defined($_[1]) && length($_[1]) != 0) {
66
                print "Basic help\n\t--showrc|showconf shows current configuration\n".
67
                        "\t--docdir|-d <dir> tells script where information.txt files should be searched\n".
68
                        "\t--define <something>=<somethingelseornot> defines some configration value\n".
319 agaran 69
                        "\t--verbose|-v [level] sets verbosity level\nOrder of options DOES matter\n".
70
                        "\t--bomdir|-b <dir> tells script where boms should be searched\n";
71
 
72
                print "\t\e[0;31mThis Help Is created especially for \e[0;33mJelle\e[0;29m\n".
73
                        "\tThis script search all directories below specified ones to find interesting files\n";
313 agaran 74
                return;
75
        }
76
        if ($_[1] =~ /^foo$/) {
77
                print "Noo, there is no foo's here\n";
78
        } else {
79
                printf "Sorry, help for `%s' don't exist (eventually) yet\n", $_[1];
80
        }
81
        exit;
82
}
83
 
84
sub fix_dir ($) {
85
        my $dir = shift @_;
86
 
87
        $dir =~ s/\/$//;
88
 
89
        if (! -d $dir) {
90
                err_printf("Sorry `%s' is not valid directory, exiting", $dir);
91
        }
92
 
93
        return $dir;
94
}
95
 
96
sub shortdir ($) {
97
        my $path = shift @_;
98
 
99
        return substr($path, 2) if ($path =~ /^\.\//) ;
100
        return $path;
101
}
102
 
103
 
104
sub trim($) {
105
        my ($value) = @_;
106
 
107
        $value =~ s/^ +//;
108
        $value =~ s/ +$//;
109
        return $value;
110
}
111
 
112
sub etrim($) {
113
        my ($value) = @_;
114
 
115
        $value =~ s/^[  ]+//;
116
        $value =~ s/[   ]+$//;
117
        return $value;
118
}
119
 
120
# this subroutine is used as callback function
121
# executed by file_lookup
280 agaran 122
sub parse_ifile($) {
293 agaran 123
        my ($filepath) = @_;
280 agaran 124
 
318 agaran 125
 
293 agaran 126
        open(IN, $filepath) or return 1;
280 agaran 127
 
293 agaran 128
        my %data;
280 agaran 129
 
293 agaran 130
        while (not eof IN) {
131
                my $line = <IN>;
280 agaran 132
 
293 agaran 133
                chomp $line;
280 agaran 134
 
293 agaran 135
                next if ($line =~ /^[   ]*$/);
136
                next if ($line =~ /^;/);
137
 
138
                last if ($line =~ /^--/);
139
 
140
                if ($line =~ /^([A-Za-z ]+):(.*)$/) {
313 agaran 141
                        my ($name,$value) = (lc etrim($1),etrim($2));
293 agaran 142
 
143
                        if ($name =~ /^price$/) {
144
                                $value =~ s/[^0-9\.\,]//g;
145
                                if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) {
146
                                        # printf STDERR "Price %.3f\n", $value;
147
                                        if (!defined($data{price})) {
148
                                                $data{price} = $value;
149
                                        } else {
313 agaran 150
                                                wrn_printf("Duplicated price field in file %s", shortdir($filepath));
293 agaran 151
                                        }
152
                                } else {
313 agaran 153
                                        err_printf("Bad price field in file %s", shortdir($filepath));
293 agaran 154
                                }
155
                        } elsif ($name =~ /^manufacturer$/i) {
156
                                # printf STDERR "Manufacturer %s\n", $value;
157
                                if (!defined($data{manufacturer})) {
158
                                        $data{manufacturer} = $value;
159
                                } else {
313 agaran 160
                                        wrn_printf("Duplicated manufacturer field in file %s", shortdir($filepath));
293 agaran 161
                                }
162
                        } elsif ($name =~ /^manufacturer part no$/ ) {
163
                                # printf STDERR "ManPartNo %s\n", $value;
164
                                if (!defined($data{manufact_partno})) {
313 agaran 165
                                        $data{manufact_partno} = trim($value);
293 agaran 166
                                } else {
167
                                        wrn_printf("Duplicated manufacturer part no field in file %s",
313 agaran 168
                                                shortdir($filepath));
293 agaran 169
                                }
170
                        } elsif ($name =~ /^description$/i) {
313 agaran 171
                                if (!defined($data{desc})) {
172
                                        $data{desc} = $value;
173
                                } else {
174
                                        wrn_printf("Duplicated description no field in file %s",
175
                                                shortdir($filepath));
176
                                }
293 agaran 177
                        } elsif ($name =~ /^datasheet$/i) {
178
                                $data{datasheet} = [] unless defined $data{datasheet};
179
                                push @{$data{datasheet}}, $value;
180
                                # printf STDERR "Datasheet %s\n", $value;
181
                        } elsif ($name =~ /^supplier$/i) {
182
                                # printf STDERR "Supplier %s\n", $value;
183
                                if (!defined($data{supplier})) {
184
                                        $data{supplier} = $value;
185
                                } else {
186
                                        wrn_printf("Duplicated supplier field in file %s",
313 agaran 187
                                                shortdir($filepath));
293 agaran 188
                                }
189
                        } elsif ($name =~ /^order code$/) {
190
                                # printf STDERR "Order Code %s\n", $value;
191
                                if (!defined($data{ordercode})) {
192
                                        $data{ordercode} = $value;
193
                                } else {
194
                                        wrn_printf("Duplicated order code field in file %s",
313 agaran 195
                                                shortdir($filepath));
293 agaran 196
                                }
197
                                #push @DATA, { $name => $value };
198
                        } elsif ($name =~ /^url .*$/) {
199
                                # printf STDERR "URL %s\n", $value;
200
                        } elsif ($name =~ /^catalog(ue|) page$/) {
201
                                # printf STDERR "Catalogue Page %s\n", $value;
202
                        } else {
203
                                err_printf("Unhandled field %s in file %s", $name,
313 agaran 204
                                        shortdir($filepath));
293 agaran 205
                        }
206
 
207
                } else {
208
                        wrn_printf("Unparseable line `%s', forgot ; to set it as comment in file %s\n", $line,
313 agaran 209
                                shortdir($filepath));
293 agaran 210
                }
211
        }
212
        close(IN);
213
 
214
        if (scalar keys %data == 0) {
215
                inf_printf("Skipping file %s because contain no data for me",
313 agaran 216
                        shortdir($filepath));
293 agaran 217
                return;
218
        }
219
 
220
        unless (defined ($data{price}) && $data{price} != 0) {
221
                wrn_printf("Missing Price in file %s",
313 agaran 222
                        shortdir($filepath));
293 agaran 223
        }
224
 
225
        unless (defined($data{manufact_partno})) {
226
                inf_printf("Missing Manufacturer Part No in file %s",
313 agaran 227
                        shortdir($filepath));
293 agaran 228
        }
229
 
230
        unless (defined($data{ordercode})) {
231
                wrn_printf("Missing Order Code in file %s",
313 agaran 232
                        shortdir($filepath));
293 agaran 233
        }
234
 
313 agaran 235
 
293 agaran 236
        use Data::Dumper qw/Dumper/;
313 agaran 237
 
238
        my $id = scalar @Inv;
239
 
240
        $Inv[$id] = {};
241
 
242
        $Inv[$id]{Datasheet} = delete $data{'datasheet'} if defined $data{'datasheet'};
243
        $Inv[$id]{Manufacturer} = delete $data{'manufacturer'} if defined $data{'manufacturer'};
244
        $Inv[$id]{Description} = delete $data{'desc'} if defined $data{'desc'};
245
        $Inv[$id]{Price} = delete $data{'price'} if defined $data{'price'};
246
        $Inv[$id]{Ordercode} = delete $data{'ordercode'} if defined $data{'ordercode'};
247
        $Inv[$id]{Manufacturer_Partno} = delete $data{'manufact_partno'} if defined $data{'manufact_partno'};
248
        $Inv[$id]{Supplier} = delete $data{'supplier'} if defined $data{'supplier'};
249
 
250
        unless (defined ($Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno}})) {
251
                $Inv_By_PartNo{$Inv[$id]{Manufacturer_Partno}} = $id;
252
        } else {
253
                wrn_printf("PartNumber %s happened more than once, using first occurence (id:%d)",
254
                        $Inv[$id]{Manufacturer_Partno}, $id);
255
        }
256
        #inf_printf("Part %s defined in file %s", $Inv[$id]{Manufacturer_Partno}, shortdir($filepath));
293 agaran 257
 
313 agaran 258
        wrn_printf("Unhandled data from parsing: %s", Dumper(\%data)) if (scalar keys %data > 0);
280 agaran 259
}
260
 
261
 
313 agaran 262
my %BomData;
263
sub parse_bom ($) {
264
        my ($filepath) = @_;
280 agaran 265
 
313 agaran 266
        open(IN, $filepath) or return 1;
267
 
268
        #wrn_printf("GotARg: %s", shortdir($filepath));
269
 
270
        my @Fields;
271
 
272
        my %data;
273
        my $v = '';
274
        while (not eof IN) {
275
                my $line = <IN>;
276
 
277
                chomp $line;
278
 
279
                if ($line =~ /^\.START$/) {
280
                        $v = 'boms';
281
                        next;
282
                }
283
 
284
                if ($line =~ /^\.END$/) {
285
                        $v = '';
286
                        next;
287
                }
288
 
289
                if ($v eq 'boms') {
290
                        @Fields = split(/\t/, substr($line,2));
291
                        $v = 'bom';
292
                        # some funny way to generate field-map
293
                        # that if someone reorder bom file columns we are still on place
294
                        next;
295
                }
296
 
297
                if ($v eq 'bom') {
298
                        my ($refdes, $device, $value, $footprint, $quantity) = split (/\t/, $line);
299
 
300
                        $device = trim($device);
301
 
302
#                       wrn_printf("Device: %s (value: %s) at refdes %s, %d pcs", $device, $value, $refdes, $quantity);
303
 
304
                        if (!defined $Inv_By_PartNo{$device}) {
305
                                wrn_printf("Device %s not found in inventory in file %s", $device, shortdir($filepath));
306
                                next;
307
                        }
308
                        my $id = $Inv_By_PartNo{$device};
309
                        next if ($Inv[$id]{Manufacturer} =~ /none/i); # skip parts whose manufacturer is none
310
                        #inf_printf("Found in Inventory at %d %s", $id, $Inv[$id]{Manufacturer_Partno});
311
                        push @{$data{$id}{RefDes}}, $refdes;
312
                }
313
        }
314
        close(IN);
315
 
316
        if (scalar keys %data == 0) {
317
                inf_printf("Skipping file %s because contain no data for me",
318
                        shortdir($filepath));
319
                return;
320
        }
321
 
322
        foreach my $id (keys %data) {
323
                my %tmp;
324
                map { $tmp{$_} = 1 } @{$data{$id}{RefDes}};
325
                @{$data{$id}{RefDes}} = keys %tmp;
326
                my $cnt = scalar @{$data{$id}{RefDes}};
327
                if (!defined $Inv[$id]{Price}) {
328
                        wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno});
329
                        $Inv[$id]{Price} = 0;
330
                }
318 agaran 331
                push @{$BomData{$id}{RefDes}}, @{$data{$id}{RefDes}};
332
 
313 agaran 333
#               printf "%-20s %.4f %s\n", $Inv[$id]{Manufacturer_Partno}, $cnt, $icost, join (', ', @{$data{$id}{RefDes}});
334
#               %BomData{ById}{$id}{RefDes}
335
        }
336
}
337
 
338
sub file_lookup ($$$$) ;
339
sub file_lookup ($$$$) {
340
        my ($dir, $depth, $regexp, $callback) = @_;
341
 
342
        err_printf("Sorry, callback must be CODE ref") unless (ref $callback eq 'CODE');
343
 
293 agaran 344
        if ( -d $dir) {
322 agaran 345
                my $d = IO::Dir->new($dir);
346
                return 1 if (!defined $d);
347
 
348
 
349
                while (defined(my $e = $d->read)) {
293 agaran 350
                        my $fe = $dir .'/'. $e;
351
                        if ( -f $fe) {
313 agaran 352
                                if ($fe =~ $regexp) {
353
                                        &$callback($fe);
293 agaran 354
                                }
355
                        } elsif (-d $fe) { # now its dir...
356
                                if ($e eq '.svn') { # if entry name is equal to svn
357
                                        next; # go to next entry in foreach loop
358
                                }
359
                                next if ($e eq '.' or $e eq '..'); # skip to next if dir entry is . or ..
281 jelle 360
 
313 agaran 361
                                if ($Config{dbg_showdirs} == -1 or $Config{dbg_showdirs} > $depth) {
362
                                        printf STDERR "Entering directory %s\n", shortdir($fe);
293 agaran 363
                                }
313 agaran 364
                                return 1 if (file_lookup($fe, $depth+1, $regexp, $callback) == 1);
293 agaran 365
                        } else {
313 agaran 366
                                # symlink or other mysterius beast
293 agaran 367
                        }
368
                }
369
        }
313 agaran 370
        return 0;
280 agaran 371
}
372
 
293 agaran 373
Getopt::Long::Configure("bundling");
280 agaran 374
 
319 agaran 375
if (scalar @ARGV == 0) {
376
        Help_Show();
377
        exit;
378
}
379
 
313 agaran 380
my $result = Getopt::Long::GetOptions (
381
        "showrc|showconf" => sub { $show_conf = 1 },
382
        "docdir|d=s" => sub { $Config{docdir} = $_[1]; },
383
        # not sure if bomdir or SCH dir
384
        "bomdir|b=s" => sub { $Config{$_[0]} = $_[1]; },  # $_[0] contain basename of option, so in few cases could be (ab)used
385
        "define|D=s" => sub { my ($p,$q) = split(/=/,$_[1],2); $Config{$p} = $q; },
386
        "verbose|v:+" => sub { $Config{$_[0]} = ($_[1]>1?0:$Config{$_[0]}) + $_[1]; },
387
        "help|h|?:s" => sub { $show_help = 1 },
388
 
389
        # options 
293 agaran 390
);
391
if (!$result) {
392
        printf "Usage: %s [-d directory] [-v]\n",basename($0);
393
        exit;
394
}
313 agaran 395
 
396
# ==================================================
397
# processing of options/config values, checking ranges etc
398
# 
399
 
400
$Config{docdir} = fix_dir ($Config{docdir});
401
$Config{bomdir} = fix_dir ($Config{bomdir});
402
 
403
if ( $show_help == 1) {
404
        Help_Show();
405
        exit;
293 agaran 406
}
407
 
313 agaran 408
if ( $show_conf == 1) {
409
        Config_Show();
410
        exit;
411
}
293 agaran 412
 
313 agaran 413
# make Inventory
414
file_lookup($Config{docdir}, 0, qr/\/information.txt$/, \&parse_ifile);
415
 
416
# process BOM files
417
file_lookup($Config{bomdir}, 0, qr/\.bom$/, \&parse_bom);
418
 
318 agaran 419
my $n = 0;
420
my $cost = 0.0;
421
 
422
sub shortstring($$) {
423
        my ($str,$lim) = @_;
424
        return substr($str,0,$lim-4).'(..)' if (length ($str) > $lim);
425
        return $str;
426
}
427
 
428
 
429
 
430
open (BOMOUT, '>output.bom') || die 'cant open output.bom: $!';
431
open (PARTMAP, '>output.map') || die 'cant open output.map: $!';
432
 
322 agaran 433
printf BOMOUT "|%s|\n|    |  %-33s|  %-20s|  %-18s|  %-11s|%-5s|%-6s|%-6s|\n|----+-----------------------------------+".
434
        "----------------------+--------------------+-------------+------+------+------|\n", ("-" x 119),
318 agaran 435
        'description','manufact. partno','manufacturer','order code','quant.','price','cost';
436
printf PARTMAP "%-35s| refdes\n\n", 'part';
437
 
438
 
439
foreach my $id (keys %BomData) {
440
        my %tmp;
441
        map { $tmp{$_} = 1 } @{$BomData{$id}{RefDes}};
442
        @{$BomData{$id}{RefDes}} = keys %tmp;
443
        my $cnt = scalar @{$BomData{$id}{RefDes}};
444
        if (!defined $Inv[$id]{Price}) {
445
                wrn_printf("%s has no price, setting to 0.0", $Inv[$id]{Manufacturer_Partno});
446
                $Inv[$id]{Price} = 0;
447
        }
448
        my $icost = $cnt * $Inv[$id]{Price};
449
 
450
        printf BOMOUT "|%4d|%-35s|%-22s|%-20s|%-13s|%6d|%6.3f|%6.3f|\n", $n, shortstring($Inv[$id]{Description},35),
451
                shortstring($Inv[$id]{Manufacturer_Partno},22), shortstring($Inv[$id]{Manufacturer},20),
452
                shortstring($Inv[$id]{Ordercode}, 13), $cnt, $Inv[$id]{Price}, $icost;
453
 
454
        printf PARTMAP "%-35s|%s\n", shortstring($Inv[$id]{Description},35), join (', ', @{$BomData{$id}{RefDes}});
455
        $cost += $icost;
456
#       %BomData{ById}{$id}{RefDes}
457
        $n ++;
458
}
319 agaran 459
printf BOMOUT "|%s|\n| %-118s|\n|%s|\n", ("-" x 119), sprintf ("Total cost: %.3f, generated at %s", $cost, scalar localtime(time())), ("-" x 119);
318 agaran 460
 
461
close BOMOUT;
462
close PARTMAP;