Subversion Repositories OpenARM Single-board Computer

Rev

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