Vessel names for capacity seem to work

diff --git a/yarrg/web/check_capacitystring b/yarrg/web/check_capacitystring
index 3d8f7a52701fd2983c09ca6bdc6629af1467ec91..ae1dec45b879e98c2fa302368d08115b24aef60c 100644 (file)
--- a/yarrg/web/check_capacitystring
+++ b/yarrg/web/check_capacitystring
@@ -34,6 +34,7 @@
 </%doc>
 
 <%attr>
+maxambig => 2
 </%attr>
 
 <%method preparse>
@@ -42,47 +43,161 @@ $h
 </%args>
 <%perl>
 
-my $def= sub {
-       my ($what,$val) = @_;
-       if (defined $h->{$what}) {
-               $h->{Emsg}= "Multiple definitions of maximum $what.";
+my $parse_numeric= sub {
+       # returns (mass,volume,emsg)
+       my ($string,$default)= @_;
+
+       my @mve= (undef,undef,undef);
+
+       if ($string !~ m/\d/) {
+               return (undef,undef,
+                       'Adjustments to capacity must contain digits.');
        }
-       print STDERR "SET $what $val\n";
-       $h->{$what}= $val;
-};
 
-foreach $_ (split /\s+/, ${ $h->{String} }) {
-       print STDERR "ITEM \`$_'\n";
-       next unless length;
-       if (m/^([1-9]\d{0,8})l$/) {
-               $def->('volume', $1);
-       } elsif (m/^([1-9]\d{0,8})kg$/) {
-               $def->('mass', $1);
-       } elsif (m/^([1-9]\d{0,5}(?:\.\d{0,3})?)kl/) {
-               $def->('volume', $1 * 1000);
-       } elsif (m/^([1-9]\d{0,5}(?:\.\d{0,3})?)t/) {
-               $def->('mass', $1 * 1000);
-       } else {
-               ${ $h->{Emsg} }= "Cannot understand capacity \`$_'.";
-               last;
+       my $def= sub {
+               my ($ix,$what,$val) = @_;
+               if (defined $h->{$what}) {
+                       $mve[2]= "\`$string' specifies $what more than once.";
+               }
+               print STDERR "SET $what $val\n";
+               $mve[$ix]= $val;
+       };
+
+print STDERR "PAN \`$string'\n";
+       local $_;
+       foreach $_ (split /\s+/, $string) {
+               print STDERR "ITEM \`$_'\n";
+               next unless length;
+               if (m/^([1-9]\d{0,8})l$/) {
+                       $def->(1, 'volume', $1);
+               } elsif (m/^([1-9]\d{0,8})kg$/) {
+                       $def->(0, 'mass', $1);
+               } elsif (m/^([1-9]\d{0,5}(?:\.\d{0,3})?)kl/) {
+                       $def->(1, 'volume', $1 * 1000);
+               } elsif (m/^([1-9]\d{0,5}(?:\.\d{0,3})?)t/) {
+                       $def->(0, 'mass', $1 * 1000);
+               } else {
+                       $mve[2]= "Cannot understand item \`$_'".
+                               " in numeric capacity";
+               }
        }
+#      foreach my $ix (qw(0 1)) {
+#              $mve[$ix]= $default unless defined $mve[$ix];
+#      }
+       return @mve;
+};
+
+$h->{'deltas'}= [ ];
+print STDERR "NDELTA0 $#{ $h->{'deltas'} }\n";
+
+local ($_)= ${ $h->{String} };
+while (m/^(.*)(\bminus\b|-|\bplus\b|\+)/) {
+       my ($lhs,$rhs)= ($1,$');
+       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 ];
+       print STDERR "NDELTA $#{ $h->{'deltas'} }\n";
+       $_= $lhs;
+}
+
+s/^\s+//; s/\s+$//;
+
+if (m/^[a-z ]+$/) {
+       push @{ $h->{Specs} }, $_;
+} elsif (m/\d/) {
+       my (@mve)= $parse_numeric->($_, undef);
+       if (defined $mve[2]) { ${ $h->{Emsg} }= $mve[2]; return; }
+       $h->{'initial'}= \@mve;
+} elsif (m/\S/) {
+       ${ $h->{Emsg} }= "Cannot understand capacity specification \`$_'.";
+} else {
+       $h->{'initial'}= [undef,undef];
 }
+
 </%perl>
 </%method>
 
+<%method sqlstmt>
+SELECT name,mass,volume
+       FROM vessels WHERE name LIKE ?
+</%method>
+
+<%method nomatch>
+  Did not understand ship name.
+</%method>
+
+<%method ambiguous>
+  Ambiguous - could be <% $ARGS{couldbe} |h %>
+</%method>
+
+<%method manyambig>
+  Too many matching ship types.
+</%method>
+
 <%method postquery>
 <%args>
 $h
 </%args>
 <%perl>
 
-if (defined $h->{'mass'} or defined $h->{'volume'}) {
-       @{ $h->{Results} } = [ $h->{'mass'}, $h->{'volume'} ];
+return if length ${ $h->{Emsg} };
+
+my @mv_names= qw(mass volume);
+
+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;
+};
+
+my @mv;
+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 "NDELTAE $#{ $h->{'deltas'} }\n";
+foreach my $delta (@{ $h->{'deltas'} }) {
+       print STDERR "DELTA @$delta\n";
+       die if defined $delta->[2]; # emsg
+       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];
+       }
+       ${ $h->{Canon} }.= " $delta->[4] ". $canon_numeric->(@$delta);
+}
 
-       ${ $h->{Canon} }=
- 'mass limit: '.(defined $h->{'mass'} ? $h->{'mass'} .'kg' : 'none').'; '.
- 'volume limit: '.(defined $h->{'volume'} ? $h->{'volume'} .'l' : 'none').'.';
+if (@{ $h->{Specs} } || @{ $h->{'deltas'} }) {
+       ${ $h->{Canon} }.= "  [= ". $canon_numeric->(@mv). "]";
 }
 
+foreach my $ix (qw(0 1)) {
+       next unless defined $mv[$ix];
+       next if $mv[$ix] >= 0;
+       ${ $h->{Emsg} }= sprintf "%s limit is negative: %s",
+               ucfirst($mv_names[$ix]), $canon_numeric->(@mv);
+       return;
+}
+
+@{ $h->{Results} }= [ @mv ];
+
 </%perl>
 </%method>

diff --git a/yarrg/web/docs b/yarrg/web/docs
index cbb1c0dd2a30dea8055aef2fae6d78c4b27d7954..24d9f165817fe95de8333067fb1027ac35d9bbfa 100755 (executable)
--- a/yarrg/web/docs
+++ b/yarrg/web/docs
@@ -110,11 +110,27 @@ which trades excessively cumbersome goods (eg. hemp, wood, iron).
 
 <p>
 
-So you should specify your vessel capacity.  Currently you must
-specify the actual mass and volume, as two numbers each with units.
-The system understands the units t (tonnes), kg, l and kl
-(kilolitres).  There should be a space between the two limits, and no
-space before the unit.
+So you should specify your vessel capacity.  You can enter things
+like:
+<dl>
+<dt>sloop
+<dd>The capacity of a sloop, exactly
+<dt>20t 13kl
+<dd>20 tonnes (20,000kg), 13 kilolitres (13,000l)
+<dt>sloop - 100l 100kg
+<dd>The capacity of a sloop minus 100l, minus 100kg
+<dt>2t plus 500kg minus 200kg
+<dd>2300kg, with no limit on volume
+</dl>
+
+Formally, the capacity is a list of terms, all but the first preceded
+by one of <kbd>-</kbd>, <kbd>minus</kbd>, <kbd>+</kbd>,
+<kbd>plus</kbd>.  Each term may specify a mass and/or a volume
+(separated by a space), as a number followed (without an intervening
+space) by a unit (<kbd>t</kbd>, <kbd>kg</kbd>, <kbd>kl</kbd> or
+<kbd>l</kbd>).  The first term may be a ship name or abbrevation
+instead.  If the first term specifies only one of mass or volume, all
+the subsequent terms may only adjust that same value.
 
 <h3>Expected losses</h3>
 

diff --git a/yarrg/web/query_route b/yarrg/web/query_route
index ea483578d565d6df529dffcfddf7d1c6a5c1e9cf..ed9fa4406c70ba1fd7aaaaad7dab4fe02f89a50e 100644 (file)
--- a/yarrg/web/query_route
+++ b/yarrg/web/query_route
@@ -98,10 +98,10 @@ Vessel or capacity:
 <&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'cs',
     thingstring => 'capacitystring', emsgstore => \$emsg,
     perresult => sub {
-        ($max_volume,$max_mass) = @_;
+        ($max_mass,$max_volume) = @_;
     }
  &>
- size=30
+ size=40
 </&>
 
 <td>