yarrg/db-idempotent-populate

   1 #!/usr/bin/perl -w
   2 #
   3 # Normally run from
   4 #  update-master-info
   5 #
   6 # usage: ./db-idempotent-populate <Oceanname>
   7 #  creates or updates OCEAN-Oceanname.db
   8 #  from source-info.txt
   9
  10 # This is part of the YARRG website.  YARRG is a tool and website
  11 # for assisting players of Yohoho Puzzle Pirates.
  12 #
  13 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
  14 #
  15 # This program is free software: you can redistribute it and/or modify
  16 # it under the terms of the GNU Affero General Public License as
  17 # published by the Free Software Foundation, either version 3 of the
  18 # License, or (at your option) any later version.
  19 #
  20 # This program is distributed in the hope that it will be useful,
  21 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 # GNU Affero General Public License for more details.
  24 #
  25 # You should have received a copy of the GNU Affero General Public License
  26 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  27 #
  28 # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
  29 # are used without permission.  This program is not endorsed or
  30 # sponsored by Three Rings.
  31
  32 use strict (qw(vars));
  33
  34 use DBI;
  35
  36 use Commods;
  37 use CommodsDatabase;
  38
  39 my $trace;
  40 if (@ARGV and $ARGV[0] eq '-D') {
  41         $trace=1;
  42         shift @ARGV;
  43 }
  44
  45 @ARGV==1 or die;
  46 my ($oceanname) = @ARGV;
  47
  48
  49 #---------- setup ----------
  50
  51 parse_info_serverside();
  52
  53 db_setocean($oceanname);
  54 db_writer();
  55 db_connect();
  56
  57 $dbh->trace(1) if $trace;
  58
  59
  60 #---------- schema update code ----------
  61
  62 our @need_compact;
  63
  64 sub table ($$) {
  65     my ($table, $fields) = @_;
  66     table_maycompact($table,undef,undef,$fields);
  67 }
  68
  69 sub table_maycompact ($$$$) {
  70     my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_;
  71
  72     #----- parse $fields -----
  73
  74     my @want_fields;
  75     my @want_field_specs;
  76     my %want_field_specs;
  77
  78     foreach my $fspec (split /\n/, $fields) {
  79         next unless $fspec =~ m/\S/;
  80         if ($fspec =~ m/^\s*\+/) {
  81             push @want_field_specs, "\t".$';
  82             next;
  83         } elsif ($fspec =~ m/^\s*(\w+)(\s+)(\w.*\S)\s*$/) {
  84             my ($f,$spaces,$rhs) = ($1,$2,$3);
  85             my $spec= "\t".$f.$spaces.$rhs;
  86             push @want_fields, $f;
  87             push @want_field_specs, $spec;
  88             $want_field_specs{$f}= $spec;
  89         } else {
  90             die "$table $fspec ?";
  91         }
  92     }
  93
  94     my $want_field_specs= join ",\n", @want_field_specs;
  95
  96     #----- ensure table exists -----
  97
  98     db_doall(<<END);
  99  CREATE TABLE IF NOT EXISTS $table (
 100 $want_field_specs
 101         );
 102 END
 103     my @need_recreate;
 104
 105     #----- check whether we need to remove autoinc -----
 106
 107     if ($fields !~ /\bautoinc/i) {
 108         my $autoinc= $dbh->prepare(<<END);
 109  SELECT sql FROM sqlite_master
 110         WHERE type='table' and name=? and tbl_name=?
 111 END
 112         $autoinc->execute($table,$table);
 113         my ($sql)= $autoinc->fetchrow_array();
 114         die unless defined $sql;
 115         push @need_recreate, 'remove autoinc'
 116             if $sql =~ m/\bautoinc/i;
 117     }
 118
 119     #----- check whether we need to add fields -----
 120
 121     my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
 122     $check->execute();
 123     my %have_fields;
 124     $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
 125     $check->finish();
 126
 127     my @have_fields;
 128     my @have_field_specs;
 129
 130     foreach my $f (@want_fields) {
 131         if ($have_fields{$f}) {
 132             push @have_fields, $f;
 133             push @have_field_specs, $want_field_specs{$f};
 134         } else {
 135             push @need_recreate, "field $f";
 136         }
 137     }
 138
 139     #----- Do we need to recreate ? -----
 140     return unless @need_recreate;
 141     # yes:
 142
 143     print "    Recreating $table:\n";
 144     print "        $_\n" foreach @need_recreate;
 145
 146     my $have_fields= join ',', @have_fields;
 147     my $have_field_specs= join ",\n", @have_field_specs;
 148
 149     db_doall(<<END);
 150  CREATE TEMPORARY TABLE aside_$table (
 151 $have_field_specs
 152         );
 153  INSERT INTO aside_$table SELECT $have_fields FROM $table;
 154
 155  DROP TABLE $table;
 156  CREATE TABLE $table (
 157 $want_field_specs
 158         );
 159
 160  INSERT INTO $table ($have_fields) SELECT $have_fields FROM aside_$table;
 161
 162  DROP TABLE aside_$table;
 163 END
 164
 165     #----- Do we need to compact ids ? -----
 166     return unless
 167         defined $cpact_idfield
 168         and grep { m/^remove autoinc/ } @need_recreate;
 169     # yes:
 170
 171     print "        will compact\n";
 172     unshift @$cpact_needupdates, [ $table ], [ $cpact_idfield ];
 173
 174     push @need_compact, {
 175         Table => $table,
 176         Id => $cpact_idfield,
 177         Updates => $cpact_needupdates,
 178         Fields => [ @want_fields ],
 179         FieldSpecs => $want_field_specs
 180         };
 181 }
 182
 183
 184 #---------- actual schema ----------
 185
 186 foreach my $bs (qw(buy sell)) {
 187     db_doall(<<END)
 188  CREATE TABLE IF NOT EXISTS $bs (
 189         commodid        INTEGER                 NOT NULL,
 190         islandid        INTEGER                 NOT NULL,
 191         stallid         INTEGER                 NOT NULL,
 192         price           INTEGER                 NOT NULL,
 193         qty             INTEGER                 NOT NULL,
 194         PRIMARY KEY (commodid, islandid, stallid)
 195  );
 196  CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
 197  CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
 198 END
 199     ;
 200 }
 201
 202 table_maycompact('commods', 'commodid',
 203                  [ [ qw(buy sell) ], [ qw(commodid) ],
 204  ], <<END);
 205         commodid        INTEGER PRIMARY KEY     NOT NULL
 206         commodname      TEXT    UNIQUE          NOT NULL
 207         unitmass        INTEGER
 208         unitvolume      INTEGER
 209         ordval          INTEGER
 210         commodclass     TEXT
 211         inclass         INTEGER
 212 END
 213
 214 table_maycompact('islands', 'islandid',
 215                  [ [ qw(buy sell stalls uploads) ], [ qw(islandid) ],
 216                    [ qw(dists routes) ], [ qw(aiid biid) ],
 217  ], <<END);
 218         islandid        INTEGER PRIMARY KEY     NOT NULL
 219         islandname      TEXT    UNIQUE          NOT NULL
 220         archipelago     TEXT                    NOT NULL
 221 END
 222
 223 table('stalls', <<END);
 224         stallid         INTEGER PRIMARY KEY     NOT NULL
 225         islandid        INTEGER                 NOT NULL
 226         stallname       TEXT                    NOT NULL
 227         + UNIQUE (islandid, stallname)
 228 END
 229
 230 table('commodclasses', <<END);
 231         commodclass     TEXT    PRIMARY KEY     NOT NULL
 232         size            INTEGER
 233 END
 234
 235 db_doall(<<END)
 236  CREATE TABLE IF NOT EXISTS uploads (
 237         islandid        INTEGER PRIMARY KEY     NOT NULL,
 238         timestamp       INTEGER                 NOT NULL,
 239         message         TEXT                    NOT NULL,
 240         clientspec      TEXT                    NOT NULL,
 241         serverspec      TEXT                    NOT NULL
 242  );
 243  CREATE TABLE IF NOT EXISTS dists (
 244         aiid            INTEGER                 NOT NULL,
 245         biid            INTEGER                 NOT NULL,
 246         dist            INTEGER                 NOT NULL,
 247         PRIMARY KEY (aiid, biid)
 248  );
 249  CREATE TABLE IF NOT EXISTS routes (
 250         aiid            INTEGER                 NOT NULL,
 251         biid            INTEGER                 NOT NULL,
 252         dist            INTEGER                 NOT NULL,
 253         PRIMARY KEY (aiid, biid)
 254  );
 255  CREATE TABLE IF NOT EXISTS vessels (
 256         name            TEXT                    NOT NULL,
 257         mass            INTEGER                 NOT NULL,
 258         volume          INTEGER                 NOT NULL,
 259         shot            INTEGER                 NOT NULL,
 260         PRIMARY KEY (name)
 261  );
 262 END
 263     ;
 264
 265
 266 #---------- commodity list ----------
 267
 268 sub commodsortkey ($) {
 269     my ($commod) = @_;
 270     my $ordval= $commods{$commod}{Ordval};
 271     return sprintf "B %20d", $ordval if defined $ordval;
 272     return sprintf "A %s", $commod;
 273 }
 274
 275 {
 276     my $insert= $dbh->prepare(<<'END')
 277  INSERT OR IGNORE INTO commods
 278      (unitmass,
 279       unitvolume,
 280       commodname)
 281      VALUES (?,?,?);
 282 END
 283     ;
 284     my $setsizes= $dbh->prepare(<<'END')
 285  UPDATE commods
 286      SET unitmass = ?,
 287          unitvolume = ?
 288      WHERE commodname = ?
 289 END
 290     ;
 291     my $setordval= $dbh->prepare(<<'END')
 292  UPDATE commods
 293      SET ordval = ?
 294      WHERE commodname = ?
 295 END
 296     ;
 297     my $setclass= $dbh->prepare(<<'END')
 298  UPDATE commods
 299      SET commodclass = ?
 300      WHERE commodname = ?
 301 END
 302     ;
 303     my $setinclass= $dbh->prepare(<<'END')
 304  UPDATE commods
 305      SET inclass = ?
 306      WHERE commodname = ?
 307 END
 308     ;
 309     my %incl;
 310     foreach my $commod (sort {
 311                 commodsortkey($a) cmp commodsortkey($b)
 312             } keys %commods) {
 313         my $c= $commods{$commod};
 314         die "no mass for $commod" unless defined $c->{Mass};
 315         die "no volume for $commod" unless defined $c->{Volume};
 316
 317         my @qa= ($c->{Mass}, $c->{Volume}, $commod);
 318         $insert->execute(@qa);
 319         $setsizes->execute(@qa);
 320         $setordval->execute($c->{Ordval} || 0, $commod);
 321         my $cl= $c->{Class};
 322         $setclass->execute($cl, $commod);
 323
 324         if (defined $c->{Ordval} and defined $cl) {
 325             $incl{$cl}++;
 326             $setinclass->execute($incl{$cl}, $commod);
 327         } elsif (defined $cl) {
 328             $incl{$cl} += 0;
 329         }
 330     }
 331     db_doall(<<END);
 332  DELETE FROM commodclasses;
 333 END
 334     my $addclass= $dbh->prepare(<<'END')
 335  INSERT INTO commodclasses
 336      (commodclass, size)
 337      VALUES (?,?)
 338 END
 339     ;
 340     foreach my $cl (sort keys %incl) {
 341         $addclass->execute($cl, $incl{$cl});
 342     }
 343 }
 344
 345
 346 #---------- vessel types ----------
 347 {
 348     my $idempotent= $dbh->prepare(<<'END')
 349  INSERT OR REPLACE INTO vessels (name, shot, mass, volume)
 350                          VALUES (?,?,?,?)
 351 END
 352     ;
 353     foreach my $name (sort keys %vessels) {
 354         my $v= $vessels{$name};
 355         my $shotdamage= $shotname2damage{$v->{Shot}};
 356         die "no shot damage for shot $v->{Shot} for vessel $name"
 357             unless defined $shotdamage;
 358         my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
 359         $idempotent->execute(@qa);
 360     }
 361 }
 362
 363
 364 #---------- put it all into effect ----------
 365 db_chkcommit();
 366 {
 367     local $dbh->{AutoCommit} = 1;
 368     print "    Vacuuming.\n";
 369     $dbh->do('VACUUM');
 370 }