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 foreach my $f (@flows) {
 243
 244         $f->{MaxQty}= $f->{'org_qty_agg'} < $f->{'dst_qty_agg'}
 245                 ? $f->{'org_qty_agg'} : $f->{'dst_qty_agg'};
 246         $f->{MaxProfit}= $f->{MaxQty} * $f->{'unitprofit'};
 247         $f->{MaxCapital}= $f->{MaxQty} * $f->{'org_price'};
 248
 249         $f->{MarginSortKey}= sprintf "%d",
 250                 $f->{'dst_price'} * 10000 / $f->{'org_price'};
 251         $f->{Margin}= sprintf "%3.1f%%",
 252                 $f->{'dst_price'} * 100.0 / $f->{'org_price'} - 100.0;
 253
 254         $f->{ExpectedUnitProfit}=
 255                 $f->{'dst_price'} * (1.0 - $loss_per_league) ** $f->{'dist'}
 256                 - $f->{'org_price'};
 257
 258         my @uid= $f->{commodid};
 259         foreach my $od (qw(org dst)) {
 260                 push @uid,
 261                         $f->{"${od}_id"},
 262                         $f->{"${od}_price"};
 263                 push @uid,
 264                         $f->{"${od}_stallid"}
 265                                 if $qa->{ShowStalls};
 266         }
 267         $f->{UidLong}= join '_', @uid;
 268
 269         my $base= 31;
 270         my $cmpu= '';
 271         map {
 272                 my $uue= $_;
 273                 my $first= $base;
 274                 do {
 275                         my $this= $uue % $base;
 276 print STDERR "uue=$uue this=$this ";
 277                         $uue -= $this;
 278                         $uue /= $base;
 279                         $this += $first;
 280                         $first= 0;
 281                         $cmpu .= chr($this + ($this < 26 ? ord('a') :
 282                                               $this < 52 ? ord('A')-26
 283                                                          : ord('0')-52));
 284 print STDERR " uue=$uue this=$this cmpu=$cmpu\n";
 285 die "$cmpu $uue ?" if length $cmpu > 20;
 286                 } while ($uue);
 287                 $cmpu;
 288         } @uid;
 289         $f->{UidShort}= $cmpu;
 290
 291         if ($qa->{'debug'}) {
 292                 my @outuid;
 293                 $_= $f->{UidShort};
 294                 my $mul;
 295                 while (m/./) {
 296                         my $v= m/^[a-z]/ ? ord($&)-ord('a') :
 297                                m/^[A-Z]/ ? ord($&)-ord('A')+26 :
 298                                m/^[0-9]/ ? ord($&)-ord('0')+52 :
 299                                die "$_ ?";
 300                         if ($v >= $base) {
 301                                 push @outuid, 0;
 302                                 $v -= $base;
 303                                 $mul= 1;
 304 #print STDERR "(next)\n";
 305                         }
 306                         die "$f->{UidShort} $_ ?" unless defined $mul;
 307                         $outuid[$#outuid] += $v * $mul;
 308
 309 #print STDERR "$f->{UidShort}  $_  $&  v=$v  mul=$mul  ord()=".ord($&).
 310 #                       "[vs.".ord('a').",".ord('A').",".ord('0')."]".
 311 #                       "  outuid=@outuid\n";
 312
 313                         $mul *= $base;
 314                         s/^.//;
 315                 }
 316                 my $recons_long= join '_', @outuid;
 317                 $f->{UidLong} eq $recons_long or
 318                         die "$f->{UidLong} = $f->{UidShort} = $recons_long ?";
 319         }
 320
 321         if (defined $qa->{"R$f->{UidShort}"} &&
 322             !defined $qa->{"T$f->{UidShort}"}) {
 323                 $f->{Suppress}= 1;
 324         }
 325
 326 }
 327 </%perl>
 328
 329 % my $optimise= $specific && !$confusing && @islandids>1;
 330 % if (!$optimise) {
 331
 332 <p>
 333 % if (@islandids<=1) {
 334 Route is trivial.
 335 % }
 336 % if (!$specific) {
 337 Route contains archipelago(es), not just specific islands.
 338 % }
 339 % if ($confusing) {
 340 Route is complex - it visits the same island several times
 341 and isn't a simple loop.
 342 % }
 343 Therefore, optimal trade pattern not calculated.
 344
 345 % } else { # ========== OPTMISATION ==========
 346 <%perl>
 347
 348 my $cplex= "
 349 Maximize
 350
 351   totalprofit:
 352                   ".(join " +
 353                   ", map {
 354                         sprintf "%.20f %s", $_->{ExpectedUnitProfit}, $_->{Var}
 355                         } @flows)."
 356
 357 Subject To
 358 ";
 359
 360 my %avail_csts;
 361 foreach my $flow (@flows) {
 362         if ($flow->{Suppress}) {
 363                 $cplex .= "
 364    $flow->{Var} = 0
 365 ";
 366                 next;
 367         }
 368         foreach my $od (qw(org dst)) {
 369                 my $cstname= join '_', (
 370                         'avail',
 371                         $flow->{'commodid'},
 372                         $od,
 373                         $flow->{"${od}_id"},
 374                         $flow->{"${od}_price"},
 375                         $flow->{"${od}_stallid"},
 376                 );
 377
 378                 push @{ $avail_csts{$cstname}{Flows} }, $flow->{Var};
 379                 $avail_csts{$cstname}{Qty}= $flow->{"${od}_qty_agg"};
 380         }
 381 }
 382 foreach my $cstname (sort keys %avail_csts) {
 383         my $c= $avail_csts{$cstname};
 384         $cplex .= "
 385    ".   sprintf("%-30s","$cstname:")." ".
 386         join("+", @{ $c->{Flows} }).
 387         " <= ".$c->{Qty}."\n";
 388 }
 389
 390 $cplex.= "
 391 Bounds
 392         ".(join "
 393         ", map { "$_->{Var} >= 0" } @flows)."
 394
 395 End
 396 ";
 397
 398 if ($qa->{'debug'}) {
 399 </%perl>
 400 <pre>
 401 <% $cplex |h %>
 402 </pre>
 403 <%perl>
 404 }
 405
 406 {
 407         my $input= pipethrough_prep();
 408         print $input $cplex or die $!;
 409         my $output= pipethrough_run_along($input, undef, 'glpsol',
 410                 qw(glpsol --cpxlp /dev/stdin -o /dev/stdout));
 411         print "<pre>\n" if $qa->{'debug'};
 412         my $found_section= 0;
 413         my $glpsol_out= '';
 414         while (<$output>) {
 415                 $glpsol_out.= $_;
 416                 print encode_entities($_) if $qa->{'debug'};
 417                 if (m/^\s*No\.\s+Column name\s+St\s+Activity\s/) {
 418                         die if $found_section>0;
 419                         $found_section= 1;
 420                         next;
 421                 }
 422                 next unless $found_section==1;
 423                 next if m/^[- ]+$/;
 424                 if (!/\S/) {
 425                         $found_section= 2;
 426                         next;
 427                 }
 428                 my ($ix, $qty) =
 429                         m/^\s*\d+\s+f(\d+)\s+\S+\s+(\d+)\s/ or die "$_ ?";
 430                 my $flow= $flows[$ix] or die;
 431                 $flow->{OptQty}= $qty;
 432                 $flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
 433                 $flow->{OptCapital}= $flow->{OptQty} * $flow->{'org_price'};
 434         }
 435         print "</pre>\n" if $qa->{'debug'};
 436         my $prerr= "\n=====\n$cplex\n=====\n$glpsol_out\n=====\n ";
 437         pipethrough_run_finish($output,$prerr);
 438         die $prerr unless $found_section;
 439 };
 440
 441 $addcols->({ DoReverse => 1 }, qw(
 442                 OptQty
 443         ));
 444 $addcols->({ Total => 0, DoReverse => 1 }, qw(
 445                 OptCapital OptProfit
 446         ));
 447
 448 </%perl>
 449
 450 % } # ========== OPTIMISATION ==========
 451
 452 % my %ts_sortkeys;
 453 % {
 454 %       my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
 455 %       my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
 456 <table id="trades" rules=groups>
 457 <colgroup span=1>
 458 <colgroup span=2>
 459 <% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
 460 <colgroup span=1>
 461 <colgroup span=2>
 462 <colgroup span=2>
 463 <colgroup span=2>
 464 <colgroup span=3>
 465 %       if ($optimise) {
 466 <colgroup span=3>
 467 %       }
 468 <tr class="spong">
 469 <th>
 470 <th<% $cdspan %>>Collect
 471 <th<% $cdspan %>>Deliver
 472 <th>
 473 <th colspan=2>Collect
 474 <th colspan=2>Deliver
 475 <th colspan=2>Profit
 476 <th colspan=3>Max
 477 %       if ($optimise) {
 478 <th colspan=3>Planned
 479 %       }
 480
 481 <tr>
 482 <th>
 483 <th>Island <% $cdstall %>
 484 <th>Island <% $cdstall %>
 485 <th>Commodity
 486 <th>Price
 487 <th>Qty
 488 <th>Price
 489 <th>Qty
 490 <th>Margin
 491 <th>Unit
 492 <th>Qty
 493 <th>Capital
 494 <th>Profit
 495 %       if ($optimise) {
 496 <th>Qty
 497 <th>Capital
 498 <th>Profit
 499 %       }
 500 % }
 501
 502 <tr id="trades_sort">
 503 % foreach my $col (@cols) {
 504 <th>
 505 % }
 506
 507 % foreach my $flowix (0..$#flows) {
 508 %       my $flow= $flows[$flowix];
 509 %       my $rowid= "id_row_$flow->{UidShort}";
 510 <tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
 511 <td><input type=hidden   name=R<% $flow->{UidShort} %> value="">
 512     <input type=checkbox name=T<% $flow->{UidShort} %> value=""
 513        <% $flow->{Suppress} ? '' : 'checked' %> >
 514 %       foreach my $ci (1..$#cols) {
 515 %               my $col= $cols[$ci];
 516 %               my $v= $flow->{$col->{Name}};
 517 %               $col->{Total} += $v if defined $col->{Total};
 518 %               $v='' if !$col->{Text} && !$v;
 519 %               my $sortkey= $col->{SortColKey} ?
 520 %                       $flow->{$col->{SortColKey}} : $v;
 521 %               $ts_sortkeys{$ci}{$rowid}= $sortkey;
 522 <td <% $col->{Text} ? '' : 'align=right' %>><% $v |h %>
 523 %       }
 524 % }
 525 <tr id="trades_total">
 526 <th>
 527 <th colspan=2>Total
 528 % foreach my $ci (3..$#cols) {
 529 %       my $col= $cols[$ci];
 530 <td align=right>
 531 %       if (defined $col->{Total}) {
 532 <% $col->{Total} |h %>
 533 %       }
 534 % }
 535 </table>
 536
 537 <& tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
 538         throw => 'trades_sort', tbrow => 'trades_total' &>
 539 <&| script &>
 540   ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
 541   function all_onload() {
 542     ts_onload__trades();
 543   }
 544   window.onload= all_onload;
 545 </&script>
 546
 547 <input type=submit name=update value="Update">
 548
 549 % if ($optimise) { # ========== TRADING PLAN ==========
 550 %
 551 % my $iquery= $dbh->prepare('SELECT islandname FROM islands
 552 %                               WHERE islandid = ?');
 553 % my %da_ages;
 554 %
 555 <h1>Voyage trading plan</h1>
 556 <table rules=groups>
 557 % foreach my $i (0..$#islandids) {
 558 <tbody>
 559 <tr><td colspan=3><strong>
 560 %       $iquery->execute($islandids[$i]);
 561 %       my ($islandname) = $iquery->fetchrow_array();
 562 %       if (!$i) {
 563 Start at <% $islandname |h %>
 564 %       } else {
 565 Sail to <% $islandname |h %>
 566 %       }
 567 </strong>
 568 <%perl>
 569      my $age_reported= 0;
 570      my %flowlists;
 571      foreach my $od (qw(org dst)) {
 572         foreach my $f (@flows) {
 573                 next if $f->{Suppress};
 574                 next unless $f->{"${od}_id"} == $islandids[$i];
 575                 next unless $f->{OptQty};
 576                 my $price= $f->{"${od}_price"};
 577                 my $stallname= $f->{"${od}_stallname"};
 578                 my $todo= \$flowlists{$od}{
 579                                 $f->{'commodname'},
 580                                 (sprintf "%07d", ($od eq 'dst' ?
 581                                                 9999999-$price : $price)),
 582                                 $stallname
 583                         };
 584                 $$todo= {
 585                         Qty => 0,
 586                         orgArbitrage => 0,
 587                         dstArbitrage => 0,
 588                 } unless $$todo;
 589                 $$todo->{'commodname'}= $f->{'commodname'};
 590                 $$todo->{'stallname'}= $stallname;
 591                 $$todo->{Price}= $price;
 592                 $$todo->{Timestamp}= $f->{"${od}_timestamp"};
 593                 $$todo->{Qty} += $f->{OptQty};
 594                 $$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
 595                 $$todo->{Stalls}= $f->{"${od}Stalls"};
 596                 if ($f->{'org_id'} == $f->{'dst_id'}) {
 597                         $$todo->{"${od}Arbitrage"}= 1;
 598                 }
 599         }
 600      }
 601
 602      my $total;
 603      my $dline= 0;
 604      my $show_flows= sub {
 605         my ($od,$arbitrage,$collectdeliver) = @_;
 606 </%perl>
 607 %
 608 %       my $todo= $flowlists{$od};
 609 %       return unless $todo;
 610 %       foreach my $tkey (sort keys %$todo) {
 611 %               my $t= $todo->{$tkey};
 612 %               next if $t->{"${od}Arbitrage"} != $arbitrage;
 613 %               if (!$age_reported++) {
 614 %                       my $age= $now - $t->{Timestamp};
 615 %                       my $cellid= "da_${i}";
 616 %                       $da_ages{$cellid}= $age;
 617 <td colspan=3>\
 618 (Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
 619 %               } elsif (!defined $total) {
 620 %                       $total= 0;
 621 <tbody>
 622 %               }
 623 %               $total += $t->{Total};
 624 %               my $span= 0 + keys %{ $t->{Stalls} };
 625 %               my $td= "td rowspan=$span";
 626 <tr class="datarow<% $dline %>">
 627 <<% $td %>><% $collectdeliver %>
 628 <<% $td %>><% $t->{'commodname'} |h %>
 629 %
 630 %               my @stalls= sort keys %{ $t->{Stalls} };
 631 %               my $pstall= sub {
 632 %                       my $name= $stalls[$_[0]];
 633 <td><% $name |h %>
 634 %               };
 635 %
 636 %               $pstall->(0);
 637 <<% $td %> align=right><% $t->{Price} |h %> poe ea.
 638 <<% $td %> align=right><% $t->{Qty} |h %> unit(s)
 639 <<% $td %> align=right><% $t->{Total} |h %> total
 640 %
 641 %               foreach my $stallix (1..$#stalls) {
 642 <tr class="datarow<% $dline %>">
 643 %                       $pstall->($stallix);
 644 %               }
 645 %
 646 %               $dline ^= 1;
 647 %       }
 648 %    };
 649 %    my $show_total= sub {
 650 %       my ($totaldesc)= @_;
 651 %       if (defined $total) {
 652 <tr>
 653 <td colspan=3>
 654 <td colspan=2 align=right><% $totaldesc %>
 655 <td align=right><% $total |h %> total
 656 %       }
 657 %       $total= undef;
 658 %       $dline= 0;
 659 <%perl>
 660      };
 661
 662      $show_flows->('dst',0,'Deliver');  $show_total->('Proceeds');
 663      $show_flows->('org',1,'Collect');  $show_total->('(Arbitrage) outlay');
 664      $show_flows->('dst',1,'Deliver');  $show_total->('(Arbitrage) proceeds');
 665      $show_flows->('org',0,'Collect');  $show_total->('Outlay');
 666
 667 }
 668 </%perl>
 669 </table>
 670 <& query_age:dataages, id2age => \%da_ages &>
 671 %
 672 % } # ========== TRADING PLAN ==========
 673
 674 <%init>
 675 use CommodsWeb;
 676 use Commods;
 677 </%init>