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