Split lookup options into separate query_ components

[ypp-sc-tools.main.git] / yarrg / web / query_age

diff --git a/yarrg/web/query_age b/yarrg/web/query_age
new file mode 100644 (file)
index 0000000..c5009d3
--- /dev/null
+++ b/yarrg/web/query_age
@@ -0,0 +1,132 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component generates the core of the `data age' query.
+
+
+</%doc>
+<%once>
+my $meta_prettyprint_age= sub {
+    my ($age,$floor,$plus) = @_;
+    return <<END;
+        $age < 60 ?             'less than a minute'                    :
+        $age < 60*2 ?           '1 minute'                              :
+        $age < 3600*2 ?         $floor ($age/60) $plus' minutes'        :
+        $age < 86400*2 ?        $floor ($age/3600) $plus ' hours'       :
+                                $floor ($age/86400) $plus ' days';
+END
+};
+
+my $prettyprint_age;
+eval '
+  $prettyprint_age= sub {
+               my ($age) = @_;
+               '.$meta_prettyprint_age->('$age','floor','.').'
+  };
+' or die "$@";
+
+</%once>
+
+<%perl>
+
+my $now= time;
+
+my $row;
+my $sth= $dbh->prepare("SELECT archipelago, islandid, islandname, timestamp
+                               FROM uploads NATURAL JOIN islands
+                               ORDER BY archipelago, islandid");
+$sth->execute();
+
+</%perl>
+
+<&| script &>
+  da_pageload= Date.now();
+</&script>
+
+<h1>Market data age</h1>
+
+<table>
+<tr>
+<th>Archipelago
+<th>Island
+<th>Age
+</tr>
+% my %da_ages;
+% $da_ages{'daid_loaded'}= 0;
+% while ($row=$sth->fetchrow_hashref) {
+%      my $elid= "daid_$row->{'islandid'}";
+%      my $age= $now - $row->{'timestamp'};
+%      $da_ages{$elid}= $age;
+<tr> <td><% $row->{'archipelago'} |h
+ %>  <td><% $row->{'islandname'} |h
+ %>  <td id="<% $elid %>"><% $prettyprint_age->($age) %> </tr>
+% }
+</table>
+
+<p>
+Time since this page loaded:
+<span id="daid_loaded">(not known; times above not updating)</span>
+
+<form action="lookup" method="get">
+% foreach my $a (keys %ARGS) {
+<input type="hidden" name="<% $a |h %>" value="<% $ARGS{$a} |h %>">
+% }
+<input type=submit name=submit value="Reload">
+</form>
+
+<&| script &>
+  da_ages= <% to_json_protecttags(\%da_ages) %>;
+
+  function da_Refresh() {
+    var now= Date.now();
+    debug('updating now='+now);
+    for (var elid in da_ages) {
+      var el= document.getElementById(elid);
+      var oldage= da_ages[elid];
+      var age= oldage + (now - da_pageload) / 1000;
+      var newhtml= <% $meta_prettyprint_age->('age','Math.floor','+') %>
+% if ($ARGS{debug}) {
+      if (elid == 'daid_loaded')
+       debug('element elid='+elid+' oldage='+oldage+' age='+age+': '+newhtml);
+% }
+      el.innerHTML= newhtml;
+    }
+  }
+
+  window.onload= da_Refresh;
+  window.setInterval(da_Refresh, 10000);
+</&script>
+
+<%init>
+use POSIX;
+use CommodsWeb;
+my $dbh= dbw_connect('Midnight');
+</%init>