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
  35 @ARGV==1 or die;
  36 my ($oceanname) = @ARGV;
  37
  38 my $dbfn= "OCEAN-$oceanname.db";
  39
  40 our $dbh;
  41
  42 sub dbdoall ($) {
  43     foreach my $cmd (split /\;/, $_[0]) {
  44         $dbh->do("$cmd;") if $cmd =~ m/\S/;
  45     }
  46 }
  47
  48 #---------- setup ----------
  49
  50 parse_masters_ocean($oceanname);
  51 our $ocean= $oceans{$oceanname};
  52
  53 $dbh= DBI->connect("dbi:SQLite:$dbfn",'','',
  54                    { AutoCommit=>0,
  55                      RaiseError=>1, ShowErrorStatement=>1,
  56                      unicode=>1 })
  57     or die "$dbfn $DBI::errstr ?";
  58
  59 #---------- schema ----------
  60
  61 foreach my $bs (qw(buy sell)) {
  62     dbdoall(<<END)
  63  CREATE TABLE IF NOT EXISTS $bs (
  64         commodid        INTEGER                 NOT NULL,
  65         islandid        INTEGER                 NOT NULL,
  66         stallid         INTEGER                 NOT NULL,
  67         price           INTEGER                 NOT NULL,
  68         qty             INTEGER                 NOT NULL,
  69         PRIMARY KEY (commodid, islandid, stallid)
  70  );
  71  CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
  72  CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
  73 END
  74     ;
  75 }
  76
  77 dbdoall(<<END)
  78  CREATE TABLE IF NOT EXISTS commods (
  79         commodid        INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
  80         commodname      TEXT    UNIQUE          NOT NULL,
  81         unitmass        INTEGER,
  82         unitvolume      INTEGER
  83  );
  84  CREATE TABLE IF NOT EXISTS islands (
  85         islandid        INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
  86         islandname      TEXT    UNIQUE          NOT NULL,
  87         archipelago     TEXT                    NOT NULL
  88  );
  89  CREATE TABLE IF NOT EXISTS stalls (
  90         stallid         INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
  91         islandid        INTEGER                 NOT NULL,
  92         stallname       TEXT                    NOT NULL,
  93         UNIQUE (islandid, stallname)
  94  );
  95  CREATE TABLE IF NOT EXISTS uploads (
  96         islandid        INTEGER PRIMARY KEY     NOT NULL,
  97         age             INTEGER                 NOT NULL,
  98         clientspec      TEXT                    NOT NULL,
  99         serverspec      TEXT                    NOT NULL
 100  );
 101  CREATE TABLE IF NOT EXISTS dists (
 102         aiid            INTEGER                 NOT NULL,
 103         biid            INTEGER                 NOT NULL,
 104         dist            INTEGER                 NOT NULL,
 105         PRIMARY KEY (aiid, biid)
 106  );
 107 END
 108     ;
 109
 110 $dbh->commit;
 111
 112 #---------- commodity list ----------
 113
 114 {
 115     my $sth= $dbh->prepare(<<'END')
 116  INSERT OR IGNORE INTO commods (commodname) VALUES (?);
 117 END
 118     ;
 119     foreach my $commod (sort keys %commods) {
 120         $sth->execute($commod);
 121     }
 122     $dbh->commit;
 123 }
 124
 125 #---------- island list ----------
 126
 127 {
 128     my $sth= $dbh->prepare(<<'END')
 129  INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?);
 130 END
 131     ;
 132     foreach my $archname (sort keys %$ocean) {
 133         my $arch= $ocean->{$archname};
 134         foreach my $islandname (sort keys %$arch) {
 135             $sth->execute($islandname, $archname);
 136         }
 137     }
 138     $dbh->commit;
 139 }
 140
 141 #---------- routes ----------
 142
 143 {
 144     foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) {
 145         warn "$route_mysteries{$oceanname}{$islandname} routes".
 146             " for unknown island $islandname\n";
 147     }
 148
 149     my $allroutes= $routes{$oceanname};
 150
 151     my @propqueue= ();
 152
 153     sub distance_set_propagate ($$$$) {
 154         my ($lev, $start, $upto, $start2upto) = @_;
 155         $allroutes->{$start}{$upto}= $start2upto;
 156         push @propqueue, [ $lev, $start, $upto ];
 157     }
 158
 159     sub distance_propagate_now {
 160         my ($lev, $start, $upto) = @_;
 161         my $startref= $allroutes->{$start};
 162         my $start2upto= $startref->{$upto};
 163         my $uptoref=  $allroutes->{$upto};
 164
 165         for my $next (keys %$uptoref) {
 166             next if $next eq $upto;
 167             my $unext= $uptoref->{$next};
 168             next unless defined $unext;
 169             distance_update("${lev}p", $start, $next, $start2upto + $unext);
 170         }
 171     }
 172
 173     sub distance_update ($$$$) {
 174         my ($lev, $x, $y, $newdist) = @_;
 175         distance_update_one("${lev}x",$x,$y,$newdist);
 176         distance_update_one("${lev}y",$y,$x,$newdist);
 177     }
 178
 179     sub distance_update_one ($$$$) {
 180         my ($lev, $x, $y, $newdist) = @_;
 181         my $xref= $allroutes->{$x};
 182         my $currently= $xref->{$y};
 183         return if defined($currently) and $currently <= $newdist;
 184         distance_set_propagate("${lev}o",$x,$y,$newdist);
 185     }
 186
 187     foreach my $xn (keys %$allroutes) {
 188         my $routes= $allroutes->{$xn};
 189         distance_set_propagate('0', $xn, $xn, 0);
 190         foreach my $yn (keys %$routes) {
 191             distance_set_propagate('0', $yn, $yn, 0);
 192             distance_set_propagate('X', $xn, $yn, $routes->{$yn});
 193             distance_set_propagate('Y', $yn, $xn, $routes->{$yn});
 194         }
 195     }
 196     my $ref;
 197     while ($ref= shift @propqueue) {
 198         distance_propagate_now(@$ref);
 199     }
 200
 201     dbdoall(<<END)
 202  DELETE FROM dists;
 203 END
 204     ;
 205     my $sth= $dbh->prepare(<<'END')
 206  INSERT INTO dists VALUES
 207         ((SELECT islandid FROM islands WHERE islandname == ?),
 208          (SELECT islandid FROM islands WHERE islandname == ?),
 209          ?);
 210 END
 211     ;
 212     foreach my $xn (keys %$allroutes) {
 213         my $routes= $allroutes->{$xn};
 214         foreach my $yn (keys %$routes) {
 215             $sth->execute($xn, $yn, $routes->{$yn});
 216         }
 217     }
 218     $dbh->commit();
 219
 220     # 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;
 221 }
 222
 223 __DATA__