From e0c789ddf7d0e06c91d0e025ebe55251a4976f97 Mon Sep 17 00:00:00 2001
From: ian <ian>
Date: Wed, 14 Apr 2004 15:12:11 +0000
Subject: [PATCH] improved

---
 farnell/farnell-find | 150 +++++++++++++++++++++++++++----------------
 1 file changed, 94 insertions(+), 56 deletions(-)

diff --git a/farnell/farnell-find b/farnell/farnell-find
index 5087eac..5353b49 100755
--- a/farnell/farnell-find
+++ b/farnell/farnell-find
@@ -5,35 +5,73 @@
 #  run it on farnell-1 and you'll see
 #  it seems very confused, particularly about defined parts
 
+# Input format: lines, #-comments, blank lines ignored.
+# Indent level is relevant, but only 0, 1, >1 relevant.
+#
+#   <Circuit Name>
+#        Starts a circuit.
+#        Circuit names must start with an uppercase letter.
+#    per <Iteratable>
+#        Starts an iteratable (ends at start of next cct).
+#        Iteratable name must start with uppercase letter,
+#        may contain any non-ws chars.
+#     <item> <qty> [<use>]
+#     <part> <qty> [<use>]
+#        Specifies that the circuit contains that part
+#        in the quantity specified.  Quantity is scaled
+#        by the iteratable's count if we're in an iteratable.
+#        <use> is any string starting with a non-ws char.
+#   <part> = <item> [<desc]>
+#        Defines <part>.  <part> is a sequence of words each separated
+#        by one space.  Each word consists of some non-ws chars.  The
+#        first word may not consist entirely of digits and hyphens; no
+#        other words may consist entirely of digits, slashes and
+#        equals signs.  <desc> is any string starting with non-ws.
+#   <part prefix> ? = <desc prefix>
+#        Gives a default description of parts which have <part prefix>
+#        as an initial subsequence of words.  <part prefix> has the
+#        syntax of a <part>.  The description is used only if there is
+#        no more specific description, and the constructed description
+#        is <desc prefix> with a space and the remainder of the part
+#        name appended.
+#   end
+#        Ends the file.  Mandatory.
+
 use strict;
 use POSIX;
 
 our(@warn);
 our(@fault);
-our(%pkinddesc); # $pkinddesc{'a b c'} => 'y'  after `a b c ? = y'
+# neither @warn nor @fault entries have trailing \n
+
+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}
+# $parts{"$circuit\n$sper"}[]{Part}       or item
+# $parts{"$circuit\n$sper"}[]{Qty}
+# $parts{"$circuit\n$sper"}[]{Use}
 
 our(%partdef);
-# $partdef{"part name"}{Item}
-# $partdef{"part name"}{Desc}
+# $partdef{"part name"}= $item;
 
 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} }  one entry for every circuit/sper which has it
+# $iteminstances{$item}[]{Use}   includes circuit
 # $iteminstances{$item}[]{Qty}
-# $iteminstances{$item}[]{SectPer}
-# $iteminstances{$item}[]{Mult}   number in this sect/sper
+# $iteminstances{$item}[]{Mult}   number in this circuit/sper
 
 our(%itemdesc);
