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         timestamp       INTEGER                 NOT NULL,
  98         message         TEXT                    NOT NULL,
  99         clientspec      TEXT                    NOT NULL,
 100         serverspec      TEXT                    NOT NULL
 101  );
 102  CREATE TABLE IF NOT EXISTS dists (
 103         aiid            INTEGER                 NOT NULL,
 104         biid            INTEGER                 NOT NULL,
 105         dist            INTEGER                 NOT NULL,
 106         PRIMARY KEY (aiid, biid)
 107  );
 108 END
 109     ;
 110
 111 $dbh->commit;
 112
 113 #---------- commodity list ----------
 114
 115 {
 116     my $sth= $dbh->prepare(<<'END')
 117  INSERT OR IGNORE INTO commods (commodname) VALUES (?);
 118 END
 119     ;
 120     foreach my $commod (sort keys %commods) {
 121         $sth->execute($commod);
 122     }
 123     $dbh->commit;
 124 }
 125
 126 #---------- island list ----------
 127
 128 {
 129     my $sth= $dbh->prepare(<<'END')
 130  INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?);
 131 END
 132     ;
 133     foreach my $archname (sort keys %$ocean) {
 134         my $arch= $ocean->{$archname};
 135         foreach my $islandname (sort keys %$arch) {
 136             $sth->execute($islandname, $archname);
 137         }
 138     }
 139     $dbh->commit;
 140 }
 141
 142 #---------- routes ----------
 143
 144 {
 145     foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) {
 146         warn "$route_mysteries{$oceanname}{$islandname} routes".
 147             " for unknown island $islandname\n";
 148     }
 149
 150     my $allroutes= $routes{$oceanname};
 151
 152     my @propqueue= ();
 153
 154     sub distance_set_propagate ($$$$) {
 155         my ($lev, $start, $upto, $start2upto) = @_;
 156         $allroutes->{$start}{$upto}= $start2upto;
 157         push @propqueue, [ $lev, $start, $upto ];
 158     }
 159
 160     sub distance_propagate_now {
 161         my ($lev, $start, $upto) = @_;
 162         my $startref= $allroutes->{$start};
 163         my $start2upto= $startref->{$upto};
 164         my $uptoref=  $allroutes->{$upto};
 165
 166         for my $next (keys %$uptoref) {
 167             next if $next eq $upto;
 168             my $unext= $uptoref->{$next};
 169             next unless defined $unext;
 170             distance_update("${lev}p", $start, $next, $start2upto + $unext);
 171         }
 172     }
 173
 174     sub distance_update ($$$$) {
 175         my ($lev, $x, $y, $newdist) = @_;
 176         distance_update_one("${lev}x",$x,$y,$newdist);
 177         distance_update_one("${lev}y",$y,$x,$newdist);
 178     }
 179
 180     sub distance_update_one ($$$$) {
 181         my ($lev, $x, $y, $newdist) = @_;
 182         my $xref= $allroutes->{$x};
 183         my $currently= $xref->{$y};
 184         return if defined($currently) and $currently <= $newdist;
 185         distance_set_propagate("${lev}o",$x,$y,$newdist);
 186     }
 187
 188     foreach my $xn (keys %$allroutes) {
 189         my $routes= $allroutes->{$xn};
 190         distance_set_propagate('0', $xn, $xn, 0);
 191         foreach my $yn (keys %$routes) {
 192             distance_set_propagate('0', $yn, $yn, 0);
 193             distance_set_propagate('X', $xn, $yn, $routes->{$yn});
 194             distance_set_propagate('Y', $yn, $xn, $routes->{$yn});
 195         }
 196     }
 197     my $ref;
 198     while ($ref= shift @propqueue) {
 199         distance_propagate_now(@$ref);
 200     }
 201
 202     dbdoall(<<END)
 203  DELETE FROM dists;
 204 END
 205     ;
 206     my $sth= $dbh->prepare(<<'END')
 207  INSERT INTO dists VALUES
 208         ((SELECT islandid FROM islands WHERE islandname == ?),
 209          (SELECT islandid FROM islands WHERE islandname == ?),
 210          ?);
 211 END
 212     ;
 213     foreach my $xn (keys %$allroutes) {
 214         my $routes= $allroutes->{$xn};
 215         foreach my $yn (keys %$routes) {
 216             $sth->execute($xn, $yn, $routes->{$yn});
 217         }
 218     }
 219     $dbh->commit();
 220
 221     # 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;
 222 }
 223
 224 __DATA__