# 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) = @_;
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};
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\<!--.*--\\>");
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 "$_ ?";
}
}
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,
};
}
$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 $!;
}
}
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();
~ijackson / trains.git / commitdiff