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