can find things

diff --git a/.cvsignore b/.cvsignore
index fa3989b6e3054849a39c7caf7e4824e985d3bfaf..08aaf5d05e41623afbd77f50d140ae34726338c8 100644 (file)
--- a/.cvsignore
+++ b/.cvsignore
@@ -10,3 +10,4 @@ testjoin
 *,*.gnuplot-cmd
 *,gnuplot-fifo
 *.gnuplots.sh
+farn.*

diff --git a/farnell/farnell-find b/farnell/farnell-find
index 9a5ceabd5d565f43375af622261153029fd53e4c..038713f4d5264def5427ed74d4c523dac918aa4f 100755 (executable)
--- a/farnell/farnell-find
+++ b/farnell/farnell-find
@@ -1,11 +1,37 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w
+
+use strict;
+
+our(@warn);
+our(@fault);
+our(%pkinddesc); # $pkinddesc{'a b c'} => 'y'  after `a b c ? = y'
+
+our(%parts);
+# $parts{"$sect/$sper"}[]{Part}
+# $parts{"$sect/$sper"}[]{Qty}
+# $parts{"$sect/$sper"}[]{Desc}
+
+our(%partdef);
+# $partdef{"part name"}{Item}
+# $partdef{"part name"}{Desc}
+
+our(%count);
+# $count{"$sper"} is number of times sper is instantiated
+#   (no syntax for specifying this atm)
+
+our(%iteminstances);
+# @{ $iteminstances{$item} }  one entry for every sect/sper which has it
+# $iteminstances{$item}[]{Desc}
+# $iteminstances{$item}[]{Qty}
+# $iteminstances{$item}[]{SectPer}
+# $iteminstances{$item}[]{Mult}   number in this sect/sper
 
 sub by_item ($) {
     my ($itemcode) = @_;
     # looks up $itemcode (ddd-d...) at Farnell and returns
     # cat hash ref
     local ($_);
-    my ($chr,$shortcode,$sc2,$url);
+    my ($chr,$shortcode,$sc2,$url,$price);
     $url= 'http://uk.farnell.com/jsp/catalog/viewproductdetails.jsp?prodId=';
     $itemcode =~ m/^(\d\d\d)\-(\d{3,7})$/ or die;
     $chr->{Item}= $itemcode;
@@ -18,41 +44,159 @@ sub by_item ($) {
        unlink "tmp.farnerr.$itemcode";
     }
     $_= `cat farn.$itemcode`; $? and die $?;
-    s/[^\n\t\x20-\x7e]/\?/g;
-    $sc2= snarf('Order Code / Sku');
-    die "wrong results $snarf ?" unless $sc2 eq $chr->{Shortcode};
+    s/[^\n\t\x20-\x7e\£]/\?/g;
+    if (!eval {
+       $sc2= snarf('Order Code / Sku');
+       die "wrong results $sc2 ?\n" unless $sc2 eq $chr->{Shortcode};
+       1;
+    }) {
+       $@ =~ s/\n$//;
+       push @warn, "item $itemcode: $@";
+       return undef;
+    }
     $chr->{Description}= snarf('Description');
     $chr->{Avail}= snarf('Stock Availability');
     $chr->{MinOrder}= snarf('Minimum Order');
     $chr->{Multiple}= snarf('Order Multiple');
+    $price= snarf('Unit Price', "\n\<!--.*--\\>");
+    $price =~ m/\£(\d+\.\d\d)$/ or die "price $price ?";
+    $chr->{Price}= $1;
+    # price
     return $chr;
 }
     
