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 $|=1;
  49
  50 #---------- setup ----------
  51
  52 parse_info_serverside();
  53
  54 db_setocean($oceanname);
  55 db_writer();
  56 db_connect();
  57
  58 $dbh->trace(1) if $trace;
  59
  60
  61 #---------- schema update code ----------
  62
  63 our @need_compact;
  64
  65 sub table ($$) {
  66     my ($table, $fields) = @_;
  67     table_maycompact($table,undef,undef,$fields);
  68 }
  69
  70 sub table_maycompact ($$$$) {
  71     my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_;
  72
  73     #----- parse $fields -----
  74
  75     my @want_fields;
  76     my @want_field_specs;
  77     my %want_field_specs;
  78
  79     foreach my $fspec (split /\n/, $fields) {
  80         next unless $fspec =~ m/\S/;
  81         if ($fspec =~ m/^\s*\+/) {
  82             push @want_field_specs, "\t".$';
  83             next;
  84         } elsif ($fspec =~ m/^\s*(\w+)(\s+)(\w.*\S)\s*$/) {
  85             my ($f,$spaces,$rhs) = ($1,$2,$3);
  86             my $spec= "\t".$f.$spaces.$rhs;
  87             push @want_fields, $f;
  88             push @want_field_specs, $spec;
  89             $want_field_specs{$f}= $spec;
  90         } else {
  91             die "$table $fspec ?";
  92         }
  93     }
  94
  95     my $want_field_specs= join ",\n", @want_field_specs;
  96
  97     #----- ensure table exists -----
  98
  99     db_doall(<<END);
 100  CREATE TABLE IF NOT EXISTS $table (
 101 $want_field_specs
 102         );
 103 END
 104     my @need_recreate;
 105
 106     #----- check whether we need to remove autoinc -----
 107
 108     if ($fields !~ /\bautoinc/i) {
 109         my $autoinc= $dbh->prepare(<<END);
 110  SELECT sql FROM sqlite_master
 111         WHERE type='table' and name=? and tbl_name=?
 112 END
 113         $autoinc->execute($table,$table);
 114         my ($sql)= $autoinc->fetchrow_array();
 115         die unless defined $sql;
 116         push @need_recreate, 'remove autoinc'
 117             if $sql =~ m/\bautoinc/i;
 118     }
 119
 120     #----- check whether we need to add fields -----
 121
 122     my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
 123     $check->execute();
 124     my %have_fields;
 125     $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
 126     $check->finish();
 127
 128     my @have_fields;
 129     my @have_field_specs;
 130
 131     foreach my $f (@want_fields) {
 132         if ($have_fields{$f}) {
 133             push @have_fields, $f;
 134             push @have_field_specs, $want_field_specs{$f};
 135         } else {
 136             push @need_recreate, "field $f";
 137         }
 138     }
 139
 140     #----- Do we need to recreate ? -----
 141     return unless @need_recreate;
 142     # yes:
 143
 144     print "    Recreating $table: ", join('; ',@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     (print("\n"), 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     my $setsizes= $dbh->prepare(<<'END');
 284  UPDATE commods
 285      SET unitmass = ?,
 286          unitvolume = ?
 287      WHERE commodname = ?
 288 END
 289     my $setordval= $dbh->prepare(<<'END');
 290  UPDATE commods
 291      SET ordval = ?
 292      WHERE commodname = ?
 293 END
 294     my $setclass= $dbh->prepare(<<'END');
 295  UPDATE commods
 296      SET commodclass = ?
 297      WHERE commodname = ?
 298 END
 299     my $setinclass= $dbh->prepare(<<'END');
 300  UPDATE commods
 301      SET inclass = ?
 302      WHERE commodname = ?
 303 END
 304     my %incl;
 305     foreach my $commod (sort {
 306                 commodsortkey($a) cmp commodsortkey($b)
 307             } keys %commods) {
 308         my $c= $commods{$commod};
 309         die "no mass for $commod" unless defined $c->{Mass};
 310         die "no volume for $commod" unless defined $c->{Volume};
 311
 312         my @qa= ($c->{Mass}, $c->{Volume}, $commod);
 313         $insert->execute(@qa);
 314         $setsizes->execute(@qa);
 315         $setordval->execute($c->{Ordval} || 0, $commod);
 316         my $cl= $c->{Class};
 317         $setclass->execute($cl, $commod);
 318
 319         if (defined $c->{Ordval} and defined $cl) {
 320             $incl{$cl}++;
 321             $setinclass->execute($incl{$cl}, $commod);
 322         } elsif (defined $cl) {
 323             $incl{$cl} += 0;
 324         }
 325     }
 326     db_doall(<<END);
 327  DELETE FROM commodclasses;
 328 END
 329     my $addclass= $dbh->prepare(<<'END');
 330  INSERT INTO commodclasses
 331      (commodclass, size)
 332      VALUES (?,?)
 333 END
 334     foreach my $cl (sort keys %incl) {
 335         $addclass->execute($cl, $incl{$cl});
 336     }
 337
 338     my $search= $dbh->prepare(<<'END');
 339  SELECT commodname,commodid FROM commods;
 340 END
 341     my %check;
 342     foreach my $bs (qw(buy sell)) {
 343         $check{$bs}= $dbh->prepare(<<END);
 344  SELECT islandname,stallname,price,qty
 345    FROM $bs
 346    JOIN stalls USING (stallid)
 347    JOIN islands ON ($bs.islandid = islands.islandid)
 348    WHERE commodid = ? LIMIT 1
 349 END
 350     }
 351     my $delete= $dbh->prepare(<<'END');
 352  DELETE FROM commods WHERE commodid = ?
 353 END
 354     $search->execute();
 355     my $any=0;
 356     while (my $row= $search->fetchrow_hashref()) {
 357         next if defined $commods{$row->{'commodname'}};
 358         print $any++ ? '; ' : "    Dropping old commodities: ",
 359               $row->{'commodname'};
 360         foreach my $bs (qw(buy sell)) {
 361             $check{$bs}->execute($row->{'commodid'});
 362             my $problem= $check{$bs}->fetchrow_hashref();
 363             if ($problem) {
 364                 print "\n";
 365                 die <<END
 366
 367 FATAL ERROR
 368     Removed commodity
 369        $row->{'commodid'}
 370        $row->{'commodname'}
 371     but
 372        $bs
 373        $problem->{'islandname'}
 374        $problem->{'stallname'}
 375        $problem->{'qty'} at $problem->{'price'}
 376 END
 377             }
 378         }
 379         $delete->execute($row->{'commodid'});
 380     }
 381     print ".\n" if $any;
 382     db_check_referential_integrity();
 383 }
 384
 385
 386 #---------- vessel types ----------
 387 {
 388     my $idempotent= $dbh->prepare(<<'END')
 389  INSERT OR REPLACE INTO vessels (name, shot, mass, volume)
 390                          VALUES (?,?,?,?)
 391 END
 392     ;
 393     foreach my $name (sort keys %vessels) {
 394         my $v= $vessels{$name};
 395         my $shotdamage= $shotname2damage{$v->{Shot}};
 396         die "no shot damage for shot $v->{Shot} for vessel $name"
 397             unless defined $shotdamage;
 398         my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
 399         $idempotent->execute(@qa);
 400     }
 401 }
 402
 403
 404 #---------- compact IDs ----------
 405
 406 sub getminmax ($$$) {
 407     my ($tab,$minmax,$f) = @_;
 408     my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab");
 409     $sth->execute();
 410     my ($val)= $sth->fetchrow_array();
 411     return defined($val) ? $val : '?';
 412 }
 413
 414 foreach my $cp (@need_compact) {
 415     print "    Compacting $cp->{Table}";
 416     my $tab= $cp->{Table};
 417     my $id= $cp->{Id};
 418     my $tmp_field_specs= $cp->{FieldSpecs};
 419     my $fields= join ',', @{$cp->{Fields}};
 420     $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
 421         die "$tab $tmp_field_specs ?";
 422     db_doall(<<END);
 423  CREATE TABLE aside_$tab (
 424         new_$id         INTEGER PRIMARY KEY NOT NULL,
 425 $tmp_field_specs
 426  );
 427  INSERT INTO aside_$tab ($fields)
 428         SELECT $fields
 429         FROM $tab;
 430 END
 431     my $oldmax= getminmax($tab,'max',$id);
 432     my $offset= $oldmax+1;
 433
 434     printf(" %s %s..%d=>1..%d:",
 435            $cp->{Id},
 436            getminmax($tab,'min',$id),
 437            $oldmax,
 438            getminmax("aside_$tab",'max',"new_$id"));
 439     my @updates= @{ $cp->{Updates} };
 440     while (@updates) {
 441         my $utabs= shift @updates;
 442         my $ufields= shift @updates;
 443         foreach my $utab (@$utabs) {
 444             printf(" %s",$utab);
 445             my $fh= '.';
 446             foreach my $ufield (@$ufields) {
 447                 printf("%s%s",$fh,$ufield); $fh=',';
 448                 db_doall(<<END);
 449  UPDATE $utab
 450     SET $ufield = $offset +
 451         (SELECT new_$id FROM aside_$tab
 452           WHERE aside_$tab.$id = $utab.$ufield);
 453  UPDATE $utab
 454     SET $ufield = $ufield - $offset;
 455 END
 456             }
 457         }
 458     }
 459     print "\n";
 460 }
 461
 462 #---------- put it all into effect ----------
 463
 464 db_chkcommit();
 465
 466 {
 467     local $dbh->{AutoCommit} = 1;
 468     $dbh->do('VACUUM');
 469 }