From a6433a25b46d948f269cefd7c206aa64f60c6393 Mon Sep 17 00:00:00 2001 From: ian Date: Wed, 14 Apr 2004 18:55:53 +0000 Subject: [PATCH] uniqueable qtys --- farnell/farnell-find | 118 ++++++++++++++++++++++++------------------- 1 file changed, 66 insertions(+), 52 deletions(-) diff --git a/farnell/farnell-find b/farnell/farnell-find index 2dd7778..629d5f9 100755 --- a/farnell/farnell-find +++ b/farnell/farnell-find @@ -21,6 +21,11 @@ # in the quantity specified. Quantity is scaled # by the iteratable's count if we're in an iteratable. # is any string starting with a non-ws char. +# is [=] or /[=]. is +# an integer. = says not to order one extra. +# is an integer (meaning the number of gates to +# a device) or an integer followed by / (meaning we +# can't mix this use with other uses or other circuits). # = [ # Defines . is a sequence of words each separated # by one space. Each word consists of some non-ws chars. The @@ -62,10 +67,10 @@ our(%count); # (no syntax for specifying this atm) our(%iteminstances); -# @{ $iteminstances{$item} } one entry for every circuit/sper which has it +# @{ $iteminstances{$item} } one entry for every line which mentions it # $iteminstances{$item}[]{Use} includes circuit # $iteminstances{$item}[]{Qty} -# $iteminstances{$item}[]{Mult} number in this circuit/sper +# $iteminstances{$item}[]{Mult} number of this iteratable # $iteminstances{$item}[]{LineNo} our(%itemdesc); @@ -82,6 +87,8 @@ our(%show); our($sorthow); # desc or price +our($partfrac_unique)= 'aaaa'; # increments + our($partword1_re)= '\S*[^ \t0-9-]\S*'; our($partword_re)= '\S*[^ \t0-9/=]\S*'; our($part_re)= "$partword1_re(?: $partword_re)*"; @@ -153,6 +160,7 @@ sub snarf ($;$) { sub read_spec () { local ($_); my ($circuit,$iteratable,$desc); + my ($part,$qty,$use); for (;;) { $!=0; $_=; die unless defined $_; chomp; s/\s+$//; @@ -166,8 +174,10 @@ sub read_spec () { } elsif (m/^ \S/) { die "$_ ?"; } elsif (m,^\s+($part_re|$item_re)\s+([0-9/=]+)(?:\s+(\S.*))?$,) { + ($part,$qty,$use) = ($1,$2,$3); + $qty .= $partfrac_unique++ if $qty =~ m,/$,; push @{ $parts{"$circuit\n$iteratable"} }, { - Part => $1, Qty => $2, Use => $3, LineNo => $. + Part => $part, Qty => $qty, Use => $use, LineNo => $. }; } elsif (m/^($part_re)\s+\?\s+\=\s+(\S.*)$/) { die if exists $pkinddesc{$1}; @@ -201,8 +211,8 @@ sub itemsortmap ($) { sub analyse_spec () { my ($part,$pd,$try,@rhs,$sp,$circuit,$iteratable,$count,$pe,$use); - my ($item,$qty,$ii,$bi,$toorder,$price,$total,$notechar,$desc,$ql,$qr); - my ($avail,%avail,$desclen,$why); + my ($item,$totalqty,$ii,$bi,$toorder,$price,$total,$notechar,$desc); + my ($avail,%avail,$desclen,$why,$ql,$qr); foreach $part (sort keys %partdef) { $item= $partdef{$part}; next if exists $itemdesc{$item}; @@ -261,23 +271,20 @@ sub analyse_spec () { $iteminfo{$item}= $bi; } foreach $item (keys %iteminstances) { - undef $qty; + $totalqty= { }; foreach $ii (@{ $iteminstances{$item} }) { - if (!defined $qty) { - $qty= $ii->{Qty}; - } else { - $qty= addqty($qty, $ii->{Qty}, $ii->{Mult}, $item); - } + addqty($totalqty, $ii->{Qty}, $ii->{Mult}, $item, $ii->{LineNo}); } $bi= $iteminfo{$item}; next unless $bi; - ($toorder,$notechar)= calcorder($qty, $bi); + ($toorder,$notechar)= calcorder($totalqty, $bi); $price= $toorder * $bi->{Price}; $avail= $bi->{Avail}; $avail{$avail}= 1; $avail= ' '.$stockmap{$avail} if exists $stockmap{$avail}; $show{$item}{Head}= - sprintf("%5d%1s %-11s %-.${desclen}s %6.3f %6.2f%1s %s\n", + sprintf("%5d%1s %-11s %-${desclen}.${desclen}s". + " %6.3f %6.2f%1s %s\n", $toorder, $notechar, $item, $bi->{Description}, $bi->{Price}, $price, $notechar, $avail); $show{$item}{Info}= ''; @@ -291,7 +298,8 @@ sub analyse_spec () { } foreach $ii (@{ $iteminstances{$item} }) { $ql= $ii->{Qty}; $qr= ''; - if ($ql =~ s/\D.*$//) { $qr= $&; } + if ($ql =~ s/\D\d+$//) { $qr= $&; } + if ($ql =~ s,(\d+)/[a-z]+$,,) { $qr= "$1/"; } $show{$item}{Info} .= sprintf("%*s %5s%-2s %s\n", (5+1+5),'', @@ -316,63 +324,69 @@ sub analyse_spec () { } sub addqty ($$$$) { - my ($q1, $q2, $m2, $item) = @_; - my ($q1numer,$q1denom,$q1exact); - my ($q2numer,$q2denom,$q2exact); - if ($q2 !~ m!^(\d+)(?:/(\d+))?(\=?)$!) { + my ($totalqty, $q2, $m2, $item) = @_; + if ($q2 !~ m!^(\d+)(?:/(\d+)(?:/(\w+))?)?(\=?)$!) { push @fault, "bad quantity $q2 x$m2 for item $item"; - return $q1; + return; } - $q2numer= $1; - $q2denom= defined $2 ? $2 : ''; - $q2exact= !!length $3; - - $q1 =~ m!^(\d+)(?:/(\d+))?(\=?)$! or die "$q1 ?"; - $q1numer= $1; - $q1denom= defined $2 ? $2 : ''; - $q2exact= !!length $3; - if ($q1denom ne $q2denom) { - push @fault, "denominator for item $item changes from". - " $q1denom to $q2denom"; - return $q1; + my ($numer,$denom,$uniq,$exact) = ($1,$2,$3,$4); + if (!$exact) { + $totalqty->{Inexact}= 1; + } + $denom=1 if !defined $denom; + if (defined $uniq) { + die if exists $totalqty->{Uniques}{$uniq}; + $totalqty->{Uniques}{$uniq}{Numer}= $numer; + $totalqty->{Uniques}{$uniq}{Denom}= $denom; + } else { + if (!exists $totalqty->{Denom}) { + $totalqty->{Denom}= $denom; + $totalqty->{Numer}= $numer; + } elsif ($denom ne $totalqty->{Denom}) { + push @fault, "denominator for item $item changes from". + " $totalqty->{Denom} to $denom"; + } else { + $totalqty->{Numer} += $numer; + } } - return sprintf("%d%s%s%s", - ($q1numer+$q2numer), - length $q1denom ? '/' : '', - $q1denom, - ($q1exact && $q2exact ? '=' : '')); } sub calcorder ($$) { - my ($qty, $bi) = @_; # => ($toorder, $notechar); - my ($notechar, $exact); + my ($totalqty, $bi) = @_; # => ($toorder, $notechar); + my ($notechar, $exact, $need, $uniq); $notechar= ''; $exact= 0; - if ($qty =~ s/\=$//) { + if (!exists $totalqty->{Inexact}) { $exact= 1; $notechar= '='; } - if ($qty =~ m!^(\d+)/(\d+)!) { - my ($numer,$denom)= ($1,$2); - $numer += $denom/2 if !$exact; - $qty= ceil($numer / $denom); - $exact= 1; - $notechar= '/'; + $need= 0; + foreach $uniq (keys %{ $totalqty->{Uniques} }) { + $need += calcneed($totalqty->{Uniques}{$uniq}, undef); } - $qty =~ m/^\d+$/ or die "$qty ?"; - $qty++ if !$exact; - if ($qty % $bi->{Multiple}) { - $qty= floor(($qty + $bi->{Multiple} - 1) / $bi->{Multiple}) + $need += calcneed($totalqty, \$notechar) if exists $totalqty->{Numer}; + $need++ if !$exact; + if ($need % $bi->{Multiple}) { + $need= floor(($need + $bi->{Multiple} - 1) / $bi->{Multiple}) * $bi->{Multiple}; $notechar= '*'; } - if ($qty < $bi->{MinOrder}) { - $qty= $bi->{MinOrder}; + if ($need < $bi->{MinOrder}) { + $need= $bi->{MinOrder}; $notechar= '>'; } - ($qty, $notechar); + ($need, $notechar); } +sub calcneed($$) { + my ($tqr, $notechar) = @_; + my ($want, $must); + $want= $tqr->{Numer} * 1.0 / $tqr->{Denom}; + $must= ceil($want); + $$notechar= '/' if $must>$want && $notechar; + return $must; +} + sub dump_warnerrs () { my ($w); my (%r); -- 2.30.2