yarrg/web/routetrade

   1 <%doc>
   2
   3  This is part of the YARRG website.  YARRG is a tool and website
   4  for assisting players of Yohoho Puzzle Pirates.
   5
   6  Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
   7  Copyright (C) 2009 Clare Boothby
   8
   9   YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
  10   The YARRG website is covered by the GNU Affero GPL v3 or later, which
  11    basically means that every installation of the website will let you
  12    download the source.
  13
  14  This program is free software: you can redistribute it and/or modify
  15  it under the terms of the GNU Affero General Public License as
  16  published by the Free Software Foundation, either version 3 of the
  17  License, or (at your option) any later version.
  18
  19  This program is distributed in the hope that it will be useful,
  20  but WITHOUT ANY WARRANTY; without even the implied warranty of
  21  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22  GNU Affero General Public License for more details.
  23
  24  You should have received a copy of the GNU Affero General Public License
  25  along with this program.  If not, see <http://www.gnu.org/licenses/>.
  26
  27  Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
  28  are used without permission.  This program is not endorsed or
  29  sponsored by Three Rings.
  30
  31
  32  This Mason component is the core trade planner for a specific route.
  33
  34
  35 </%doc>
  36 <%args>
  37 $dbh
  38 @islandids
  39 @archipelagoes
  40 $qa
  41 </%args>
  42 <&| script &>
  43   da_pageload= Date.now();
  44 </&script>
  45
  46 <%perl>
  47
  48 my $now= time;
  49 my $loss_per_league= 1e-7;
  50
  51 my @flow_conds;
  52 my @query_params;
  53
  54 my $sd_condition= sub {
  55         my ($bs, $ix) = @_;
  56         my $islandid= $islandids[$ix];
  57         if (defined $islandid) {
  58                 return "${bs}.islandid = $islandid";
  59         } else {
  60                 push @query_params, $archipelagoes[$ix];
  61                 return "${bs}_islands.archipelago = ?";
  62         }
  63 };
  64
  65 my %islandpair;
  66 # $islandpair{$a,$b}= [ $start_island_ix, $end_island_ix ]
  67
  68 my $specific= !grep { !defined $_ } @islandids;
  69 my $confusing= 0;
  70
  71 foreach my $src_i (0..$#islandids) {
  72         my $src_isle= $islandids[$src_i];
  73         my $src_cond= $sd_condition->('sell',$src_i);
  74         my @dst_conds;
  75         foreach my $dst_i ($src_i..$#islandids) {
  76                 my $dst_isle= $islandids[$dst_i];
  77                 my $dst_cond= $sd_condition->('buy',$dst_i);
  78                 if ($dst_i==$src_i and !defined $src_isle) {
  79                         # we always want arbitrage, but mentioning an arch
  80                         # once shouldn't produce intra-arch trades
  81                         $dst_cond=
  82                                 "($dst_cond AND sell.islandid = buy.islandid)";
  83                 }
  84                 push @dst_conds, $dst_cond;
  85
  86                 if ($specific && !$confusing &&
  87                     # With a circular route, do not carry goods round the loop
  88                     !($src_i==0 && $dst_i==$#islandids &&
  89                       $src_isle == $islandids[$dst_i])) {
  90                         if ($islandpair{$src_isle,$dst_isle}) {
  91                                 $confusing= 1;
  92                         } else {
  93                                 $islandpair{$src_isle,$dst_isle}=
  94                                         [ $src_i, $dst_i ];
  95                         }
  96                 }
  97         }
  98         push @flow_conds, "$src_cond AND (
  99                         ".join("
 100                      OR ",@dst_conds)."
 101                 )";
 102 }
 103
 104 my $stmt= "
 105         SELECT  sell_islands.islandname                         org_name,
 106                 sell_islands.islandid                           org_id,
 107                 sell.price                                      org_price,
 108                 sell.qty                                        org_qty_stall,
 109                 sell_stalls.stallname                           org_stallname,
 110                 sell.stallid                                    org_stallid,
 111                 sell_uploads.timestamp                          org_timestamp,
 112                 buy_islands.islandname                          dst_name,
 113                 buy_islands.islandid                            dst_id,
 114                 buy.price                                       dst_price,
 115                 buy.qty                                         dst_qty_stall,
 116                 buy_stalls.stallname                            dst_stallname,
 117                 buy.stallid                                     dst_stallid,
 118                 buy_uploads.timestamp                           dst_timestamp,
 119 ".($qa->{ShowStalls} ? "
 120                 sell.qty                                        org_qty_agg,
 121                 buy.qty                                         dst_qty_agg,
 122 " : "
 123                 (SELECT sum(qty) FROM sell AS sell_agg
 124                   WHERE sell_agg.commodid = commods.commodid
 125                   AND   sell_agg.islandid = sell.islandid
 126                   AND   sell_agg.price = sell.price)            org_qty_agg,
 127                 (SELECT sum(qty) FROM buy AS buy_agg
 128                   WHERE buy_agg.commodid = commods.commodid
 129                   AND   buy_agg.islandid = buy.islandid
 130                   AND   buy_agg.price = buy.price)              dst_qty_agg,
 131 ")."
 132                 commods.commodname                              commodname,
 133                 commods.commodid                                commodid,
 134                 commods.unitmass                                unitmass,
 135                 commods.unitvolume                              unitvolume,
 136                 dist                                            dist,
 137                 buy.price - sell.price                          unitprofit
 138         FROM commods
 139         JOIN sell ON commods.commodid = sell.commodid
 140         JOIN buy  ON commods.commodid = buy.commodid
 141         JOIN islands AS sell_islands ON sell.islandid = sell_islands.islandid
 142         JOIN islands AS buy_islands  ON buy.islandid  = buy_islands.islandid
 143         JOIN uploads AS sell_uploads ON sell.islandid = sell_uploads.islandid
 144         JOIN uploads AS buy_uploads  ON buy.islandid  = buy_uploads.islandid
 145         JOIN stalls  AS sell_stalls  ON sell.stallid  = sell_stalls.stallid
 146         JOIN stalls  AS buy_stalls   ON buy.stallid   = buy_stalls.stallid
 147         JOIN dists ON aiid = sell.islandid AND biid = buy.islandid
 148         WHERE   (
 149                 ".join("
 150            OR   ", @flow_conds)."
 151         )
 152           AND   buy.price > sell.price
 153         ORDER BY org_name, dst_name, commodname, unitprofit DESC,
 154                  org_price, dst_price DESC,
 155                  org_stallname, dst_stallname
 156      ";
 157
 158 my $sth= $dbh->prepare($stmt);
 159 $sth->execute(@query_params);
 160 my @flows;
 161
 162 my @cols= ({ NoSort => 1 });
 163
 164 my $addcols= sub {
 165         my $base= shift @_;
 166         foreach my $name (@_) {
 167                 my $col= { Name => $name, %$base };
 168                 $col->{Numeric}=1 if !$col->{Text};
 169                 push @cols, $col;
 170         }
 171 };
 172
 173 if ($qa->{ShowStalls}) {
 174         $addcols->({ Text => 1 }, qw(
 175                 org_name org_stallname
 176                 dst_name dst_stallname
 177         ));
 178 } else {
 179         $addcols->({Text => 1 }, qw(
 180                 org_name dst_name
 181         ));
 182 }
 183 $addcols->({ Text => 1 }, qw(commodname));
 184 $addcols->({ DoReverse => 1 },
 185         qw(     org_price org_qty_agg dst_price dst_qty_agg
 186         ));
 187 $addcols->({ DoReverse => 1, SortColKey => 'MarginSortKey' },
 188         qw(     Margin
 189         ));
 190 $addcols->({ DoReverse => 1 },
 191         qw(     unitprofit MaxQty
 192                 MaxCapital MaxProfit
 193         ));
 194
 195 </%perl>
 196
 197 % if ($qa->{'debug'}) {
 198 <pre>
 199 <% $stmt |h %>
 200 <% join(' | ',@query_params) |h %>
 201 </pre>
 202 % }
 203
 204 <& dumptable:start, qa => $qa, sth => $sth &>
 205 % {
 206 %   my $got;
 207 %   while ($got= $sth->fetchrow_hashref()) {
 208 <%perl>
 209
 210         my $f= $flows[$#flows];
 211         if (    !$f ||
 212                 $qa->{ShowStalls} ||
 213                 grep { $f->{$_} ne $got->{$_} }
 214                         qw(org_id org_price dst_id dst_price commodid)
 215         ) {
 216                 # Make a new flow rather than adding to the existing one
 217
 218                 $f= {
 219                         Ix => scalar(@flows),
 220                         Var => "f".@flows,
 221                         %$got
 222                 };
 223                 $f->{"org_stallid"}= $f->{"dst_stallid"}= 'all'
 224                         if !$qa->{ShowStalls};
 225                 push @flows, $f;
 226         }
 227         foreach my $od (qw(org dst)) {
 228                 $f->{"${od}Stalls"}{
 229                         $got->{"${od}_stallname"}
 230                     } =
 231                         $got->{"${od}_qty_stall"}
 232                     ;
 233         }
 234
 235 </%perl>
 236 <& dumptable:row, qa => $qa, sth => $sth, row => $f &>
 237 %    }
 238 <& dumptable:end, qa => $qa &>
 239 % }
 240
 241 <%perl>
 242
 243 if (!@flows) {
 244         print 'No profitable trading opportunities were found.';
 245         return;
 246 }
 247
 248 foreach my $f (@flows) {
 249
 250         $f->{MaxQty}= $f->{'org_qty_agg'} < $f->{'dst_qty_agg'}
 251                 ? $f->{'org_qty_agg'} : $f->{'dst_qty_agg'};
 252         $f->{MaxProfit}= $f->{MaxQty} * $f->{'unitprofit'};
 253         $f->{MaxCapital}= $f->{MaxQty} * $f->{'org_price'};
 254
 255         $f->{MarginSortKey}= sprintf "%d",
 256                 $f->{'dst_price'} * 10000 / $f->{'org_price'};
 257         $f->{Margin}= sprintf "%3.1f%%",
 258                 $f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0;
 259
 260         $f->{ExpectedUnitProfit}=
 261                 $f->{'dst_price'} * (1.0 - $loss_per_league) ** $f->{'dist'}
 262                 - $f->{'org_price'};
 263
 264         my @uid= $f->{commodid};
 265         foreach my $od (qw(org dst)) {
 266                 push @uid,
 267                         $f->{"${od}_id"},
 268                         $f->{"${od}_price"};
 269                 push @uid,
 270                         $f->{"${od}_stallid"}
 271                                 if $qa->{ShowStalls};
 272         }
 273         $f->{UidLong}= join '_', @uid;
 274
 275         my $base= 31;
 276         my $cmpu= '';
 277         map {
 278                 my $uue= $_;
 279                 my $first= $base;
 280                 do {
 281                         my $this= $uue % $base;
 282 print STDERR "uue=$uue this=$this ";
 283                         $uue -= $this;
 284                         $uue /= $base;
 285                         $this += $first;
 286                         $first= 0;
 287                         $cmpu .= chr($this + ($this < 26 ? ord('a') :
 288                                               $this < 52 ? ord('A')-26
 289                                                          : ord('0')-52));
 290 print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
 291 die "$cmpu $uue ?" if length $cmpu > 20;
 292                 } while ($uue);
 293                 $cmpu;
 294         } @uid;
 295         $f->{UidShort}= $cmpu;
 296
 297         if ($qa->{'debug'}) {
 298                 my @outuid;
 299                 $_= $f->{UidShort};
 300                 my $mul;
 301                 while (m/./) {
 302                         my $v= m/^[a-z]/ ? ord($&)-ord('a') :
 303                                m/^[A-Z]/ ? ord($&)-ord('A')+26 :
 304                                m/^[0-9]/ ? ord($&)-ord('0')+52 :
 305                                die "$_ ?";
 306                         if ($v >= $base) {
 307                                 push @outuid, 0;
 308                                 $v -= $base;
 309                                 $mul= 1;
 310 #print STDERR "(next)\n";
 311                         }
 312                         die "$f->{UidShort} $_ ?" unless defined $mul;
 313                         $outuid[$#outuid] += $v * $mul;
 314
 315 #print STDERR "$f->{UidShort}  $_  $&  v=$v  mul=$mul  ord()=".ord($&).
 316 #                       "[vs.".ord('a').",".ord('A').",".ord('0')."]".
 317 #                       "  outuid=@outuid\n";
 318
 319                         $mul *= $base;
 320                         s/^.//;
 321                 }
 322                 my $recons_long= join '_', @outuid;
 323                 $f->{UidLong} eq $recons_long or
 324                         die "$f->{UidLong} = $f->{UidShort} = $recons_long ?";
 325         }
 326
 327         if (defined $qa->{"R$f->{UidShort}"} &&
 328             !defined $qa->{"T$f->{UidShort}"}) {
 329                 $f->{Suppress}= 1;
 330         }
 331
 332 }
 333 </%perl>
 334
 335 % my $optimise= $specific && !$confusing && @islandids>1;
 336 % if (!$optimise) {
 337
 338 <p>
 339 % if (@islandids<=1) {
 340 Route is trivial.
 341 % }
 342 % if (!$specific) {
 343 Route contains archipelago(es), not just specific islands.
 344 % }
 345 % if ($confusing) {
 346 Route is complex - it visits the same island several times
 347 and isn't a simple loop.
 348 % }
 349 Therefore, optimal voyage trade plan not calculated.
 350
 351 % } else { # ========== OPTMISATION ==========
 352 <%perl>
 353
 354 my $cplex= "
 355 Maximize
 356
 357   totalprofit:
 358                   ".(join " +
 359                   ", map {
 360                         sprintf "%.20f %s", $_->{ExpectedUnitProfit}, $_->{Var}
 361                         } @flows)."
 362
 363 Subject To
 364 ";
 365
 366 my %avail_csts;
 367 foreach my $flow (@flows) {
 368         if ($flow->{Suppress}) {
 369                 $cplex .= "
 370    $flow->{Var} = 0
 371 ";
 372                 next;
 373         }
 374         foreach my $od (qw(org dst)) {
 375                 my $cstname= join '_', (
 376                         'avail',
 377                         $flow->{'commodid'},
 378                         $od,
 379                         $flow->{"${od}_id"},
 380                         $flow->{"${od}_price"},
 381                         $flow->{"${od}_stallid"},
 382                 );
 383
 384                 push @{ $avail_csts{$cstname}{Flows} }, $flow->{Var};
 385                 $avail_csts{$cstname}{Qty}= $flow->{"${od}_qty_agg"};
 386         }
 387 }
 388 foreach my $cstname (sort keys %avail_csts) {
 389         my $c= $avail_csts{$cstname};
 390         $cplex .= "
 391    ".   sprintf("%-30s","$cstname:")." ".
 392         join("+", @{ $c->{Flows} }).
 393         " <= ".$c->{Qty}."\n";
 394 }
 395
 396 $cplex.= "
 397 Bounds
 398         ".(join "
 399         ", map { "$_->{Var} >= 0" } @flows)."
 400
 401 End
 402 ";
 403
 404 if ($qa->{'debug'}) {
 405 </%perl>
 406 <pre>
 407 <% $cplex |h %>
 408 </pre>
 409 <%perl>
 410 }
 411
 412 {
 413         my $input= pipethrough_prep();
 414         print $input $cplex or die $!;
 415         my $output= pipethrough_run_along($input, undef, 'glpsol',
 416                 qw(glpsol --cpxlp /dev/stdin -o /dev/stdout));
 417         print "<pre>\n" if $qa->{'debug'};
 418         my $found_section= 0;
 419         my $glpsol_out= '';
 420         while (<$output>) {
 421                 $glpsol_out.= $_;
 422                 print encode_entities($_) if $qa->{'debug'};
 423                 if (m/^\s*No\.\s+Column name\s+St\s+Activity\s/) {
 424                         die if $found_section>0;
 425                         $found_section= 1;
 426                         next;
 427                 }
 428                 next unless $found_section==1;
 429                 next if m/^[- ]+$/;
 430                 if (!/\S/) {
 431                         $found_section= 2;
 432                         next;
 433                 }
 434                 my ($ix, $qty) =
 435                         m/^\s*\d+\s+f(\d+)\s+\S+\s+(\d+)\s/ or die "$_ ?";
 436                 my $flow= $flows[$ix] or die;
 437                 $flow->{OptQty}= $qty;
 438                 $flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
 439                 $flow->{OptCapital}= $flow->{OptQty} * $flow->{'org_price'};
 440         }
 441         print "</pre>\n" if $qa->{'debug'};
 442         my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
 443         pipethrough_run_finish($output,$prerr);
 444         die $prerr unless $found_section;
 445 };
 446
 447 $addcols->({ DoReverse => 1 }, qw(
 448                 OptQty
 449         ));
 450 $addcols->({ Total => 0, DoReverse => 1 }, qw(
 451                 OptCapital OptProfit
 452         ));
 453
 454 </%perl>
 455
 456 % } # ========== OPTIMISATION ==========
 457
 458 % my %ts_sortkeys;
 459 % {
 460 %       my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
 461 %       my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
 462 <table id="trades" rules=groups>
 463 <colgroup span=1>
 464 <colgroup span=2>
 465 <% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
 466 <colgroup span=1>
 467 <colgroup span=2>
 468 <colgroup span=2>
 469 <colgroup span=2>
 470 <colgroup span=3>
 471 %       if ($optimise) {
 472 <colgroup span=3>
 473 %       }
 474 <tr class="spong">
 475 <th>
 476 <th<% $cdspan %>>Collect
 477 <th<% $cdspan %>>Deliver
 478 <th>
 479 <th colspan=2>Collect
 480 <th colspan=2>Deliver
 481 <th colspan=2>Profit
 482 <th colspan=3>Max
 483 %       if ($optimise) {
 484 <th colspan=3>Planned
 485 %       }
 486
 487 <tr>
 488 <th>
 489 <th>Island <% $cdstall %>
 490 <th>Island <% $cdstall %>
 491 <th>Commodity
 492 <th>Price
 493 <th>Qty
 494 <th>Price
 495 <th>Qty
 496 <th>Margin
 497 <th>Unit
 498 <th>Qty
 499 <th>Capital
 500 <th>Profit
 501 %       if ($optimise) {
 502 <th>Qty
 503 <th>Capital
 504 <th>Profit
 505 %       }
 506 % }
 507
 508 <tr id="trades_sort">
 509 % foreach my $col (@cols) {
 510 <th>
 511 % }
 512
 513 % foreach my $flowix (0..$#flows) {
 514 %       my $flow= $flows[$flowix];
 515 %       my $rowid= "id_row_$flow->{UidShort}";
 516 <tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
 517 <td><input type=hidden   name=R<% $flow->{UidShort} %> value="">
 518     <input type=checkbox name=T<% $flow->{UidShort} %> value=""
 519        <% $flow->{Suppress} ? '' : 'checked' %> >
 520 %       foreach my $ci (1..$#cols) {
 521 %               my $col= $cols[$ci];
 522 %               my $v= $flow->{$col->{Name}};
 523 %               $col->{Total} += $v if defined $col->{Total};
 524 %               $v='' if !$col->{Text} && !$v;
 525 %               my $sortkey= $col->{SortColKey} ?
 526 %                       $flow->{$col->{SortColKey}} : $v;
 527 %               $ts_sortkeys{$ci}{$rowid}= $sortkey;
 528 <td <% $col->{Text} ? '' : 'align=right' %>><% $v |h %>
 529 %       }
 530 % }
 531 <tr id="trades_total">
 532 <th>
 533 <th colspan=2>Total
 534 % foreach my $ci (3..$#cols) {
 535 %       my $col= $cols[$ci];
 536 <td align=right>
 537 %       if (defined $col->{Total}) {
 538 <% $col->{Total} |h %>
 539 %       }
 540 % }
 541 </table>
 542
 543 <& tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
 544         throw => 'trades_sort', tbrow => 'trades_total' &>
 545 <&| script &>
 546   ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
 547   function all_onload() {
 548     ts_onload__trades();
 549   }
 550   window.onload= all_onload;
 551 </&script>
 552
 553 <input type=submit name=update value="Update">
 554
 555 % if ($optimise) { # ========== TRADING PLAN ==========
 556 %
 557 % my $iquery= $dbh->prepare('SELECT islandname FROM islands
 558 %                               WHERE islandid = ?');
 559 % my %da_ages;
 560 % my $total_total= 0;
 561 %
 562 <h1>Voyage trading plan</h1>
 563 <table rules=groups>
 564 % foreach my $i (0..$#islandids) {
 565 <tbody>
 566 <tr><td colspan=3><strong>
 567 %       $iquery->execute($islandids[$i]);
 568 %       my ($islandname) = $iquery->fetchrow_array();
 569 %       if (!$i) {
 570 Start at <% $islandname |h %>
 571 %       } else {
 572 Sail to <% $islandname |h %>
 573 %       }
 574 </strong>
 575 <%perl>
 576      my $age_reported= 0;
 577      my %flowlists;
 578      foreach my $od (qw(org dst)) {
 579         foreach my $f (@flows) {
 580                 next if $f->{Suppress};
 581                 next unless $f->{"${od}_id"} == $islandids[$i];
 582                 next unless $f->{OptQty};
 583                 my $price= $f->{"${od}_price"};
 584                 my $stallname= $f->{"${od}_stallname"};
 585                 my $todo= \$flowlists{$od}{
 586                                 $f->{'commodname'},
 587                                 (sprintf "%07d", ($od eq 'dst' ?
 588                                                 9999999-$price : $price)),
 589                                 $stallname
 590                         };
 591                 $$todo= {
 592                         Qty => 0,
 593                         orgArbitrage => 0,
 594                         dstArbitrage => 0,
 595                 } unless $$todo;
 596                 $$todo->{'commodname'}= $f->{'commodname'};
 597                 $$todo->{'stallname'}= $stallname;
 598                 $$todo->{Price}= $price;
 599                 $$todo->{Timestamp}= $f->{"${od}_timestamp"};
 600                 $$todo->{Qty} += $f->{OptQty};
 601                 $$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
 602                 $$todo->{Stalls}= $f->{"${od}Stalls"};
 603                 if ($f->{'org_id'} == $f->{'dst_id'}) {
 604                         $$todo->{"${od}Arbitrage"}= 1;
 605                 }
 606         }
 607      }
 608
 609      my $total;
 610      my $dline= 0;
 611      my $show_flows= sub {
 612         my ($od,$arbitrage,$collectdeliver) = @_;
 613 </%perl>
 614 %
 615 %       my $todo= $flowlists{$od};
 616 %       return unless $todo;
 617 %       foreach my $tkey (sort keys %$todo) {
 618 %               my $t= $todo->{$tkey};
 619 %               next if $t->{"${od}Arbitrage"} != $arbitrage;
 620 %               if (!$age_reported++) {
 621 %                       my $age= $now - $t->{Timestamp};
 622 %                       my $cellid= "da_${i}";
 623 %                       $da_ages{$cellid}= $age;
 624 <td colspan=3>\
 625 (Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
 626 %               } elsif (!defined $total) {
 627 %                       $total= 0;
 628 <tbody>
 629 %               }
 630 %               $total += $t->{Total};
 631 %               my $span= 0 + keys %{ $t->{Stalls} };
 632 %               my $td= "td rowspan=$span";
 633 <tr class="datarow<% $dline %>">
 634 <<% $td %>><% $collectdeliver %>
 635 <<% $td %>><% $t->{'commodname'} |h %>
 636 %
 637 %               my @stalls= sort keys %{ $t->{Stalls} };
 638 %               my $pstall= sub {
 639 %                       my $name= $stalls[$_[0]];
 640 <td><% $name |h %>
 641 %               };
 642 %
 643 %               $pstall->(0);
 644 <<% $td %> align=right><% $t->{Price} |h %> poe ea.
 645 <<% $td %> align=right><% $t->{Qty} |h %> unit(s)
 646 <<% $td %> align=right><% $t->{Total} |h %> total
 647 %
 648 %               foreach my $stallix (1..$#stalls) {
 649 <tr class="datarow<% $dline %>">
 650 %                       $pstall->($stallix);
 651 %               }
 652 %
 653 %               $dline ^= 1;
 654 %       }
 655 %    };
 656 %    my $show_total= sub {
 657 %       my ($totaldesc, $sign)= @_;
 658 %       if (defined $total) {
 659 <tr>
 660 <td colspan=3>
 661 <td colspan=2 align=right><% $totaldesc %>
 662 <td align=right><% $total |h %> total
 663 %               $total_total += $sign * $total;
 664 %       }
 665 %       $total= undef;
 666 %       $dline= 0;
 667 <%perl>
 668      };
 669
 670      $show_flows->('dst',0,'Deliver'); $show_total->('Proceeds',1);
 671      $show_flows->('org',1,'Collect'); $show_total->('(Arbitrage) outlay',-1);
 672      $show_flows->('dst',1,'Deliver'); $show_total->('(Arbitrage) proceeds',1);
 673      $show_flows->('org',0,'Collect'); $show_total->('Outlay',-1);
 674
 675 }
 676 </%perl>
 677 <tbody><tr>
 678 <td colspan=2>
 679 <td colspan=3 align=right>Overall net cash flow
 680 <td align=right><strong><%
 681   $total_total < 0 ? -$total_total." loss" : $total_total." gain"
 682  %></strong>
 683 </table>
 684 <& query_age:dataages, id2age => \%da_ages &>
 685 %
 686 % } # ========== TRADING PLAN ==========
 687
 688 <%init>
 689 use CommodsWeb;
 690 use Commods;
 691 </%init>