Rev 281 | Rev 313 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed
| Rev 281 | Rev 293 | ||
|---|---|---|---|
| Line 1... | Line 1... | ||
| 1 | #!/usr/bin/perl -w
|
1 | #!/usr/bin/perl -w
|
| 2 | use strict; |
2 | use strict; |
| - | 3 | # $Id: inventory.pl 293 2008-11-18 22:52:14Z agaran $
|
|
| 3 | # Thu, 13 Nov 2008 21:06:23 +0100
|
4 | # Thu, 13 Nov 2008 21:06:23 +0100
|
| 4 | # Maciej 'agaran' Pijanka <agaran@pld-linux.org>
|
5 | # Maciej 'agaran' Pijanka <agaran@pld-linux.org>
|
| 5 | # for OpenARM SBC Project
|
6 | # for OpenARM SBC Project
|
| 6 | # license: gpl v3
|
7 | # license: gpl v3
|
| 7 | 8 | ||
| - | 9 | ||
| 8 | use Getopt::Long qw//; |
10 | use Getopt::Long qw//; |
| - | 11 | use File::Basename qw/basename/; |
|
| - | 12 | ||
| - | 13 | my %opts; |
|
| 9 | 14 | ||
| 10 | # ITS UNFINISHED
|
15 | $opts{dir} = '.'; |
| - | 16 | $opts{verbose} = 1; |
|
| 11 | 17 | ||
| 12 | # idea/todo
|
- | |
| 13 | # -v for verbose (muiltiple for more)
|
- | |
| 14 | # -q for quiet or -s for silent?
|
- | |
| 15 | #
|
- | |
| 16 | # some file with definitions of required fields
|
- | |
| 17 | # if not present (default) then hardcoded data will
|
- | |
| 18 | # be used
|
- | |
| 19 | #
|
- | |
| 20 | # split elements by types so defaults/required-fields
|
- | |
| 21 | # different for different types could be applied
|
- | |
| 22 | #
|
- | |
| 23 | # --verbose
|
- | |
| 24 | # --file "pathtoschematic"
|
18 | my $dirprintoffset = 0; |
| 25 | # --list "id,description,partid,manufacturer,ordercode,quanity,price,total"
|
- | |
| 26 | # --list "id,description,partid,footprint,refdes,sheet"
|
- | |
| 27 | # --configfile "pathtoconfigfile:
|
- | |
| 28 | # --search partid "LD1117S12TR"
|
- | |
| 29 | #
|
- | |
| 30 | # inventory.conf
|
- | |
| 31 | # path-to-directory-of-external-component-information
|
- | |
| 32 | # path-to-directory-of-schematics
|
- | |
| 33 | # match information-source to "information.txt"
|
- | |
| 34 | # match description to "Description:"
|
- | |
| 35 | # match manufacturer to "Manufacturer:"
|
- | |
| 36 | # match ordercode to "Order Code:"
|
- | |
| 37 | # calculate total per schematics
|
- | |
| 38 | # calculate total sum of all schematics
|
- | |
| 39 | # layout asci
|
- | |
| 40 | # spaces one
|
- | |
| 41 | # merge schematics information
|
- | |
| 42 | # seperate schematics information
|
- | |
| 43 | #
|
- | |
| 44 | # first stage is build list of all data found (no caching concept yet)
|
- | |
| 45 | # then find all sch and make bom? or find already done boms?
|
- | |
| 46 | 19 | ||
| 47 | sub dbg_printf($$@) { |
20 | sub err_printf($@) { |
| - | 21 | my ($format, @args) = @_; |
|
| - | 22 | ||
| - | 23 | printf STDERR "\n-E- ".$format."\n\n", @args; |
|
| - | 24 | }
|
|
| - | 25 | ||
| - | 26 | sub wrn_printf($@) { |
|
| 48 | my ($lvl, $format, @args) = @_; |
27 | my ($format, @args) = @_; |
| - | 28 | ||
| - | 29 | printf STDERR "-W- ".$format."\n", @args; |
|
| - | 30 | }
|
|
| 49 | 31 | ||
| - | 32 | sub inf_printf($@) { |
|
| 50 | return if ($lvl >= 3) ; |
33 | my ($format, @args) = @_; |
| 51 | 34 | ||
| 52 | printf STDERR $format, @args; |
35 | printf STDERR "-I- ".$format."\n", @args; |
| 53 | }
|
36 | }
|
| 54 | 37 | ||
| 55 | sub parse_ifile($) { |
38 | sub parse_ifile($) { |
| 56 | my ($filepath) = @_; |
39 | my ($filepath) = @_; |
| 57 | 40 | ||
| 58 | open(IN, $filepath) or return 1; |
41 | open(IN, $filepath) or return 1; |
| 59 | 42 | ||
| 60 | while (not eof IN) { |
- | |
| 61 | my $line = <IN>; |
43 | my %data; |
| 62 | 44 | ||
| - | 45 | while (not eof IN) { |
|
| 63 | chomp $line; |
46 | my $line = <IN>; |
| 64 | 47 | ||
| - | 48 | chomp $line; |
|
| - | 49 | ||
| - | 50 | next if ($line =~ /^[ ]*$/); |
|
| - | 51 | next if ($line =~ /^;/); |
|
| - | 52 | ||
| - | 53 | last if ($line =~ /^--/); |
|
| - | 54 | ||
| 65 | if ($line =~ /^[A-Z][a-z]+[ ]*:[ ]+.*$/) { |
55 | if ($line =~ /^([A-Za-z ]+):(.*)$/) { |
| 66 | my ($name,$value) = split (/[ ]*:[ ]+/, $line); |
56 | my ($name,$value) = ($1,$2); |
| - | 57 | ||
| - | 58 | $name =~ s/^[ ]+//; |
|
| - | 59 | $value =~ s/^[ ]+//; |
|
| - | 60 | ||
| - | 61 | $name =~ s/[ ]+$//; |
|
| - | 62 | $value =~ s/[ ]+$//; |
|
| - | 63 | ||
| - | 64 | $name = lc $name; |
|
| - | 65 | ||
| 67 | if ($name =~ /^price$/i) { |
66 | if ($name =~ /^price$/) { |
| - | 67 | $value =~ s/[^0-9\.\,]//g; |
|
| - | 68 | if ($value =~ s/^([0-9]+)[,.]([0-9]+)$/$1.$2/) { |
|
| - | 69 | # printf STDERR "Price %.3f\n", $value;
|
|
| - | 70 | if (!defined($data{price})) { |
|
| - | 71 | $data{price} = $value; |
|
| - | 72 | } else { |
|
| - | 73 | wrn_printf("Duplicated price field in file %s", |
|
| - | 74 | substr($filepath, $dirprintoffset)); |
|
| - | 75 | }
|
|
| - | 76 | } else { |
|
| - | 77 | err_printf("Bad price field in file %s", |
|
| - | 78 | substr($filepath, $dirprintoffset)); |
|
| - | 79 | }
|
|
| 68 | } elsif ($name =~ /^manufacturer$/i) { |
80 | } elsif ($name =~ /^manufacturer$/i) { |
| - | 81 | # printf STDERR "Manufacturer %s\n", $value;
|
|
| - | 82 | if (!defined($data{manufacturer})) { |
|
| - | 83 | $data{manufacturer} = $value; |
|
| - | 84 | } else { |
|
| - | 85 | wrn_printf("Duplicated manufacturer field in file %s", |
|
| - | 86 | substr($filepath, $dirprintoffset)); |
|
| - | 87 | }
|
|
| - | 88 | } elsif ($name =~ /^manufacturer part no$/ ) { |
|
| - | 89 | # printf STDERR "ManPartNo %s\n", $value;
|
|
| - | 90 | if (!defined($data{manufact_partno})) { |
|
| - | 91 | $data{manufact_partno} = $value; |
|
| - | 92 | } else { |
|
| - | 93 | wrn_printf("Duplicated manufacturer part no field in file %s", |
|
| - | 94 | substr($filepath, $dirprintoffset)); |
|
| - | 95 | }
|
|
| 69 | } elsif ($name =~ /^description$/i) { |
96 | } elsif ($name =~ /^description$/i) { |
| - | 97 | # printf STDERR "Desc %s\n", $value;
|
|
| - | 98 | $data{desc} = [] unless defined $data{desc}; |
|
| - | 99 | push @{$data{desc}}, $value; |
|
| 70 | } elsif ($name =~ /^datasheet$/i) { |
100 | } elsif ($name =~ /^datasheet$/i) { |
| - | 101 | $data{datasheet} = [] unless defined $data{datasheet}; |
|
| - | 102 | push @{$data{datasheet}}, $value; |
|
| - | 103 | # printf STDERR "Datasheet %s\n", $value;
|
|
| 71 | } elsif ($name =~ /^supplier$/i) { |
104 | } elsif ($name =~ /^supplier$/i) { |
| - | 105 | # printf STDERR "Supplier %s\n", $value;
|
|
| 72 | } elsif ($name =~ /^$/i) { |
106 | if (!defined($data{supplier})) { |
| - | 107 | $data{supplier} = $value; |
|
| 73 | } else { |
108 | } else { |
| - | 109 | wrn_printf("Duplicated supplier field in file %s", |
|
| - | 110 | substr($filepath, $dirprintoffset)); |
|
| - | 111 | }
|
|
| - | 112 | } elsif ($name =~ /^order code$/) { |
|
| 74 | dbg_printf(1, "UNHANDLED IDATA %s = %s\n", $name, $value); |
113 | # printf STDERR "Order Code %s\n", $value;
|
| - | 114 | if (!defined($data{ordercode})) { |
|
| - | 115 | $data{ordercode} = $value; |
|
| 75 | }
|
116 | } else { |
| - | 117 | wrn_printf("Duplicated order code field in file %s", |
|
| - | 118 | substr($filepath, $dirprintoffset)); |
|
| - | 119 | }
|
|
| - | 120 | #push @DATA, { $name => $value };
|
|
| - | 121 | } elsif ($name =~ /^url .*$/) { |
|
| - | 122 | # printf STDERR "URL %s\n", $value;
|
|
| - | 123 | } elsif ($name =~ /^catalog(ue|) page$/) { |
|
| - | 124 | # printf STDERR "Catalogue Page %s\n", $value;
|
|
| 76 | } else { |
125 | } else { |
| 77 | dbg_printf(3, "REST %s\n", $line); |
126 | err_printf("Unhandled field %s in file %s", $name, |
| - | 127 | substr($filepath, $dirprintoffset)); |
|
| - | 128 | }
|
|
| - | 129 | ||
| 78 | }
|
130 | } else { |
| - | 131 | wrn_printf("Unparseable line `%s', forgot ; to set it as comment in file %s\n", $line, |
|
| - | 132 | substr($filepath, $dirprintoffset)); |
|
| 79 | }
|
133 | }
|
| - | 134 | }
|
|
| 80 | close(IN); |
135 | close(IN); |
| - | 136 | ||
| - | 137 | if (scalar keys %data == 0) { |
|
| - | 138 | inf_printf("Skipping file %s because contain no data for me", |
|
| - | 139 | substr($filepath, $dirprintoffset)); |
|
| - | 140 | return; |
|
| - | 141 | }
|
|
| - | 142 | ||
| - | 143 | unless (defined ($data{price}) && $data{price} != 0) { |
|
| - | 144 | wrn_printf("Missing Price in file %s", |
|
| - | 145 | substr($filepath, $dirprintoffset)); |
|
| - | 146 | }
|
|
| - | 147 | ||
| - | 148 | unless (defined($data{manufact_partno})) { |
|
| - | 149 | inf_printf("Missing Manufacturer Part No in file %s", |
|
| - | 150 | substr($filepath, $dirprintoffset)); |
|
| - | 151 | }
|
|
| - | 152 | ||
| - | 153 | unless (defined($data{ordercode})) { |
|
| - | 154 | wrn_printf("Missing Order Code in file %s", |
|
| - | 155 | substr($filepath, $dirprintoffset)); |
|
| - | 156 | }
|
|
| - | 157 | ||
| - | 158 | use Data::Dumper qw/Dumper/; |
|
| 81 | 159 | ||
| - | 160 | #print Dumper(\%data);
|
|
| 82 | }
|
161 | }
|
| 83 | 162 | ||
| 84 | sub build_ifile_list($); |
163 | sub build_ifile_list($$); |
| 85 | sub build_ifile_list($) { |
164 | sub build_ifile_list($$) { |
| 86 | my ($dir) = @_; |
165 | my ($dir,$depth) = @_; |
| 87 | 166 | ||
| 88 | 167 | ||
| 89 | if ( -d $dir) { |
168 | if ( -d $dir) { |
| 90 | opendir(DIR, $dir) or return 1; |
169 | opendir(DIR, $dir) or return 1; |
| 91 | foreach my $e (readdir(DIR)) { |
170 | foreach my $e (readdir(DIR)) { |
| 92 | my $fe = $dir .'/'. $e; |
171 | my $fe = $dir .'/'. $e; |
| 93 | if ( -f $fe) { |
172 | if ( -f $fe) { |
| 94 | # Whoo file we have
|
173 | # Whoo file we have
|
| 95 | if ($e =~ /\.[pP][dD][fF]$/) { |
174 | if ($e eq 'information.txt') { |
| 96 | # its an pdf file if filename is correct
|
175 | # we found an information.txt file
|
| 97 | dbg_printf(3, "PDF %s\n", $fe); |
176 | parse_ifile($fe); |
| 98 | } elsif ($e eq 'information.txt') { |
177 | } elsif ($e =~ /\.[pP][dD][fF]$/) { |
| 99 | # we found an information.txt file
|
178 | # its an pdf file if filename is correct
|
| 100 | dbg_printf(2, "IFILE %s\n", $fe); |
- | |
| 101 | parse_ifile($fe); |
179 | } elsif ($e =~ /\.sch$/) { |
| 102 | } else { |
180 | } else { |
| 103 | printf STDERR "FILE %s\n", $fe; |
181 | # printf STDERR "FILE %s\n", $fe;
|
| 104 | }
|
182 | }
|
| 105 | } elsif (-d $fe) { # now its dir... |
183 | } elsif (-d $fe) { # now its dir... |
| 106 | if ($e eq '.svn') { # if entry name is equal to svn |
184 | if ($e eq '.svn') { # if entry name is equal to svn |
| 107 | next; # go to next entry in foreach loop |
185 | next; # go to next entry in foreach loop |
| 108 | }
|
186 | }
|
| 109 | next if ($e eq '.' or $e eq '..'); # skip to next if dir entry is . or .. |
187 | next if ($e eq '.' or $e eq '..'); # skip to next if dir entry is . or .. |
| 110 | 188 | ||
| 111 | dbg_printf(3, "DIR %s\n", $fe); |
189 | if ($opts{verbose} >= 2+$depth) { |
| 112 | # so we are in dir and not unwanted one
|
190 | printf STDERR "Entering directory %s\n", substr($fe,length($opts{dir})+1); |
| - | 191 | }
|
|
| 113 | build_ifile_list($fe); |
192 | build_ifile_list($fe,$depth+1); |
| 114 | # so scan deeper
|
- | |
| 115 | } else { |
193 | } else { |
| 116 | # symlink or other myserius beast
|
194 | # symlink or other myserius beast
|
| 117 | }
|
195 | }
|
| 118 | }
|
196 | }
|
| 119 | closedir(DIR); |
197 | closedir(DIR); |
| - | 198 | }
|
|
| - | 199 | }
|
|
| - | 200 | ||
| - | 201 | Getopt::Long::Configure("bundling"); |
|
| - | 202 | ||
| - | 203 | my $result = Getopt::Long::GetOptions (\%opts, |
|
| - | 204 | "dir|d=s", |
|
| - | 205 | "verbose|v+", |
|
| - | 206 | ); |
|
| - | 207 | if (!$result) { |
|
| - | 208 | printf "Usage: %s [-d directory] [-v]\n",basename($0); |
|
| - | 209 | exit; |
|
| - | 210 | }
|
|
| - | 211 | $opts{dir} =~ s/\/$//; |
|
| - | 212 | if ($opts{dir} eq '.') { |
|
| - | 213 | $dirprintoffset = 2; |
|
| 120 | }
|
214 | } else { |
| - | 215 | # i was thinking about some code which could shorten pathes in few cases but didnt created it yet
|
|
| 121 | }
|
216 | }
|
| 122 | 217 | ||
| 123 | build_ifile_list('.'); |
218 | print Data::Dumper::Dumper(\%opts); |
| 124 | 219 | ||
| - | 220 | build_ifile_list($opts{dir},0); |
|