-sub snarf ($) {
-    my ($thing) = @_;
+sub snarf ($;$) {
+    my ($thing, $allowbefore) = @_;
+    $allowbefore='' if !defined $allowbefore;
     m!
 \<td class="tabledata"(?: width="\d+%")?\>$thing</td>
-\<td class="tabledata"(?: width="\d+%")?\>
+\<td class="tabledata"(?: width="\d+%")?\>(?:$allowbefore)?
 (.+)(?:\n\&nbsp\;)*
 \</td>
 !
-    or die "no $thing ?";
+    or die "no $thing ?\n";
     return $1;
 }
 
 sub read_spec () {
     local ($_);
+    my ($section,$sectionper);
     for (;;) {
        $!=0; $_=<F>; die unless length $_;
        chomp; s/\s+$//;
        last if m/^end$/;
        next if m/^\#/ || !m/\S/;
-       
-       if (m/^
-       $section= 
+       if (m/^[A-Z].*$/) {
+           $section= $&;
+           $sectionper= '';
+       } elsif (m/^ per ([A-Z]\S+)$/) {
+           $sectionper= $1;
+       } elsif (m/^ \S/) {
+           die "$_ ?";
+       } elsif (
+ m,^\s+(\S+(?:\s+\S*[^ \t0-9/=]\S*)*)\s+([0-9/=]+)(?:\s+(\S.*))?$,) {
+           push @{ $parts{"$section\n$sectionper"} }, {
+               Part => $1, Qty => $2, Desc => $3
+               };
+       } elsif (m/^(\S.*) \?\s+\=\s+(\S.*)$/) {
+           die if exists $pkinddesc{$1};
+           $pkinddesc{$1}= $2;
+       } elsif (m/^(\S[^=]*\S)\s+\=\s+(\d{3}\-\d+)(?:\s+(\S.*))?$/) {
+           die if exists $partdef{$1};
+           $partdef{$1}= { Item => $2, Desc => $3 };
+       } else {
+           die "$_ ?";
+       }
+    }
+}
+
+sub analyse_spec () {
+    my ($part,$pd,$try,@rhs,$sp,$section,$sectionper,$count,$pe,$desc);
+    my ($item,$qty,$ii,$bi,$toorder,$price,$total,$notechar);
+    foreach $part (keys %partdef) {
+       $pd= $partdef{$part};
+       next if length $pd->{Desc};
+
+       $try= $part;
+       @rhs= ();
+       for (;;) {
+           if ($try !~ s/\s+(\S+)$//) {
+               $pd->{Desc}= $part;
+               last;
+           }
+           unshift @rhs, $1;
+           if (exists $pkinddesc{$try}) {
+               $pd->{Desc}= join(' ', $pkinddesc{$try}, @rhs);
+               last;
+           }
+       }
+    }
+    foreach $sp (keys %parts) {
+       $sp =~ m/\n/ or die "$sp ?";
+       $section= $`;
+       $sectionper= $';
+       if (exists $count{$sectionper}) {
+           $count= $count{$sectionper};
+       } else {
+           push @warn, "assuming only 1 $sectionper" if length $sectionper;
+           $count= 1;
+       }
+       foreach $pe (@{ $parts{$sp} }) {
+           $desc= $pe->{Desc};
+           if ($pe->{Part} =~ m/^\d{3}\-/) {
+               $item= $pe->{Part};
+           } elsif (exists $partdef{$pe->{Part}}) {
+               $pd= $partdef{$pe->{Part}};
+               $item= $pd->{Item};
+               $desc= $pd->{Desc}.' '.$desc;
+           } else {
+               push @fault, "unknown part $pe->{Part}";
+               next;
+           }
+           $desc =~ s/^\s+//; $desc =~ s/\s+$//;
+           push @{ $iteminstances{$item} }, {
+               Desc => $desc,
+               Qty => $pe->{Qty},
+               SectPer => $sp,
+               Mult => $count,
+               };
+       }
+    }
+    $total= 0;
+    foreach $item (sort keys %iteminstances) {
+       undef $qty;
+       foreach $ii (@{ $iteminstances{$item} }) {
+           if (!defined $qty) {
+               $qty= $ii->{Qty};
+           } else {
+               $qty= addqty($qty, $ii->{Qty}, $ii->{Mult}, $item);
+           }
+       }
+       $bi= by_item($item);
+       next unless $bi;
+       ($toorder,$notechar)= calcorder($qty, $bi);
+       $price= $toorder * $bi->{Price};
+       printf("%5d%1s %-11s %.-60s %5.2d %5.2d\n",
+              $toorder, $notechar, $item, $bi->{Description},
+              $bi->{Price}, $price)
+           or die $!;
+       $total += $price;
+    }
+    printf((' 'x(5+1+1+11+1+60+5+1))."%5.2d\n", $total) or die $!;
+    dump_warnerrs();
+}       
+
+sub dump_warnerrs () {
+    my ($w);
+    foreach $w (@warn) { print("WARNING: $w\n") or die $!; }
+    foreach $w (@fault) { print("ERROR: $w\n") or die $!; }
+    die "errors\n" if @fault;
+}
 
-if (@ARGV==1 && @ARGV[0] =~ m/^(\d\d\d\-)/) {
+if (@ARGV==1 && $ARGV[0] =~ m/^(\d\d\d\-)/) {
+    my ($chr, $k);
     $chr= by_item($ARGV[0]);
+    dump_warnerrs();
     foreach $k (sort keys %$chr) {
        printf "%-20s %s\n", $k, $chr->{$k} or die $!;
     }
@@ -61,5 +205,7 @@ if (@ARGV==1 && @ARGV[0] =~ m/^(\d\d\d\-)/) {
     read_spec();
     close F or die $!;
     analyse_spec();
-    dump_results();
+    exit !!@fault;
+} else {
+    die;
 }