-# $itemdesc{$item}{$desc}= 1;
+# $itemdesc{$item}[]= $desc;
+
+our($partword1_re)= '\S*[^ \t0-9-]\S*';
+our($partword_re)= '\S*[^ \t0-9/=]\S*';
+our($part_re)= "$partword1_re(?: $partword_re)*";
+our($item_re)= '\d{3}\-\d{3,7}';
 
 sub by_item ($) {
     my ($itemcode) = @_;
@@ -42,7 +80,7 @@ sub by_item ($) {
     local ($_);
     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;
+    $itemcode =~ m/^(\d\d\d)\-(\d{3,7})$/ or die "$itemcode ?";
     $chr->{Item}= $itemcode;
     $chr->{Shortcode}= $1.$2;
     $url .= $chr->{Shortcode};
@@ -65,7 +103,12 @@ sub by_item ($) {
 	return undef;
     }
     $chr->{Description}= snarf('Description');
+    eval {
+	my ($partno)= snarf('Manufacturer Part Number');
+	$chr->{Description}= "[$partno] $chr->{Description}";
+    };
     $chr->{Avail}= snarf('Stock Availability');
+    $chr->{Avail} =~ s/^Awaiting Delivery$/Awaiting/;
     $chr->{MinOrder}= snarf('Minimum Order');
     $chr->{Multiple}= snarf('Order Multiple');
     $price= snarf('Unit Price', "\n\<!--.*--\\>");
@@ -90,30 +133,32 @@ sub snarf ($;$) {
 
 sub read_spec () {
     local ($_);
-    my ($section,$sectionper);
+    my ($circuit,$iteratable,$desc);
     for (;;) {
 	$!=0; $_=<F>; die unless defined $_;
 	chomp; s/\s+$//;
 	last if m/^end$/;
 	next if m/^\#/ || !m/\S/;
 	if (m/^[A-Z].*$/) {
-	    $section= $&;
-	    $sectionper= '';
+	    $circuit= $&;
+	    $iteratable= '';
 	} elsif (m/^ per ([A-Z]\S+)$/) {
-	    $sectionper= $1;
+	    $iteratable= $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+($part_re|$item_re)\s+([0-9/=]+)(?:\s+(\S.*))?$,) {
+	    push @{ $parts{"$circuit\n$iteratable"} }, {
+		Part => $1, Qty => $2, Use => $3
 		};
-	} elsif (m/^(\S.*) \?\s+\=\s+(\S.*)$/) {
+	} elsif (m/^($part_re)\s+\?\s+\=\s+(\S.*)$/) {
 	    die if exists $pkinddesc{$1};
 	    $pkinddesc{$1}= $2;
-	} elsif (m/^(\S[^=]*\S)\s+\=\s+(\d{3}\-\d+)(?:\s+(\S.*))?$/) {
+	} elsif (m/^($part_re)\s+\=\s+($item_re)(?:\s+(\S.*))?$/) {
 	    die if exists $partdef{$1};
-	    $partdef{$1}= { Item => $2, Desc => $3 };
+	    $partdef{$1}= $2;
+	    if (defined $3) {
+		push @{ $itemdesc{$2} }, "$1: $3";
+	    }
 	} else {
 	    die "$_ ?";
 	}
@@ -121,54 +166,51 @@ sub read_spec () {
 }
 
 sub analyse_spec () {
-    my ($part,$pd,$try,@rhs,$sp,$section,$sectionper,$count,$pe,$desc);
-    my ($item,$qty,$ii,$bi,$toorder,$price,$total,$notechar);
+    my ($part,$pd,$try,@rhs,$sp,$circuit,$iteratable,$count,$pe,$use);
+    my ($item,$qty,$ii,$bi,$toorder,$price,$total,$notechar,$desc);
     foreach $part (keys %partdef) {
-	$pd= $partdef{$part};
-	$pd->{Desc}= '' if !defined $pd->{Desc};
-	next if length $pd->{Desc};
+	$item= $partdef{$part};
+	next if exists $itemdesc{$item};
 
 	$try= $part;
 	@rhs= ();
 	for (;;) {
 	    if ($try !~ s/\s+(\S+)$//) {
-		$pd->{Desc}= $part;
+		push @{ $itemdesc{$item} }, $part;
 		last;
 	    }
 	    unshift @rhs, $1;
 	    if (exists $pkinddesc{$try}) {
-		$pd->{Desc}= join(' ', $pkinddesc{$try}, @rhs);
+		push @{ $itemdesc{$item} }, join(' ', $pkinddesc{$try}, @rhs);
 		last;
 	    }
 	}
     }
     foreach $sp (keys %parts) {
 	$sp =~ m/\n/ or die "$sp ?";
-	$section= $`;
-	$sectionper= $';
-	if (exists $count{$sectionper}) {
-	    $count= $count{$sectionper};
+	$circuit= $`;
+	$iteratable= $';
+	if (exists $count{$iteratable}) {
+	    $count= $count{$iteratable};
 	} else {
-	    push @warn, "assuming only 1 $sectionper" if length $sectionper;
+	    push @warn, "assuming only 1 $iteratable" if length $iteratable;
 	    $count= 1;
 	}
 	foreach $pe (@{ $parts{$sp} }) {
-	    $desc= $pe->{Desc};
-	    $desc= '' if !defined $desc;
-	    if ($pe->{Part} =~ m/^\d{3}\-/) {
-		$item= $pe->{Part};
-	    } elsif (exists $partdef{$pe->{Part}}) {
-		$item= $pd->{Item};
-		$itemdesc{$item}{$pd->{Desc}}= 1;
+	    $use= $pe->{Use};
+	    $use= defined $use ? "$circuit: $use" : $circuit;
+	    $part= $pe->{Part};
+	    if ($part =~ m/^$item_re$/) {
+		$item= $part;
+	    } elsif (exists $partdef{$part}) {
+		$item= $partdef{$part};
 	    } else {
-		push @fault, "unknown part $pe->{Part}";
+		push @fault, "unknown part $part";
 		next;
 	    }
-	    $desc =~ s/^\s+//; $desc =~ s/\s+$//;
 	    push @{ $iteminstances{$item} }, {
-		Desc => $desc,
+		Use => $use,
 		Qty => $pe->{Qty},
-		SectPer => $sp,
 		Mult => $count,
 		};
 	}
@@ -192,22 +234,18 @@ sub analyse_spec () {
 	       $bi->{Price}, $price, $bi->{Avail})
 	    or die $!;
 	$total += $price;
-	foreach $desc (keys %{ $itemdesc{$item} }) {
-	    next if !length $desc;
+	foreach $desc (@{ $itemdesc{$item} }) {
 	    printf("%*s %s\n",
-		   (5+1+11+1+5),'',
+		   (5+1+1+11),'',
 		   $desc)
 		or die $!;
 	}
 	foreach $ii (@{ $iteminstances{$item} }) {
-	    $sp= $ii->{SectPer};
-	    $sp =~ s/\n.*//;
-	    $desc= "$sp: $ii->{Desc}";
-	    $desc =~ s/\: $//;
 	    printf("%*s %11s %s\n",
 		   (5+1+5),'',
-		   $ii->{Qty} eq '1' ? '' : $ii->{Qty},
-		   $desc)
+#		   $ii->{Qty} eq '1' ? '' : $ii->{Qty},
+		   $ii->{Qty},
+		   $ii->{Use})
 		or die $!;
 	}
     }
@@ -280,7 +318,7 @@ sub dump_warnerrs () {
     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();
-- 
2.30.2