chiark / gitweb /
uniqueable qtys
authorian <ian>
Wed, 14 Apr 2004 18:55:53 +0000 (18:55 +0000)
committerian <ian>
Wed, 14 Apr 2004 18:55:53 +0000 (18:55 +0000)
farnell/farnell-find

index 2dd7778a16d19e074e37e7432b751ca327b2e19f..629d5f9061cb0dd0347f7a1e6942223177e39c56 100755 (executable)
 #        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
@@ -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; $_=<F>; 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);