4 # ./farnell-find [<options>] [describe] NNN-NNNN ....
5 # Prints info about the specified relevant part.
6 # ./farnell-find [<options>] order [<sid>|<url>] [NNN-NNNN <qty> ...]
7 # Add specified parts and quantities to the cart.
8 # If no parts and quantities specified on command line,
9 # will read from stdin (format is <item> <qty>).
10 # If no <sid> or <url> specified (ie thing with jsessionid)
11 # then will prompt and read a line from tty.
12 # ./farnell-find [<options>] bom <file> ...
13 # Processes input files and produces BOM parts list.
14 # ./farnell-find [<options>] order-bom <file> ...
15 # Processes input files and adds BOM parts to cart.
19 # Specifies sort order for BOM. Several may be specified, first
20 # one on the command line is least significant. Can be `desc'
21 # `avail' `price'. Default sort order is avail, then price,
22 # then desc (equivalent to -Sdesc -Sprice -Savail).
24 # Input format: lines, #-comments, blank lines ignored.
25 # Indent level is relevant, but only 0, 1, >1 relevant.
26 # Order of information in a file is not relevant unless explicitly
31 # Circuit names must start with an uppercase letter.
33 # Starts an iteratable (ends at start of next cct).
34 # Iteratable name must start with uppercase letter,
35 # may contain any non-ws chars.
36 # <item> <qty> [<use>]
37 # <part> <qty> [<use>]
38 # Specifies that the circuit contains that part
39 # in the quantity specified. Quantity is scaled
40 # by the iteratable's count if we're in an iteratable.
41 # <use> is any string starting with a non-ws char.
42 # <qty> is <num>[=] or <num>/<denom>[=]. <num> is
43 # an integer. = says not to order one extra. <denom>
44 # is an integer (meaning the number of gates to
45 # a device) or an integer followed by / (meaning we
46 # can't mix this use with other uses or other circuits).
47 # <part> = <item> [<desc]>
48 # Defines <part>. <part> is a sequence of words each separated
49 # by one space. Each word consists of some non-ws chars. The
50 # first word may not consist entirely of digits and hyphens; no
51 # other words may consist entirely of digits, slashes and
52 # equals signs. <desc> is any string starting with non-ws.
53 # <part prefix> ? = <desc prefix>
54 # Gives a default description of parts which have <part prefix>
55 # as an initial subsequence of words. <part prefix> has the
56 # syntax of a <part>. The description is used only if there is
57 # no more specific description, and the constructed description
58 # is <desc prefix> with a space and the remainder of the part
62 # suppress <part glob>
63 # Suppresses all processing for all parts matching the
66 # count <count> <iteratable>
67 # include <circuit> ) use only one of
68 # exclude <circuit> ) include and exclude
71 # Ends the file. Optional.
79 use HTTP::Request::Common;
85 # neither @warn nor @fault entries have trailing \n
88 # $pkinddesc{'a b c'} => 'y' after `a b c ? = y'
91 # $parts{"$circuit\n$iteratable"}[]{Part} or item
92 # $parts{"$circuit\n$iteratable"}[]{Qty}
93 # $parts{"$circuit\n$iteratable"}[]{Use}
94 # $parts{"$circuit\n$iteratable"}[]{FileLine}
97 # $partdef{"part name"}= $item;
100 # $count{"$iteratable"} is number of times iteratable is instantiated
101 # (no syntax for specifying this atm)
104 # @{ $iteminstances{$item} } one entry for every line which mentions it
105 # $iteminstances{$item}[]{Use} includes circuit
106 # $iteminstances{$item}[]{Qty}
107 # $iteminstances{$item}[]{Mult} number of this iteratable
108 # $iteminstances{$item}[]{FileLine}
111 # $itemdesc{$item}[]= $desc;
114 # $iteminfo{$item}= by_item(...);
117 # $show{$item}{Head} ) newline terminated
118 # $show{$item}{Info} ) strings ready to print
119 # $show{$item}{Price} calculated value
122 our(@suppress_partre);
124 our($incexc); # 'include' or 'exclude'
125 our(%incexc); # $incexc{$circuit}= 1; for those mentioned
128 # list of desc price avail
133 our($partfrac_unique)= 'aaaa'; # increments
135 our($partword1_re)= '\S*[^ \t0-9-]\S*';
136 our($partword_re)= '\S*[^ \t0-9/=]\S*';
137 our($part_re)= "$partword1_re(?: $partword_re)*";
138 our($item_re)= '\d{3}\-\d{3,7}';
140 our(%stockmap)= ('In Stock' => 'Y',
141 'Awaiting Delivery' => 'A');
142 our($urlbase)= 'http://uk.farnell.com';
144 sub get_useragent () {
145 my ($whoami,$mailname);
146 return if defined $useragent;
147 die "want http_proxy\n" unless exists $ENV{'http_proxy'};
148 chomp($whoami= `whoami`); $? and die $?;
149 chomp($mailname= `cat /etc/mailname`); $? and die $?;
150 $useragent= new LWP::UserAgent(env_proxy => 1, keep_alive =>1);
153 sub check_response ($$) {
154 my ($response,$url) = @_;
155 $response->is_success or die "$url ".$response->as_string." ?";
159 my ($itemcode,$why) = @_;
160 # looks up $itemcode (ddd-d...) at Farnell and returns
163 my ($chr,$shortcode,$sc2,$url,$price);
164 $url= "$urlbase/jsp/catalog/viewproductdetails.jsp?prodId=";
165 $itemcode =~ m/^(\d\d\d)\-(\d{3,7})$/ or die "$itemcode ?";
166 $chr->{Item}= $itemcode;
167 $chr->{Shortcode}= $1.$2;
168 $url .= $chr->{Shortcode};
169 if (!-f "farn.$itemcode") {
172 $response= $useragent->get($url);
173 check_response($response, $url);
174 $_= $response->content;
175 open N, ">tmp.farn.$itemcode" or die $!;
178 rename "tmp.farn.$itemcode", "farn.$itemcode" or die $!;
179 unlink "tmp.farnerr.$itemcode";
181 $_= `cat farn.$itemcode`; $? and die $?;
183 s/[^\n\t\x20-\x7e\£]/\?/g;
185 $sc2= snarf('Order Code / Sku');
186 die "wrong results $sc2 ?\n" unless $sc2 eq $chr->{Shortcode};
191 $emsg= "item $itemcode: $@";
192 $emsg.= " ($why)" if defined $why;
196 $chr->{Description}= snarf('Description');
198 my ($partno)= snarf('Manufacturer Part Number');
199 $chr->{Description}= "[$partno] $chr->{Description}";
201 $chr->{Avail}= snarf('Stock Availability');
202 $chr->{MinOrder}= snarf('Minimum Order');
203 $chr->{Multiple}= snarf('Order Multiple');
204 $price= snarf('Unit Price', "\n\<!--.*--\\>");
205 $price =~ m/\£(\d+\.\d\d+)$/ or die "price $price ?";
212 my ($thing, $allowbefore) = @_;
213 $allowbefore= defined $allowbefore ? "(?:$allowbefore)?" : '';
215 \<td class="tabledata"(?: width="\d+%")?\>$thing</td>
216 \<td class="tabledata"(?: width="\d+%")?\>$allowbefore
220 or die "no $thing ?\n";
225 my (@orderlist) = @_;
226 my ($i, $url, $item, $qty, @submit, $request, $response);
230 $url= "$urlbase/jsp/op/shoppingbasket.jsp;jsessionid=$jsessionid";
232 $response= $useragent->get($url);
233 check_response($response, $url);
234 $_= $response->content;
237 ($item, $qty, @orderlist) = @orderlist;
239 ?)(\<tr class=\"tabledata)((?:_alt)?)(\"\>
241 ?\<input type=\"text\" name=\"k1\" value=\")(\"[^<>]*\>
242 ?\<input type=\"hidden\" name=\"_D:k1\" value=\" \"\>
244 ?\<td\>\<input type=\"text\" name=\"k3\" value=\")1(\"[^<>]*\>
245 ?\<input type=\"hidden\" name=\"_D:k3\" value=\" \"\>
246 ?\</td\>\<td\b[^<>]*\>\ \;\</td\>
248 ?)((?:\<tr class=\"tabledata(?:_alt)?\"\>
250 ?\<input type=\"text\" name=\"k1\" value=\"\"[^<>]*\>
251 ?\<input type=\"hidden\" name=\"_D:k1\" value=\" \"\>
253 ?\<td\>\<input type=\"text\" name=\"k3\" value=\"1\"[^<>]*\>
254 ?\<input type=\"hidden\" name=\"_D:k3\" value=\" \"\>
255 ?\</td\>\<td\b[^<>]*\>\ \;\</td\>
258 ?\<td [^<>]* class=\"tableheading\"\>
262 ?\<td align=\"right\" class=\"tabletotal\"\>
265 or die "no blanks\n";
267 my ($page_head)= $`.$1;
268 my ($entry_2alt, $entry_alt2item, $entry_item2qty, $entry_qty2)
270 my ($this_alt)= !!length $3;
271 my ($page_tail)= $7.$';
274 $entry_2alt. ($this_alt ? '' : '_alt').
275 $entry_alt2item. $item. $entry_item2qty. $qty. $entry_qty2.
278 $entry_alt2item. $entry_item2qty. 1 . $entry_qty2.
280 $entry_alt2item. $entry_item2qty. 1 . $entry_qty2
285 m!\</head\>! or die "no </head>\n";
286 $page_output= $`. "<base href=\"$urlbase\">\n" . $& . $';
289 die "$_ huh $@ ?" unless m/\<body [^<>]*\>/;
291 "<h1><strong>ERRORS FROM FARNELL-FIND:</strong></h1>\n".
295 "<h1>In output data:</h1>\n".
298 open N, ">tmp.farn.basket.html" or die $!;
299 print N $page_output or die $!;
301 exec 'w3m','./tmp.farn.basket.html'; die $!;
307 my ($circuit,$iteratable,$desc);
308 my ($part,$qty,$use,$f);
309 $f= new IO::File $filename, 'r' or die "$filename: $!\n";
312 die "$filename: read: $!\n" if $f->error;
313 last unless defined $_;
316 next if m/^\#/ || !m/\S/;
320 } elsif (m/^ per ([A-Z]\S+)$/) {
324 } elsif (m,^\s+($part_re|$item_re)\s+([0-9/=]+)(?:\s+(\S.*))?$,) {
325 ($part,$qty,$use) = ($1,$2,$3);
326 $qty .= $partfrac_unique++ if $qty =~ m,/$,;
327 push @{ $parts{"$circuit\n$iteratable"} }, {
328 Part => $part, Qty => $qty, Use => $use,
329 FileLine => "$filename:$."
331 } elsif (m/^($part_re)\s+\?\s+\=\s+(\S.*)$/) {
332 die if exists $pkinddesc{$1};
334 } elsif (m/^($part_re)\s+\=\s+($item_re)(?:\s+(\S.*))?$/) {
335 die if exists $partdef{$1};
338 push @{ $itemdesc{$2} }, "$1: $3";
340 } elsif (m/^suppress\s+($item_re)$/) {
341 $suppress_item{$1}= 1;
342 } elsif (m/^suppress\s+(\S.*)$/) {
344 s/\W/ ($& eq '*' ? '.*' :
347 push @suppress_partre, $_;
348 } elsif (m/^count\s+(\d+)\s+([A-Z].*)$/) {
350 } elsif (m/^(include|exclude)\s+([A-Z].*)$/) {
351 die "both include and exclude\n" if
352 defined $incexc && $incexc ne $1;
362 sub itemsortmap ($) {
364 my ($o, $bi, $how, $price,$title);
366 $bi= $iteminfo{$item};
368 $bi= { Avail => '?U' };
369 $bi->{Description} = $itemdesc{$item} ? $itemdesc{$item}[0] : '?U';
371 foreach $how (@sorthow) {
372 if ($how eq 'price') {
373 $price= exists $show{$item} ? $show{$item}{Price} : 0.0;
374 $o .= sprintf "%030.20f ", 1.0 / ($price + 0.0001);
375 } elsif ($how eq 'desc') {
376 $title= $bi->{Description};
377 $title .= "\n".$1 if $title =~ s/^(\[[^][]+\]) //;
379 } elsif ($how eq 'avail') {
388 sub hrule () { print '-'x79, "\n" or die $!; }
390 sub iteminstanceprint ($) {
394 $ql= $ii->{Qty}; $qr= '';
395 if ($ql =~ s/\D\d+$//) { $qr= $&; }
396 if ($ql =~ s,(\d+)/[a-z]+$,,) { $qr= "$1/"; }
397 if ($ql =~ s/\=//) { $qr .= $&; }
398 return sprintf("%*s %5s%-2s %s%s\n",
401 $ii->{Mult} != 1 ? "(x$ii->{Mult}) " : '',
405 sub analyse_spec ($) {
407 my ($part,$pd,$try,@rhs,$sp,$circuit,$iteratable,$count,$pe,$use);
408 my ($item,$totalqty,$ii,$bi,$toorder,$price,$total,$notechar,$desc);
409 my ($avail,%avail,$desclen,$why,$suppress,%suppress,$pi);
410 my ($iteminstance,@orderlist);
412 foreach $part (sort keys %partdef) {
413 $item= $partdef{$part};
414 next if exists $itemdesc{$item};
419 if ($try !~ s/\s+(\S+)$//) {
420 push @{ $itemdesc{$item} }, $part;
424 if (exists $pkinddesc{$try}) {
425 push @{ $itemdesc{$item} }, join(' ', $pkinddesc{$try}, @rhs);
430 foreach $sp (sort keys %parts) {
431 $sp =~ m/\n/ or die "$sp ?";
435 (defined $incexc && $incexc eq 'include')
436 xor exists $incexc{$circuit};
437 if (exists $count{$iteratable}) {
438 $count= $count{$iteratable};
440 push @warn, "assuming only 1 $iteratable" if length $iteratable;
443 foreach $pe (@{ $parts{$sp} }) {
445 $use= defined $use ? "$circuit: $use" : $circuit;
448 if ($part =~ m/^$item_re$/) {
450 } elsif (exists $partdef{$part}) {
451 $suppress= 1 if grep { $part =~ m/^$_$/ } @suppress_partre;
452 $item= $partdef{$part};
454 push @fault, "unknown part $part ($pe->{FileLine})";
457 $suppress= 1 if exists $suppress_item{$item};
462 FileLine => $pe->{FileLine},
465 push @{ $suppress{$item} }, iteminstanceprint($iteminstance);
467 push @{ $iteminstances{$item} }, $iteminstance;
472 foreach $item (sort keys %iteminstances) {
473 $why= defined $itemdesc{$item} ? $itemdesc{$item}[0].'; ' : '';
474 $why .= join ",", map { $_->{FileLine} } @{ $iteminstances{$item} };
475 $bi= by_item($item, $why);
476 $iteminfo{$item}= $bi;
478 foreach $item (keys %iteminstances) {
480 foreach $ii (@{ $iteminstances{$item} }) {
481 addqty($totalqty, $ii->{Qty}, $ii->{Mult}, $item, $ii->{FileLine});
483 $bi= $iteminfo{$item};
485 ($toorder,$notechar)= calcorder($totalqty, $bi);
486 next unless $toorder > 0;
487 $price= $toorder * $bi->{Price};
488 $avail= $bi->{Avail};
490 $avail= ' '.$stockmap{$avail} if exists $stockmap{$avail};
492 sprintf("%4d%1s %-10s %-${desclen}.${desclen}s".
493 " %7.3f %7.2f%1s %s\n",
494 $toorder, $notechar, $item, $bi->{Description},
495 $bi->{Price}, $price, $notechar, $avail);
496 $show{$item}{Info}= '';
498 $show{$item}{Price}= $price;
499 $show{$item}{ToOrder}= $toorder;
500 foreach $desc (@{ $itemdesc{$item} }) {
501 $show{$item}{Info} .=
506 foreach $ii (@{ $iteminstances{$item} }) {
507 $show{$item}{Info} .= iteminstanceprint($ii);
510 if ($op eq 'order-bom') {
513 printf " Qty %-10s %-*s (ex VAT) Each Total Stock?\n\n",
514 'Item', $desclen-7, 'Part no. and Description'
517 foreach $item (sort { itemsortmap($a) cmp itemsortmap($b); }
519 if ($op eq 'order-bom') {
520 push @orderlist, $item, $show{$item}{ToOrder};
522 print $show{$item}{Head}, $show{$item}{Info}, "\n"
526 if ($op eq 'order-bom') {
527 cart_add(@orderlist);
530 printf("%*s %11s %-*s %6.2f\n",
533 ($desclen+1+6), join(' / ', sort keys %avail),
536 print "\n" or die $!;
537 if (keys %suppress) {
538 print "---------- suppressed ----------\n" or die $!;
539 foreach $item (sort { itemsortmap($a) cmp itemsortmap($b); }
542 foreach $ii (@{ $itemdesc{$item} }) {
543 printf " %-10s %s\n", $pi, $ii
548 print " $pi\n" or die $!;
550 foreach $ii (@{ $suppress{$item} }) {
554 print "\n" or die $!;
561 my ($totalqty, $q2, $m2, $item) = @_;
562 if ($q2 !~ m!^(\d+)(?:/(\d+)(?:/(\w+))?)?(\=?)$!) {
563 push @fault, "bad quantity $q2 x$m2 for item $item";
566 my ($numer,$denom,$uniq,$exact) = ($1,$2,$3,$4);
568 $totalqty->{Inexact}= 1;
570 $denom=1 if !defined $denom;
573 die if exists $totalqty->{Uniques}{$uniq};
574 $totalqty->{Uniques}{$uniq}{Numer}= $numer;
575 $totalqty->{Uniques}{$uniq}{Denom}= $denom;
577 if (!exists $totalqty->{Denom}) {
578 $totalqty->{Denom}= $denom;
579 $totalqty->{Numer}= $numer;
580 } elsif ($denom ne $totalqty->{Denom}) {
581 push @fault, "denominator for item $item changes from".
582 " $totalqty->{Denom} to $denom";
584 $totalqty->{Numer} += $numer;
590 my ($totalqty, $bi) = @_; # => ($toorder, $notechar);
591 my ($notechar, $exact, $need, $uniq);
594 if (!exists $totalqty->{Inexact}) {
599 foreach $uniq (keys %{ $totalqty->{Uniques} }) {
600 $need += calcneed($totalqty->{Uniques}{$uniq}, undef);
602 $need += calcneed($totalqty, \$notechar) if exists $totalqty->{Numer};
603 $need++ if $need && !$exact;
604 if ($need % $bi->{Multiple}) {
605 $need= floor(($need + $bi->{Multiple} - 1) / $bi->{Multiple})
609 if ($need && $need < $bi->{MinOrder}) {
610 $need= $bi->{MinOrder};
617 my ($tqr, $notechar) = @_;
619 $want= $tqr->{Numer} * 1.0 / $tqr->{Denom};
621 $$notechar= '/' if $must>$want && $notechar;
625 sub dump_warnerrs () {
628 foreach $w (@fault) { next if $r{$w}++; print("ERROR: $w\n") or die $!; }
629 foreach $w (@warn) { next if $r{$w}++; print("WARNING: $w\n") or die $!; }
630 STDOUT->flush or die $!;
631 die "errors\n" if @fault;
634 @sorthow= qw(avail price desc);
636 while (@ARGV && $ARGV[0] =~ m/^\-/) {
639 if (m/^\-S(avail|price|desc)$/) {
640 unshift @sorthow, $1;
642 die "unknown option \`$_'\n";
646 sub is_jsessionid ($) {
649 $a =~ m/\;jsessionid=([0-9A-Z]+)\b/ ||
650 $a =~ m/^([0-9A-Z]+)$/;
654 sub need_jsessionid () {
657 return if defined $jsessionid;
658 open TTY, "+< /dev/tty" or die $!;
659 select((select(TTY), $|=1)[0]);
660 print TTY "URL or jsessionid: " or die $!;
661 $_= <TTY>; TTY->error and die $!;
663 $newjsid= is_jsessionid($_);
664 defined $newjsid or die;
665 $jsessionid= $newjsid;
673 $op= $ARGV[0] =~ m/^\d/ ? 'describe' : shift @ARGV;
675 if ($op eq 'describe') {
677 foreach $item (@ARGV) {
678 $chr= by_item($item);
680 foreach $k (sort keys %$chr) {
681 printf "%-20s %s\n", $k, $chr->{$k} or die $!;
684 } elsif ($op eq 'order') {
685 my ($qty, @orderlist, $newjsid);
688 if (defined($newjsid= is_jsessionid($a))) {
689 die if defined $jsessionid;
690 $jsessionid= $newjsid;
691 } elsif ($a =~ m/^$item_re$/) {
694 push @orderlist, $a, $qty;
701 defined($_= <STDIN>) or last;
705 m/^($item_re)\s+(\d+)$/ or die "$_ ?";
706 push @orderlist, $1, $2;
708 die $! if STDIN->error;
710 cart_add(@orderlist);
711 } elsif ($op eq 'bom' || $op eq 'order-bom') {
713 foreach $filename (@ARGV) {
714 read_spec($filename);