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