Allow %age adjustments to capacity

[ypp-sc-tools.db-live.git] / yarrg / web / check_capacitystring

diff --git a/yarrg/web/check_capacitystring b/yarrg/web/check_capacitystring
index ae1dec45b879e98c2fa302368d08115b24aef60c..f001c790f6963201f6e83f4889af22141fa714e6 100644 (file)
--- a/yarrg/web/check_capacitystring
+++ b/yarrg/web/check_capacitystring
@@ -87,6 +87,19 @@ print STDERR "PAN \`$string'\n";
        return @mve;
 };
 
+my @mv_names= qw(mass volume);
+my $canon_numeric= $h->{'canon_numeric'}= sub {
+       print STDERR "CANNUM @_\n";
+       my $sep= '';
+       my $out= '';
+       foreach my $ix (qw(0 1)) {
+               next unless defined $_[$ix];
+               $out .= $sep; $sep= ' ';
+               $out .= sprintf "%g%s", $_[$ix], (qw(kg l))[$ix];
+       }
+       return $out;
+};
+
 $h->{'deltas'}= [ ];
 print STDERR "NDELTA0 $#{ $h->{'deltas'} }\n";
 
@@ -96,9 +109,29 @@ while (m/^(.*)(\bminus\b|-|\bplus\b|\+)/) {
        print STDERR "TERM L=\`$1' M=\`$2' R=\`$''\n";
        my ($signum,$signopstr)= 
                $2 =~ m/^p|^\+/ ? (+1,'plus') : (-1,'minus');
-       my (@mve)= $parse_numeric->($rhs, 0);
-       ${ $h->{Emsg} }= $mve[2] if defined $mve[2];
-       unshift @{ $h->{'deltas'} }, [ @mve,$signum,$signopstr ];
+       my @mveco;
+       if ($rhs =~ m/^\s*(\d{1,2}(?:\.\d{0,4})?)\%\s*$/) {
+               my $pct= 100.0 + $signum * $1;
+               @mveco= ($pct,$pct,undef);
+               push @mveco, sprintf "%s %g%%", $signopstr, $1;
+               push @mveco, sub {
+                       return undef unless defined $_[0];
+                       $_[0] * $_[1] / 100.0
+               };
+       } else {
+               @mveco= $parse_numeric->($rhs, 0);
+               if (!defined $mveco[2]) {
+                       push @mveco, $signopstr.' '.$canon_numeric->(@mveco);
+                       push @mveco, sub {
+                               ${ $h->{Emsg} }= "Cannot add or subtract".
+                                       " mass to/from volume"
+                                       unless defined $_[0];
+                               $_[0] + $_[1] * $signum
+                       };
+               }
+       }
+       ${ $h->{Emsg} }= $mveco[2] if defined $mveco[2];
+       unshift @{ $h->{'deltas'} }, [ @mveco ];
        print STDERR "NDELTA $#{ $h->{'deltas'} }\n";
        $_= $lhs;
 }
@@ -143,30 +176,19 @@ $h
 </%args>
 <%perl>
 
-return if length ${ $h->{Emsg} };
-
-my @mv_names= qw(mass volume);
+my $canon_numeric= $h->{'canon_numeric'};
 
-my $canon_numeric= sub {
-       print STDERR "CANNUM @_\n";
-       my $sep= '';
-       my $out= '';
-       foreach my $ix (qw(0 1)) {
-               next unless defined $_[$ix];
-               $out .= $sep; $sep= ' ';
-               $out .= sprintf "%g%s", $_[$ix], (qw(kg l))[$ix];
-       }
-       return $out;
-};
+return if length ${ $h->{Emsg} };
 
 my @mv;
+my @mv_names= qw(mass volume);
 if (@{ $h->{Specs} }) {
        @mv= @{ $h->{Results}[0] }[1,2];
-       print STDERR "INITIAL VESSEL @mv\n";
 } else {
        @mv= @{ $h->{'initial'} };
        ${ $h->{Canon} }= $canon_numeric->(@mv);
 }
+print STDERR "INITIAL @mv\n";
 
 print STDERR "NDELTAE $#{ $h->{'deltas'} }\n";
 foreach my $delta (@{ $h->{'deltas'} }) {
@@ -175,14 +197,10 @@ foreach my $delta (@{ $h->{'deltas'} }) {
        foreach my $ix (qw(0 1)) {
                next unless defined $delta->[$ix];
                print STDERR "DELTA I $ix\n";
-               if (!defined $mv[$ix]) {
-                       ${ $h->{Emsg} }= "Cannot add or subtract".
-                               " $mv_names[$ix] to/from $mv_names[!$ix]";
-                       return;
-               }
-               $mv[$ix] += $delta->[$ix] * $delta->[3];
+               $mv[$ix] = $delta->[4]->($mv[$ix], $delta->[$ix]);
+               return if length ${ $h->{Emsg} };
        }
-       ${ $h->{Canon} }.= " $delta->[4] ". $canon_numeric->(@$delta);
+       ${ $h->{Canon} }.= ' '.$delta->[3];
 }
 
 if (@{ $h->{Specs} } || @{ $h->{'deltas'} }) {