pctb/db-idempotent-populate

   1 #!/usr/bin/perl -w
   2 #
   3 # usage: ./db-idempotent-populate <Oceanname>
   4 #  creates or updates OCEAN-Oceanname.db
   5 #  from master-master.txt
   6
   7 # This is part of ypp-sc-tools, a set of third-party tools for assisting
   8 # players of Yohoho Puzzle Pirates.
   9 #
  10 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
  11 #
  12 # This program is free software: you can redistribute it and/or modify
  13 # it under the terms of the GNU General Public License as published by
  14 # the Free Software Foundation, either version 3 of the License, or
  15 # (at your option) any later version.
  16 #
  17 # This program is distributed in the hope that it will be useful,
  18 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 # GNU General Public License for more details.
  21 #
  22 # You should have received a copy of the GNU General Public License
  23 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  24 #
  25 # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
  26 # are used without permission.  This program is not endorsed or
  27 # sponsored by Three Rings.
  28
  29 use strict (qw(vars));
  30
  31 use DBI;
  32
  33 use Commods;
  34 use CommodsDatabase;
  35
  36 @ARGV==1 or die;
  37 my ($oceanname) = @ARGV;
  38
  39 #---------- setup ----------
  40
  41 parse_masters_ocean($oceanname);
  42 our $ocean= $oceans{$oceanname};
  43
  44 db_setocean($oceanname);
  45 db_connect();
  46
  47 #---------- schema ----------
  48
  49 foreach my $bs (qw(buy sell)) {
  50     db_doall(<<END)
  51  CREATE TABLE IF NOT EXISTS $bs (
  52         commodid        INTEGER                 NOT NULL,
  53         islandid        INTEGER                 NOT NULL,
  54         stallid         INTEGER                 NOT NULL,
  55         price           INTEGER                 NOT NULL,
  56         qty             INTEGER                 NOT NULL,
  57         PRIMARY KEY (commodid, islandid, stallid)
  58  );
  59  CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
  60  CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
  61 END
  62     ;
  63 }
  64
  65 db_doall(<<END)
  66  CREATE TABLE IF NOT EXISTS commods (
  67         commodid        INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
  68         commodname      TEXT    UNIQUE          NOT NULL,
  69         unitmass        INTEGER,
  70         unitvolume      INTEGER
  71  );
  72  CREATE TABLE IF NOT EXISTS islands (
  73         islandid        INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
  74         islandname      TEXT    UNIQUE          NOT NULL,
  75         archipelago     TEXT                    NOT NULL
  76  );
  77  CREATE TABLE IF NOT EXISTS stalls (
  78         stallid         INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
  79         islandid        INTEGER                 NOT NULL,
  80         stallname       TEXT                    NOT NULL,
  81         UNIQUE (islandid, stallname)
  82  );
  83  CREATE TABLE IF NOT EXISTS uploads (
  84         islandid        INTEGER PRIMARY KEY     NOT NULL,
  85         timestamp       INTEGER                 NOT NULL,
  86         message         TEXT                    NOT NULL,
  87         clientspec      TEXT                    NOT NULL,
  88         serverspec      TEXT                    NOT NULL
  89  );
  90  CREATE TABLE IF NOT EXISTS dists (
  91         aiid            INTEGER                 NOT NULL,
  92         biid            INTEGER                 NOT NULL,
  93         dist            INTEGER                 NOT NULL,
  94         PRIMARY KEY (aiid, biid)
  95  );
  96 END
  97     ;
  98
  99 $dbh->commit;
 100
 101 #---------- commodity list ----------
 102
 103 {
 104     my $sth= $dbh->prepare(<<'END')
 105  INSERT OR IGNORE INTO commods (commodname) VALUES (?);
 106 END
 107     ;
 108     foreach my $commod (sort keys %commods) {
 109         $sth->execute($commod);
 110     }
 111     $dbh->commit;
 112 }
 113
 114 #---------- island list ----------
 115
 116 {
 117     my $sth= $dbh->prepare(<<'END')
 118  INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?);
 119 END
 120     ;
 121     foreach my $archname (sort keys %$ocean) {
 122         my $arch= $ocean->{$archname};
 123         foreach my $islandname (sort keys %$arch) {
 124             $sth->execute($islandname, $archname);
 125         }
 126     }
 127     $dbh->commit;
 128 }
 129
 130 #---------- routes ----------
 131
 132 {
 133     foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) {
 134         warn "$route_mysteries{$oceanname}{$islandname} routes".
 135             " for unknown island $islandname\n";
 136     }
 137
 138     my $allroutes= $routes{$oceanname};
 139
 140     my @propqueue= ();
 141
 142     sub distance_set_propagate ($$$$) {
 143         my ($lev, $start, $upto, $start2upto) = @_;
 144         $allroutes->{$start}{$upto}= $start2upto;
 145         push @propqueue, [ $lev, $start, $upto ];
 146     }
 147
 148     sub distance_propagate_now {
 149         my ($lev, $start, $upto) = @_;
 150         my $startref= $allroutes->{$start};
 151         my $start2upto= $startref->{$upto};
 152         my $uptoref=  $allroutes->{$upto};
 153
 154         for my $next (keys %$uptoref) {
 155             next if $next eq $upto;
 156             my $unext= $uptoref->{$next};
 157             next unless defined $unext;
 158             distance_update("${lev}p", $start, $next, $start2upto + $unext);
 159         }
 160     }
 161
 162     sub distance_update ($$$$) {
 163         my ($lev, $x, $y, $newdist) = @_;
 164         distance_update_one("${lev}x",$x,$y,$newdist);
 165         distance_update_one("${lev}y",$y,$x,$newdist);
 166     }
 167
 168     sub distance_update_one ($$$$) {
 169         my ($lev, $x, $y, $newdist) = @_;
 170         my $xref= $allroutes->{$x};
 171         my $currently= $xref->{$y};
 172         return if defined($currently) and $currently <= $newdist;
 173         distance_set_propagate("${lev}o",$x,$y,$newdist);
 174     }
 175
 176     foreach my $xn (keys %$allroutes) {
 177         my $routes= $allroutes->{$xn};
 178         distance_set_propagate('0', $xn, $xn, 0);
 179         foreach my $yn (keys %$routes) {
 180             distance_set_propagate('0', $yn, $yn, 0);
 181             distance_set_propagate('X', $xn, $yn, $routes->{$yn});
 182             distance_set_propagate('Y', $yn, $xn, $routes->{$yn});
 183         }
 184     }
 185     my $ref;
 186     while ($ref= shift @propqueue) {
 187         distance_propagate_now(@$ref);
 188     }
 189
 190     db_doall(<<END)
 191  DELETE FROM dists;
 192 END
 193     ;
 194     my $sth= $dbh->prepare(<<'END')
 195  INSERT INTO dists VALUES
 196         ((SELECT islandid FROM islands WHERE islandname == ?),
 197          (SELECT islandid FROM islands WHERE islandname == ?),
 198          ?);
 199 END
 200     ;
 201     foreach my $xn (keys %$allroutes) {
 202         my $routes= $allroutes->{$xn};
 203         foreach my $yn (keys %$routes) {
 204             $sth->execute($xn, $yn, $routes->{$yn});
 205         }
 206     }
 207     $dbh->commit();
 208
 209     # select ia.islandname, ib.islandname,dists.dist from dists, islands as ia on dists.aiid = ia.islandid, islands as ib on dists.biid = ib.islandid order by ia.islandname, ib.islandname;
 210 }
 211
 212 __DATA__