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=0;
  40 while (@ARGV and $ARGV[0] eq '-D') {
  41         $trace++;
  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 our @need_transfer_back;
  65
  66 our %table;
  67
  68 sub table ($$) {
  69     my ($table, $fields) = @_;
  70     table_maycompact($table,undef,undef,$fields);
  71 }
  72
  73 sub table_maycompact ($$$$) {
  74     my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_;
  75
  76     #----- parse $fields -----
  77
  78     my @want_fields;
  79     my @want_field_specs;
  80     my %want_field_specs;
  81
  82     foreach my $fspec (split /\n/, $fields) {
  83         next unless $fspec =~ m/\S/;
  84         if ($fspec =~ m/^\s*\+/) {
  85             push @want_field_specs, "\t".$';
  86             next;
  87         } elsif ($fspec =~ m/^\s*(\w+)(\s+)(\w.*\S)\s*$/) {
  88             my ($f,$spaces,$rhs) = ($1,$2,$3);
  89             my $spec= "\t".$f.$spaces.$rhs;
  90             push @want_fields, $f;
  91             push @want_field_specs, $spec;
  92             $want_field_specs{$f}= $spec;
  93         } else {
  94             die "$table $fspec ?";
  95         }
  96     }
  97
  98     my $want_field_specs= join ",\n", @want_field_specs;
  99
 100     #----- ensure table exists -----
 101
 102     db_doall(<<END);
 103  CREATE TABLE IF NOT EXISTS $table (
 104 $want_field_specs
 105         );
 106 END
 107     my @need_recreate;
 108
 109     #----- check whether we need to remove autoinc -----
 110
 111     if ($fields !~ /\bautoinc/i) {
 112         my $autoinc= $dbh->prepare(<<END);
 113  SELECT sql FROM sqlite_master
 114         WHERE type='table' and name=? and tbl_name=?
 115 END
 116         $autoinc->execute($table,$table);
 117         my ($sql)= $autoinc->fetchrow_array();
 118         die unless defined $sql;
 119         push @need_recreate, 'remove autoinc'
 120             if $sql =~ m/\bautoinc/i;
 121     }
 122
 123     #----- check whether we need to add fields -----
 124
 125     my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
 126     $check->execute();
 127     my %have_fields;
 128     $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
 129     $check->finish();
 130
 131     my @have_fields;
 132     my @aside_fields;
 133     my @have_field_specs;
 134     my @aside_field_specs;
 135
 136     foreach my $f (@want_fields) {
 137         if ($have_fields{$f}) {
 138             push @have_fields, $f;
 139             push @have_field_specs, $want_field_specs{$f};
 140         } else {
 141             my $aside= $want_field_specs{$f};
 142             $aside =~ s/\bUNIQUE\b//i;
 143             $aside =~ s/\bNOT\s*NULL\b//i;
 144             $aside =~ s/\bPRIMARY\s*KEY\b//i;
 145             $aside =~ s/\s+$//;
 146             push @aside_fields, $f;
 147             push @aside_field_specs, $aside;
 148             push @need_recreate, "field $f";
 149         }
 150     }
 151
 152     #----- Do we need to recreate ? -----
 153     if (!@need_recreate) {
 154         $table{$table}= $table;
 155         return;
 156     }
 157     #----- Yes, recreate: -----
 158
 159     print "    Recreating $table: ", join('; ',@need_recreate);
 160     $table{$table}= "aside_$table";
 161
 162     my $have_fields= join ',', @have_fields;
 163     my $aside_fields= join ',', @have_fields, @aside_fields;
 164     my $have_field_specs= join ",\n", @have_field_specs;
 165     my $aside_field_specs= join ",\n", @have_field_specs, @aside_field_specs;
 166
 167     db_doall(<<END);
 168  CREATE TEMPORARY TABLE aside_$table (
 169 $aside_field_specs
 170         );
 171  INSERT INTO aside_$table ($have_fields)
 172         SELECT $have_fields FROM $table;
 173
 174  DROP TABLE $table;
 175 END
 176
 177     push @need_transfer_back, {
 178         Table => $table,
 179         Sql => <<END
 180  CREATE TABLE $table (
 181 $want_field_specs
 182         );
 183
 184  INSERT INTO $table ($aside_fields) SELECT $aside_fields FROM aside_$table;
 185
 186  DROP TABLE aside_$table;
 187 END
 188     };
 189
 190     #----- Do we need to compact ids ? -----
 191     (print(".\n"), return) unless
 192         defined $cpact_idfield
 193         and grep { m/^remove autoinc/ } @need_recreate;
 194     # yes:
 195
 196     print "; will compact.\n";
 197     unshift @$cpact_needupdates, [ $table ], [ $cpact_idfield ];
 198
 199     push @need_compact, {
 200         Table => $table,
 201         Id => $cpact_idfield,
 202         Updates => $cpact_needupdates,
 203         Fields => [ @want_fields ],
 204         FieldSpecs => $want_field_specs
 205         };
 206 }
 207
 208
 209 #---------- actual schema ----------
 210
 211 foreach my $bs (qw(buy sell)) {
 212     table($bs,<<END);
 213         commodid        INTEGER                 NOT NULL
 214         islandid        INTEGER                 NOT NULL
 215         stallid         INTEGER                 NOT NULL
 216         price           INTEGER                 NOT NULL
 217         qty             INTEGER                 NOT NULL
 218         + PRIMARY KEY (commodid, islandid, stallid)
 219 END
 220 }
 221
 222 table_maycompact('commods', 'commodid',
 223                  [ [ qw(buy sell) ], [ qw(commodid) ],
 224  ], <<END);
 225         commodid        INTEGER PRIMARY KEY     NOT NULL
 226         commodname      TEXT    UNIQUE          NOT NULL
 227         unitmass        INTEGER
 228         unitvolume      INTEGER
 229         commodclassid   INTEGER                 NOT NULL
 230         ordval          INTEGER                 NOT NULL
 231         posinclass      INTEGER                 NOT NULL
 232         flags           TEXT                    NOT NULL
 233 END
 234
 235 table_maycompact('islands', 'islandid',
 236                  [ [ qw(buy sell stalls uploads) ], [ qw(islandid) ],
 237                    [ qw(dists routes) ], [ qw(aiid biid) ],
 238  ], <<END);
 239         islandid        INTEGER PRIMARY KEY     NOT NULL
 240         islandname      TEXT    UNIQUE          NOT NULL
 241         archipelago     TEXT                    NOT NULL
 242 END
 243
 244 table('stalls', <<END);
 245         stallid         INTEGER PRIMARY KEY     NOT NULL
 246         islandid        INTEGER                 NOT NULL
 247         stallname       TEXT                    NOT NULL
 248         + UNIQUE (islandid, stallname)
 249 END
 250
 251 table('commodclasses', <<END);
 252         commodclassid   INTEGER PRIMARY KEY     NOT NULL
 253         commodclass     TEXT    UNIQUE          NOT NULL
 254         maxposinclass   INTEGER                 NOT NULL
 255 END
 256
 257 table('uploads', <<END);
 258         islandid        INTEGER PRIMARY KEY     NOT NULL
 259         timestamp       INTEGER                 NOT NULL
 260         message         TEXT                    NOT NULL
 261         clientspec      TEXT                    NOT NULL
 262         serverspec      TEXT                    NOT NULL
 263 END
 264
 265 table('dists', <<END);
 266         aiid            INTEGER                 NOT NULL
 267         biid            INTEGER                 NOT NULL
 268         dist            INTEGER                 NOT NULL
 269         + PRIMARY KEY (aiid, biid)
 270 END
 271
 272 table('routes', <<END);
 273         aiid            INTEGER                 NOT NULL
 274         biid            INTEGER                 NOT NULL
 275         dist            INTEGER                 NOT NULL
 276         + PRIMARY KEY (aiid, biid)
 277 END
 278
 279 table('vessels', <<END);
 280         name            TEXT                    NOT NULL
 281         mass            INTEGER                 NOT NULL
 282         volume          INTEGER                 NOT NULL
 283         shot            INTEGER                 NOT NULL
 284         + PRIMARY KEY (name)
 285 END
 286
 287
 288 #---------- commodity list ----------
 289
 290 sub commodsortkey ($) {
 291     my ($commod) = @_;
 292     return $commods{$commod}{Ordval} ||
 293            $commods{$commod}{ClassOrdval};
 294 }
 295 sub commods_ordered () {
 296     sort {
 297         commodsortkey($a) <=> commodsortkey($b);
 298     } keys %commods;
 299 }
 300
 301 our %posincl;
 302
 303 {
 304     my %classorderedcount;
 305
 306     foreach my $cl (keys %commodclasses) {
 307         $classorderedcount{$cl}= 0;
 308     }
 309     foreach my $commod (commods_ordered()) {
 310         my $cl= $commods{$commod}{Class};
 311         die "no class for commodity $commod" unless defined $cl;
 312
 313         my $clid= $commodclasses{$cl};
 314         die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid;
 315
 316         if (defined $commods{$commod}{Ordval}) {
 317             $posincl{$commod}= ++$classorderedcount{$cl};
 318         } else {
 319             $posincl{$commod}= 0;
 320         }
 321     }
 322
 323     db_doall(<<END);
 324  DELETE FROM $table{commodclasses};
 325 END
 326     my $addclass= $dbh->prepare(<<END);
 327  INSERT INTO $table{commodclasses}
 328      (commodclassid, commodclass, maxposinclass)
 329      VALUES (?,?,?)
 330 END
 331     foreach my $cl (sort keys %commodclasses) {
 332         my $clname= $cl;
 333         $clname =~ s/_/ /g;
 334         $addclass->execute($commodclasses{$cl}+1,
 335                            ucfirst $clname,
 336                            $classorderedcount{$cl});
 337     }
 338 }
 339
 340 {
 341     my @valuefields= qw(
 342                         unitmass
 343                         unitvolume
 344                         commodclassid
 345                         ordval
 346                         posinclass
 347                         flags
 348                         );
 349     my $insert= $dbh->prepare("
 350  INSERT OR IGNORE INTO $table{commods}
 351       ( commodname,
 352         ".join(",
 353         ", @valuefields)." )
 354      VALUES (?,".join(',', map {'?'} @valuefields).")
 355 ");
 356     my $update= $dbh->prepare("
 357  UPDATE $table{commods}
 358      SET ".join(",
 359         ", map { "$_ = ?" } @valuefields)."
 360      WHERE commodname = ?
 361 ");
 362     foreach my $commod (commods_ordered()) {
 363         my $c= $commods{$commod};
 364         die "no mass for $commod" unless defined $c->{Mass};
 365         die "no volume for $commod" unless defined $c->{Volume};
 366
 367         my $cl= $c->{Class};
 368         my $clid= $commodclasses{$cl}+1;
 369
 370         my @valuevalues= (
 371                           $c->{Mass},
 372                           $c->{Volume},
 373                           $clid,
 374                           commodsortkey($commod),
 375                           $posincl{$commod},
 376                           $c->{Flags}
 377                           );
 378         $insert->execute($commod, @valuevalues);
 379         $update->execute(@valuevalues, $commod);
 380     }
 381
 382     my $search= $dbh->prepare(<<END);
 383  SELECT commodname,commodid FROM $table{commods};
 384 END
 385     my %check;
 386     foreach my $bs (qw(buy sell)) {
 387         $check{$bs}= $dbh->prepare(<<END);
 388  SELECT islandname,stallname,price,qty
 389    FROM $table{$bs}
 390    JOIN $table{stalls} USING (stallid)
 391    JOIN $table{islands} ON ($bs.islandid = $table{islands}.islandid)
 392    WHERE commodid = ? LIMIT 1
 393 END
 394     }
 395     my $delete= $dbh->prepare(<<END);
 396  DELETE FROM $table{commods} WHERE commodid = ?
 397 END
 398     $search->execute();
 399     my $any=0;
 400     while (my $row= $search->fetchrow_hashref()) {
 401         next if defined $commods{$row->{'commodname'}};
 402         print $any++ ? '; ' : "    Dropping old commodities: ",
 403               $row->{'commodname'};
 404         foreach my $bs (qw(buy sell)) {
 405             $check{$bs}->execute($row->{'commodid'});
 406             my $problem= $check{$bs}->fetchrow_hashref();
 407             if ($problem) {
 408                 print "\n";
 409                 die <<END
 410
 411 FATAL ERROR
 412     Removed commodity
 413        $row->{'commodid'}
 414        $row->{'commodname'}
 415     but
 416        $bs
 417        $problem->{'islandname'}
 418        $problem->{'stallname'}
 419        $problem->{'qty'} at $problem->{'price'}
 420 END
 421             }
 422         }
 423         $delete->execute($row->{'commodid'});
 424     }
 425     print ".\n" if $any;
 426 }
 427
 428 #---------- vessel types ----------
 429 {
 430     my $idempotent= $dbh->prepare(<<END)
 431  INSERT OR REPLACE INTO $table{vessels}
 432         (name, shot, mass, volume)
 433         VALUES (?,?,?,?)
 434 END
 435     ;
 436     foreach my $name (sort keys %vessels) {
 437         my $v= $vessels{$name};
 438         my $shotdamage= $shotname2damage{$v->{Shot}};
 439         die "no shot damage for shot $v->{Shot} for vessel $name"
 440             unless defined $shotdamage;
 441         my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
 442         $idempotent->execute(@qa);
 443     }
 444 }
 445
 446 #---------- transfer data back from any recreated tables ----------
 447
 448 foreach my $tb (@need_transfer_back) {
 449     my $tab= $tb->{Table};
 450     print "    Retransferring $tab...";
 451
 452     if (!eval {
 453         db_doall($tb->{Sql});
 454         1;
 455     }) {
 456         my $emsg= $@;
 457         my $w=20;
 458         print STDERR "\n=== $tab retransfer failed, dumping:\n";
 459         my $dumph= $dbh->prepare("SELECT * FROM aside_$tab");
 460         $dumph->execute();
 461         my @cols= @{ $dumph->{NAME_lc} };
 462         dumptab_head(\*STDERR,$w,\@cols);
 463         my $row;
 464         while ($row= $dumph->fetchrow_hashref()) {
 465             dumptab_row_hashref(\*STDERR,$w,\@cols,$row);
 466         }
 467         die "\n$emsg";
 468     }
 469     print "\n";
 470     $table{$tab}= $tab;
 471 }
 472
 473 #---------- create indices ----------
 474
 475 foreach my $bs (qw(buy sell)) {
 476     db_doall(<<END)
 477  CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
 478  CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
 479 END
 480     ;
 481 }
 482
 483 db_check_referential_integrity(1);
 484
 485 #---------- compact IDs ----------
 486
 487 sub getminmax ($$$) {
 488     my ($tab,$minmax,$f) = @_;
 489     my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab");
 490     $sth->execute();
 491     my ($val)= $sth->fetchrow_array();
 492     return defined($val) ? $val : '?';
 493 }
 494
 495 foreach my $cp (@need_compact) {
 496     print "    Compacting $cp->{Table}";
 497     my $tab= $cp->{Table};
 498     my $id= $cp->{Id};
 499     my $tmp_field_specs= $cp->{FieldSpecs};
 500     my $fields= join ',', @{$cp->{Fields}};
 501     $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
 502         die "$tab $tmp_field_specs ?";
 503     db_doall(<<END);
 504  CREATE TEMPORARY TABLE idlookup_$tab (
 505         new_$id         INTEGER PRIMARY KEY NOT NULL,
 506 $tmp_field_specs
 507  );
 508  INSERT INTO idlookup_$tab ($fields)
 509         SELECT $fields
 510         FROM $tab;
 511 END
 512     my $oldmax= getminmax($tab,'max',$id);
 513     my $offset= $oldmax+1;
 514
 515     printf(" %s %s..%d=>1..%d:",
 516            $cp->{Id},
 517            getminmax($tab,'min',$id),
 518            $oldmax,
 519            getminmax("idlookup_$tab",'max',"new_$id"));
 520     my @updates= @{ $cp->{Updates} };
 521     while (@updates) {
 522         my $utabs= shift @updates;
 523         my $ufields= shift @updates;
 524         foreach my $utab (@$utabs) {
 525             printf(" %s",$utab);
 526             my $fh= '.';
 527             foreach my $ufield (@$ufields) {
 528                 printf("%s%s",$fh,$ufield); $fh=',';
 529                 db_doall(<<END);
 530  UPDATE $utab
 531     SET $ufield = $offset +
 532         (SELECT new_$id FROM idlookup_$tab
 533           WHERE idlookup_$tab.$id = $utab.$ufield);
 534  UPDATE $utab
 535     SET $ufield = $ufield - $offset;
 536 END
 537             }
 538         }
 539     }
 540     print "\n";
 541 }
 542
 543 #---------- put it all into effect ----------
 544
 545 db_chkcommit(1);
 546
 547 {
 548     local $dbh->{AutoCommit} = 1;
 549     $dbh->do('VACUUM');
 550 }