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 #---------- setup ----------
  49
  50 parse_info_serverside();
  51
  52 db_setocean($oceanname);
  53 db_writer();
  54 db_connect();
  55
  56 $dbh->trace(1) if $trace;
  57
  58 #---------- referential integrity constraints ----------
  59
  60 # SQLite doesn't support foreign key constraints so we do it by steam:
  61
  62 sub nooutput ($) {
  63     my ($stmts) = @_;
  64     my $ekindcount= 0;
  65     my $letxt= '';
  66     foreach my $stmt (split /\;/, $stmts) {
  67         next unless $stmt =~ /\S/;
  68
  69         my $etxt= '';
  70         $stmt =~ s/^([ \t]*\#.*)$/ $etxt .= $1."\n"; ''; /mge;
  71         $etxt= $letxt unless length $etxt;
  72         $letxt= $etxt;
  73
  74         $stmt =~ s/^\s+//; $stmt =~ s/\s+$//;
  75         my $sth= $dbh->prepare($stmt);
  76         $sth->execute();
  77         my $row;
  78         my $ecount= 0;
  79         my @cols= @{ $sth->{NAME_lc} };
  80         my $w= 11;
  81         while ($row= $sth->fetchrow_hashref) {
  82             if (!$ecount++) {
  83                 print STDERR "REFERENTIAL INTEGRITY ERROR\n";
  84                 print STDERR "\n$etxt\n $stmt\n\n";
  85                 printf STDERR "|%-${w}s", $_ foreach @cols; print STDERR "|\n";
  86                 print STDERR "+",('-'x$w)  foreach @cols; print STDERR "+\n";
  87             }
  88             if ($ecount>5) { print STDERR "...\n"; last; }
  89             printf STDERR "|%-$w.${w}s",
  90                 (defined $row->{$_} ? $row->{$_} : 'NULL')
  91                     foreach @cols;
  92             print STDERR "\n";
  93         }
  94         next unless $ecount;
  95
  96         $ekindcount++;
  97         print STDERR "\n\n";
  98     }
  99     die "REFERENTIAL INTEGRITY ERRORS $ekindcount\n"
 100         if $ekindcount;
 101 }
 102
 103 sub check_referential_integrity () {
 104     foreach my $bs (qw(buy sell)) {
 105         nooutput(<<END);
 106
 107  # Every buy/sell must refer to an entry in commods, islands, and stalls:
 108  SELECT * FROM $bs NATURAL LEFT JOIN commods WHERE commodname IS NULL;
 109  SELECT * FROM $bs NATURAL LEFT JOIN islands WHERE islandname IS NULL;
 110  SELECT * FROM $bs LEFT JOIN STALLS USING (stallid) WHERE stallname IS NULL;
 111
 112  # Every buy/sell must be part of an upload:
 113  SELECT * FROM $bs NATURAL LEFT JOIN uploads WHERE timestamp IS NULL;
 114
 115  # The islandid in stalls must be the same as the islandid in buy/sell:
 116  SELECT * FROM $bs JOIN stalls USING (stallid)
 117         WHERE $bs.islandid != stalls.islandid;
 118
 119 END
 120     }
 121     foreach my $end (qw(aiid biid)) {
 122         foreach my $tab (qw(dists routes)) {
 123             nooutput(<<END);
 124
 125  # Every row in dists and routes must refer to two existing rows in islands:
 126  SELECT * FROM $tab d LEFT JOIN islands ON (d.$end=islandid)
 127         WHERE islandname IS NULL;
 128
 129 END
 130         }
 131     }
 132     nooutput(<<END);
 133
 134  # Every pair of islands must have an entry in dists:
 135  SELECT * FROM islands ia JOIN islands ib LEFT JOIN dists
 136         ON (ia.islandid=aiid and ib.islandid=biid)
 137         WHERE dist IS NULL;
 138
 139  # Every stall and upload must refer to an island:
 140  SELECT * FROM stalls NATURAL LEFT JOIN islands WHERE islandname IS NULL;
 141  SELECT * FROM uploads NATURAL LEFT JOIN islands WHERE islandname IS NULL;
 142
 143  # Every commod which refers to a commodclass refers to an existing one:
 144  SELECT * FROM commods WHERE commodclass NOT IN
 145         (SELECT commodclass FROM commodclasses);
 146
 147  # There are no empty commodclasses:
 148  SELECT * FROM commodclasses NATURAL LEFT JOIN commods
 149         WHERE commodname IS NULL;
 150
 151  # Ordvals which are not zero are unique:
 152  SELECT ordval,count(*) FROM COMMODS
 153         WHERE ordval IS NOT NULL AND ordval != 0
 154         GROUP BY ordval
 155         HAVING count(*) > 1;
 156
 157 END
 158 }
 159
 160 sub chkcommit () {
 161     check_referential_integrity();
 162     $dbh->commit();
 163 }
 164
 165 #---------- schema ----------
 166
 167 foreach my $bs (qw(buy sell)) {
 168     db_doall(<<END)
 169  CREATE TABLE IF NOT EXISTS $bs (
 170         commodid        INTEGER                 NOT NULL,
 171         islandid        INTEGER                 NOT NULL,
 172         stallid         INTEGER                 NOT NULL,
 173         price           INTEGER                 NOT NULL,
 174         qty             INTEGER                 NOT NULL,
 175         PRIMARY KEY (commodid, islandid, stallid)
 176  );
 177  CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
 178  CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
 179 END
 180     ;
 181 }
 182
 183 sub table ($$) {
 184     my ($table,$fields) = @_;
 185     db_doall(" CREATE TABLE IF NOT EXISTS $table (\n$fields );");
 186
 187     my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
 188     $check->execute();
 189     my %have_fields;
 190     $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
 191     $check->finish();
 192
 193     my (@have_fields, @missing_fields);
 194     my $have_field_specs='';
 195
 196     foreach my $fspec (split /,/, $fields) {
 197         next unless $fspec =~ m/\S/;
 198         $fspec =~ m/^\s*(\w+)\s+(\w.*\S)\s*$/ or die "$table $fspec ?";
 199         my ($f,$spec) = ($1,$2);
 200         if ($have_fields{$f}) {
 201             push @have_fields, $f;
 202             $have_field_specs .= ",\n" if length $have_field_specs;
 203             $have_field_specs .= "\t$f\t\t$spec\n";
 204         } else {
 205             push @missing_fields, $f;
 206         }
 207     }
 208
 209     return unless @missing_fields;
 210     print "    Adding missing fields to $table: @missing_fields ...\n";
 211
 212     my $have_fields= join ',', @have_fields;
 213
 214     db_doall(<<END);
 215  CREATE TEMPORARY TABLE aside_$table (
 216 $have_field_specs );
 217  INSERT INTO aside_$table SELECT $have_fields FROM $table;
 218
 219  DROP TABLE $table;
 220  CREATE TABLE $table (
 221 $fields );
 222
 223  INSERT INTO $table ($have_fields) SELECT $have_fields FROM aside_$table;
 224
 225  DROP TABLE aside_$table;
 226 END
 227 }
 228
 229 table('commods', <<END);
 230         commodid        INTEGER PRIMARY KEY     NOT NULL,
 231         commodname      TEXT    UNIQUE          NOT NULL,
 232         unitmass        INTEGER,
 233         unitvolume      INTEGER,
 234         ordval          INTEGER,
 235         commodclass     TEXT,
 236         inclass         INTEGER
 237 END
 238
 239 table('commodclasses', <<END);
 240         commodclass     TEXT    PRIMARY KEY     NOT NULL,
 241         size            INTEGER
 242 END
 243
 244 db_doall(<<END)
 245  CREATE TABLE IF NOT EXISTS islands (
 246         islandid        INTEGER PRIMARY KEY     NOT NULL,
 247         islandname      TEXT    UNIQUE          NOT NULL,
 248         archipelago     TEXT                    NOT NULL
 249  );
 250  CREATE TABLE IF NOT EXISTS stalls (
 251         stallid         INTEGER PRIMARY KEY     NOT NULL,
 252         islandid        INTEGER                 NOT NULL,
 253         stallname       TEXT                    NOT NULL,
 254         UNIQUE (islandid, stallname)
 255  );
 256  CREATE TABLE IF NOT EXISTS uploads (
 257         islandid        INTEGER PRIMARY KEY     NOT NULL,
 258         timestamp       INTEGER                 NOT NULL,
 259         message         TEXT                    NOT NULL,
 260         clientspec      TEXT                    NOT NULL,
 261         serverspec      TEXT                    NOT NULL
 262  );
 263  CREATE TABLE IF NOT EXISTS dists (
 264         aiid            INTEGER                 NOT NULL,
 265         biid            INTEGER                 NOT NULL,
 266         dist            INTEGER                 NOT NULL,
 267         PRIMARY KEY (aiid, biid)
 268  );
 269  CREATE TABLE IF NOT EXISTS routes (
 270         aiid            INTEGER                 NOT NULL,
 271         biid            INTEGER                 NOT NULL,
 272         dist            INTEGER                 NOT NULL,
 273         PRIMARY KEY (aiid, biid)
 274  );
 275  CREATE TABLE IF NOT EXISTS vessels (
 276         name            TEXT                    NOT NULL,
 277         mass            INTEGER                 NOT NULL,
 278         volume          INTEGER                 NOT NULL,
 279         shot            INTEGER                 NOT NULL,
 280         PRIMARY KEY (name)
 281  );
 282 END
 283     ;
 284
 285 chkcommit();
 286
 287 #---------- commodity list ----------
 288
 289 sub commodsortkey ($) {
 290     my ($commod) = @_;
 291     my $ordval= $commods{$commod}{Ordval};
 292     return sprintf "B %20d", $ordval if defined $ordval;
 293     return sprintf "A %s", $commod;
 294 }
 295
 296 {
 297     my $insert= $dbh->prepare(<<'END')
 298  INSERT OR IGNORE INTO commods
 299      (unitmass,
 300       unitvolume,
 301       commodname)
 302      VALUES (?,?,?);
 303 END
 304     ;
 305     my $setsizes= $dbh->prepare(<<'END')
 306  UPDATE commods
 307      SET unitmass = ?,
 308          unitvolume = ?
 309      WHERE commodname = ?
 310 END
 311     ;
 312     my $setordval= $dbh->prepare(<<'END')
 313  UPDATE commods
 314      SET ordval = ?
 315      WHERE commodname = ?
 316 END
 317     ;
 318     my $setclass= $dbh->prepare(<<'END')
 319  UPDATE commods
 320      SET commodclass = ?
 321      WHERE commodname = ?
 322 END
 323     ;
 324     my $setinclass= $dbh->prepare(<<'END')
 325  UPDATE commods
 326      SET inclass = ?
 327      WHERE commodname = ?
 328 END
 329     ;
 330     my %incl;
 331     foreach my $commod (sort {
 332                 commodsortkey($a) cmp commodsortkey($b)
 333             } keys %commods) {
 334         my $c= $commods{$commod};
 335         die "no mass for $commod" unless defined $c->{Mass};
 336         die "no volume for $commod" unless defined $c->{Volume};
 337
 338         my @qa= ($c->{Mass}, $c->{Volume}, $commod);
 339         $insert->execute(@qa);
 340         $setsizes->execute(@qa);
 341         $setordval->execute($c->{Ordval} || 0, $commod);
 342         my $cl= $c->{Class};
 343         $setclass->execute($cl, $commod);
 344
 345         if (defined $c->{Ordval} and defined $cl) {
 346             $incl{$cl}++;
 347             $setinclass->execute($incl{$cl}, $commod);
 348         }
 349     }
 350     db_doall(<<END);
 351  DELETE FROM commodclasses;
 352 END
 353     my $addclass= $dbh->prepare(<<'END')
 354  INSERT INTO commodclasses
 355      (commodclass, size)
 356      VALUES (?,?)
 357 END
 358     ;
 359     foreach my $cl (sort keys %incl) {
 360         $addclass->execute($cl, $incl{$cl});
 361     }
 362     chkcommit();
 363 }
 364
 365 #---------- vessel types ----------
 366 {
 367     my $idempotent= $dbh->prepare(<<'END')
 368  INSERT OR REPLACE INTO vessels (name, shot, mass, volume)
 369                          VALUES (?,?,?,?)
 370 END
 371     ;
 372     foreach my $name (sort keys %vessels) {
 373         my $v= $vessels{$name};
 374         my $shotdamage= $shotname2damage{$v->{Shot}};
 375         die "no shot damage for shot $v->{Shot} for vessel $name"
 376             unless defined $shotdamage;
 377         my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
 378         $idempotent->execute(@qa);
 379     }
 380     chkcommit();
 381 }