# 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.
+# <qty> is <num>[=] or <num>/<denom>[=]. <num> is
+# an integer. = says not to order one extra. <denom>
+# 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).
# <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
# (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);
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)*";
sub read_spec () {
local ($_);
my ($circuit,$iteratable,$desc);
+ my ($part,$qty,$use);
for (;;) {
$!=0; $_=<F>; die unless defined $_;
chomp; s/\s+$//;
} 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};
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};
$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}= '';
}
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),'',
}
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);