From 22bd4cbd5ff38bb1f07c362d63254ed162b83398 Mon Sep 17 00:00:00 2001
From: ian <ian>
Date: Thu, 8 Apr 2004 00:54:59 +0000
Subject: [PATCH] can find things

---
 .cvsignore           |   1 +
 farnell/farnell-find | 174 +++++++++++++++++++++++++++++++++++++++----
 2 files changed, 161 insertions(+), 14 deletions(-)

diff --git a/.cvsignore b/.cvsignore
index fa3989b..08aaf5d 100644
--- 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 9a5ceab..038713f 100755
--- 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;
 }
-- 
2.30.2