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         while (<$output>) {
 414                 print encode_entities($_) if $qa->{'debug'};
 415                 if (m/^\s*No\.\s+Column name\s+St\s+Activity\s/) {
 416                         die if $found_section>0;
 417                         $found_section= 1;
 418                         next;
 419                 }
 420                 next unless $found_section==1;
 421                 next if m/^[- ]+$/;
 422                 if (!/\S/) {
 423                         $found_section= 2;
 424                         next;
 425                 }
 426                 my ($ix, $qty) =
 427                         m/^\s*\d+\s+f(\d+)\s+\S+\s+(\d+)\s/ or die "$_ ?";
 428                 my $flow= $flows[$ix] or die;
 429                 $flow->{OptQty}= $qty;
 430                 $flow->{OptProfit}= $flow->{'unitprofit'} * $qty;
 431                 $flow->{OptCapital}= $flow->{OptQty} * $flow->{'org_price'};
 432         }
 433         print "</pre>\n" if $qa->{'debug'};
 434         pipethrough_run_finish($output, 'glpsol');
 435         die unless $found_section;
 436 };
 437
 438 $addcols->({ DoReverse => 1 }, qw(
 439                 OptQty
 440         ));
 441 $addcols->({ Total => 0, DoReverse => 1 }, qw(
 442                 OptCapital OptProfit
 443         ));
 444
 445 </%perl>
 446
 447 % } # ========== OPTIMISATION ==========
 448
 449 % my %ts_sortkeys;
 450 % {
 451 %       my $cdspan= $qa->{ShowStalls} ? ' colspan=2' : '';
 452 %       my $cdstall= $qa->{ShowStalls} ? '<th>Stall</th>' : '';
 453 <table id="trades" rules=groups>
 454 <colgroup span=1>
 455 <colgroup span=2>
 456 <% $qa->{ShowStalls} ? '<colgroup span=2>' : '' %>
 457 <colgroup span=1>
 458 <colgroup span=2>
 459 <colgroup span=2>
 460 <colgroup span=2>
 461 <colgroup span=3>
 462 %       if ($optimise) {
 463 <colgroup span=3>
 464 %       }
 465 <tr class="spong">
 466 <th>
 467 <th<% $cdspan %>>Collect
 468 <th<% $cdspan %>>Deliver
 469 <th>
 470 <th colspan=2>Collect
 471 <th colspan=2>Deliver
 472 <th colspan=2>Profit
 473 <th colspan=3>Max
 474 %       if ($optimise) {
 475 <th colspan=3>Planned
 476 %       }
 477
 478 <tr>
 479 <th>
 480 <th>Island <% $cdstall %>
 481 <th>Island <% $cdstall %>
 482 <th>Commodity
 483 <th>Price
 484 <th>Qty
 485 <th>Price
 486 <th>Qty
 487 <th>Margin
 488 <th>Unit
 489 <th>Qty
 490 <th>Capital
 491 <th>Profit
 492 %       if ($optimise) {
 493 <th>Qty
 494 <th>Capital
 495 <th>Profit
 496 %       }
 497 % }
 498
 499 <tr id="trades_sort">
 500 % foreach my $col (@cols) {
 501 <th>
 502 % }
 503
 504 % foreach my $flowix (0..$#flows) {
 505 %       my $flow= $flows[$flowix];
 506 %       my $rowid= "id_row_$flow->{UidShort}";
 507 <tr id="<% $rowid %>" class="datarow<% $flowix & 1 %>">
 508 <td><input type=hidden   name=R<% $flow->{UidShort} %> value="">
 509     <input type=checkbox name=T<% $flow->{UidShort} %> value=""
 510        <% $flow->{Suppress} ? '' : 'checked' %> >
 511 %       foreach my $ci (1..$#cols) {
 512 %               my $col= $cols[$ci];
 513 %               my $v= $flow->{$col->{Name}};
 514 %               $col->{Total} += $v if defined $col->{Total};
 515 %               $v='' if !$col->{Text} && !$v;
 516 %               my $sortkey= $col->{SortColKey} ?
 517 %                       $flow->{$col->{SortColKey}} : $v;
 518 %               $ts_sortkeys{$ci}{$rowid}= $sortkey;
 519 <td <% $col->{Text} ? '' : 'align=right' %>><% $v |h %>
 520 %       }
 521 % }
 522 <tr id="trades_total">
 523 <th>
 524 <th colspan=2>Total
 525 % foreach my $ci (3..$#cols) {
 526 %       my $col= $cols[$ci];
 527 <td align=right>
 528 %       if (defined $col->{Total}) {
 529 <% $col->{Total} |h %>
 530 %       }
 531 % }
 532 </table>
 533
 534 <& tabsort, cols => \@cols, table => 'trades', rowclass => 'datarow',
 535         throw => 'trades_sort', tbrow => 'trades_total' &>
 536 <&| script &>
 537   ts_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>;
 538   function all_onload() {
 539     ts_onload__trades();
 540   }
 541   window.onload= all_onload;
 542 </&script>
 543
 544 <input type=submit name=update value="Update">
 545
 546 % if ($optimise) { # ========== TRADING PLAN ==========
 547 %
 548 % my $iquery= $dbh->prepare('SELECT islandname FROM islands
 549 %                               WHERE islandid = ?');
 550 % my %da_ages;
 551 %
 552 <h1>Voyage trading plan</h1>
 553 <table rules=groups>
 554 % foreach my $i (0..$#islandids) {
 555 <tbody>
 556 <tr><td colspan=3><strong>
 557 %       $iquery->execute($islandids[$i]);
 558 %       my ($islandname) = $iquery->fetchrow_array();
 559 %       if (!$i) {
 560 Start at <% $islandname |h %>
 561 %       } else {
 562 Sail to <% $islandname |h %>
 563 %       }
 564 </strong>
 565 <%perl>
 566      my $age_reported= 0;
 567      my %flowlists;
 568      foreach my $od (qw(org dst)) {
 569         foreach my $f (@flows) {
 570                 next if $f->{Suppress};
 571                 next unless $f->{"${od}_id"} == $islandids[$i];
 572                 next unless $f->{OptQty};
 573                 my $price= $f->{"${od}_price"};
 574                 my $stallname= $f->{"${od}_stallname"};
 575                 my $todo= \$flowlists{$od}{
 576                                 $f->{'commodname'},
 577                                 (sprintf "%07d", ($od eq 'dst' ?
 578                                                 9999999-$price : $price)),
 579                                 $stallname
 580                         };
 581                 $$todo= {
 582                         Qty => 0,
 583                         orgArbitrage => 0,
 584                         dstArbitrage => 0,
 585                 } unless $$todo;
 586                 $$todo->{'commodname'}= $f->{'commodname'};
 587                 $$todo->{'stallname'}= $stallname;
 588                 $$todo->{Price}= $price;
 589                 $$todo->{Timestamp}= $f->{"${od}_timestamp"};
 590                 $$todo->{Qty} += $f->{OptQty};
 591                 $$todo->{Total}= $$todo->{Price} * $$todo->{Qty};
 592                 $$todo->{Stalls}= $f->{"${od}Stalls"};
 593                 if ($f->{'org_id'} == $f->{'dst_id'}) {
 594                         $$todo->{"${od}Arbitrage"}= 1;
 595                 }
 596         }
 597      }
 598
 599      my $total;
 600      my $dline= 0;
 601      my $show_flows= sub {
 602         my ($od,$arbitrage,$collectdeliver) = @_;
 603 </%perl>
 604 %
 605 %       my $todo= $flowlists{$od};
 606 %       return unless $todo;
 607 %       foreach my $tkey (sort keys %$todo) {
 608 %               my $t= $todo->{$tkey};
 609 %               next if $t->{"${od}Arbitrage"} != $arbitrage;
 610 %               if (!$age_reported++) {
 611 %                       my $age= $now - $t->{Timestamp};
 612 %                       my $cellid= "da_${i}";
 613 %                       $da_ages{$cellid}= $age;
 614 <td colspan=3>\
 615 (Data age: <span id="<% $cellid %>"><% prettyprint_age($age) %></span>)
 616 %               } elsif (!defined $total) {
 617 %                       $total= 0;
 618 <tbody>
 619 %               }
 620 %               $total += $t->{Total};
 621 %               my $span= 0 + keys %{ $t->{Stalls} };
 622 %               my $td= "td rowspan=$span";
 623 <tr class="datarow<% $dline %>">
 624 <<% $td %>><% $collectdeliver %>
 625 <<% $td %>><% $t->{'commodname'} |h %>
 626 %
 627 %               my @stalls= sort keys %{ $t->{Stalls} };
 628 %               my $pstall= sub {
 629 %                       my $name= $stalls[$_[0]];
 630 <td><% $name |h %>
 631 %               };
 632 %
 633 %               $pstall->(0);
 634 <<% $td %> align=right><% $t->{Price} |h %> poe ea.
 635 <<% $td %> align=right><% $t->{Qty} |h %> unit(s)
 636 <<% $td %> align=right><% $t->{Total} |h %> total
 637 %
 638 %               foreach my $stallix (1..$#stalls) {
 639 <tr class="datarow<% $dline %>">
 640 %                       $pstall->($stallix);
 641 %               }
 642 %
 643 %               $dline ^= 1;
 644 %       }
 645 %    };
 646 %    my $show_total= sub {
 647 %       my ($totaldesc)= @_;
 648 %       if (defined $total) {
 649 <tr>
 650 <td colspan=3>
 651 <td colspan=2 align=right><% $totaldesc %>
 652 <td align=right><% $total |h %> total
 653 %       }
 654 %       $total= undef;
 655 %       $dline= 0;
 656 <%perl>
 657      };
 658
 659      $show_flows->('dst',0,'Deliver');  $show_total->('Proceeds');
 660      $show_flows->('org',1,'Collect');  $show_total->('(Arbitrage) outlay');
 661      $show_flows->('dst',1,'Deliver');  $show_total->('(Arbitrage) proceeds');
 662      $show_flows->('org',0,'Collect');  $show_total->('Outlay');
 663
 664 }
 665 </%perl>
 666 </table>
 667 <& query_age:dataages, id2age => \%da_ages &>
 668 %
 669 % } # ========== TRADING PLAN ==========
 670
 671 <%init>
 672 use CommodsWeb;
 673 use Commods;
 674 </%init>