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