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 END
 233
 234 table_maycompact('islands', 'islandid',
 235                  [ [ qw(buy sell stalls uploads) ], [ qw(islandid) ],
 236                    [ qw(dists routes) ], [ qw(aiid biid) ],
 237  ], <<END);
 238         islandid        INTEGER PRIMARY KEY     NOT NULL
 239         islandname      TEXT    UNIQUE          NOT NULL
 240         archipelago     TEXT                    NOT NULL
 241 END
 242
 243 table('stalls', <<END);
 244         stallid         INTEGER PRIMARY KEY     NOT NULL
 245         islandid        INTEGER                 NOT NULL
 246         stallname       TEXT                    NOT NULL
 247         + UNIQUE (islandid, stallname)
 248 END
 249
 250 table('commodclasses', <<END);
 251         commodclassid   INTEGER PRIMARY KEY     NOT NULL
 252         commodclass     TEXT    UNIQUE          NOT NULL
 253         maxposinclass   INTEGER                 NOT NULL
 254 END
 255
 256 table('uploads', <<END);
 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 END
 263
 264 table('dists', <<END);
 265         aiid            INTEGER                 NOT NULL
 266         biid            INTEGER                 NOT NULL
 267         dist            INTEGER                 NOT NULL
 268         + PRIMARY KEY (aiid, biid)
 269 END
 270
 271 table('routes', <<END);
 272         aiid            INTEGER                 NOT NULL
 273         biid            INTEGER                 NOT NULL
 274         dist            INTEGER                 NOT NULL
 275         + PRIMARY KEY (aiid, biid)
 276 END
 277
 278 table('vessels', <<END);
 279         name            TEXT                    NOT NULL
 280         mass            INTEGER                 NOT NULL
 281         volume          INTEGER                 NOT NULL
 282         shot            INTEGER                 NOT NULL
 283         + PRIMARY KEY (name)
 284 END
 285
 286
 287 #---------- commodity list ----------
 288
 289 sub commodsortkey ($) {
 290     my ($commod) = @_;
 291     return $commods{$commod}{Ordval} ||
 292            $commods{$commod}{ClassOrdval};
 293 }
 294 sub commods_ordered () {
 295     sort {
 296         commodsortkey($a) <=> commodsortkey($b);
 297     } keys %commods;
 298 }
 299
 300 our %posincl;
 301
 302 {
 303     my %classorderedcount;
 304
 305     foreach my $cl (keys %commodclasses) {
 306         $classorderedcount{$cl}= 0;
 307     }
 308     foreach my $commod (commods_ordered()) {
 309         my $cl= $commods{$commod}{Class};
 310         die "no class for commodity $commod" unless defined $cl;
 311
 312         my $clid= $commodclasses{$cl};
 313         die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid;
 314
 315         if (defined $commods{$commod}{Ordval}) {
 316             $posincl{$commod}= ++$classorderedcount{$cl};
 317         } else {
 318             $posincl{$commod}= 0;
 319         }
 320     }
 321
 322     db_doall(<<END);
 323  DELETE FROM $table{commodclasses};
 324 END
 325     my $addclass= $dbh->prepare(<<END);
 326  INSERT INTO $table{commodclasses}
 327      (commodclassid, commodclass, maxposinclass)
 328      VALUES (?,?,?)
 329 END
 330     foreach my $cl (sort keys %commodclasses) {
 331         my $clname= $cl;
 332         $clname =~ s/_/ /g;
 333         $addclass->execute($commodclasses{$cl}+1,
 334                            ucfirst $clname,
 335                            $classorderedcount{$cl});
 336     }
 337 }
 338
 339 {
 340     my @valuefields= qw(
 341                         unitmass
 342                         unitvolume
 343                         commodclassid
 344                         ordval
 345                         posinclass
 346                         );
 347     my $insert= $dbh->prepare("
 348  INSERT OR IGNORE INTO $table{commods}
 349       ( commodname,
 350         ".join(",
 351         ", @valuefields)." )
 352      VALUES (?,".join(',', map {'?'} @valuefields).")
 353 ");
 354     my $update= $dbh->prepare("
 355  UPDATE $table{commods}
 356      SET ".join(",
 357         ", map { "$_ = ?" } @valuefields)."
 358      WHERE commodname = ?
 359 ");
 360     foreach my $commod (commods_ordered()) {
 361         my $c= $commods{$commod};
 362         die "no mass for $commod" unless defined $c->{Mass};
 363         die "no volume for $commod" unless defined $c->{Volume};
 364
 365         my $cl= $c->{Class};
 366         my $clid= $commodclasses{$cl}+1;
 367
 368         my @valuevalues= (
 369                           $c->{Mass},
 370                           $c->{Volume},
 371                           $clid,
 372                           commodsortkey($commod),
 373                           $posincl{$commod}
 374                           );
 375         $insert->execute($commod, @valuevalues);
 376         $update->execute(@valuevalues, $commod);
 377     }
 378
 379     my $search= $dbh->prepare(<<END);
 380  SELECT commodname,commodid FROM $table{commods};
 381 END
 382     my %check;
 383     foreach my $bs (qw(buy sell)) {
 384         $check{$bs}= $dbh->prepare(<<END);
 385  SELECT islandname,stallname,price,qty
 386    FROM $table{$bs}
 387    JOIN $table{stalls} USING (stallid)
 388    JOIN $table{islands} ON ($bs.islandid = $table{islands}.islandid)
 389    WHERE commodid = ? LIMIT 1
 390 END
 391     }
 392     my $delete= $dbh->prepare(<<END);
 393  DELETE FROM $table{commods} WHERE commodid = ?
 394 END
 395     $search->execute();
 396     my $any=0;
 397     while (my $row= $search->fetchrow_hashref()) {
 398         next if defined $commods{$row->{'commodname'}};
 399         print $any++ ? '; ' : "    Dropping old commodities: ",
 400               $row->{'commodname'};
 401         foreach my $bs (qw(buy sell)) {
 402             $check{$bs}->execute($row->{'commodid'});
 403             my $problem= $check{$bs}->fetchrow_hashref();
 404             if ($problem) {
 405                 print "\n";
 406                 die <<END
 407
 408 FATAL ERROR
 409     Removed commodity
 410        $row->{'commodid'}
 411        $row->{'commodname'}
 412     but
 413        $bs
 414        $problem->{'islandname'}
 415        $problem->{'stallname'}
 416        $problem->{'qty'} at $problem->{'price'}
 417 END
 418             }
 419         }
 420         $delete->execute($row->{'commodid'});
 421     }
 422     print ".\n" if $any;
 423 }
 424
 425 #---------- vessel types ----------
 426 {
 427     my $idempotent= $dbh->prepare(<<END)
 428  INSERT OR REPLACE INTO $table{vessels}
 429         (name, shot, mass, volume)
 430         VALUES (?,?,?,?)
 431 END
 432     ;
 433     foreach my $name (sort keys %vessels) {
 434         my $v= $vessels{$name};
 435         my $shotdamage= $shotname2damage{$v->{Shot}};
 436         die "no shot damage for shot $v->{Shot} for vessel $name"
 437             unless defined $shotdamage;
 438         my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
 439         $idempotent->execute(@qa);
 440     }
 441 }
 442
 443 #---------- transfer data back from any recreated tables ----------
 444
 445 foreach my $tb (@need_transfer_back) {
 446     my $tab= $tb->{Table};
 447     print "    Retransferring $tab...";
 448
 449     if (!eval {
 450         db_doall($tb->{Sql});
 451         1;
 452     }) {
 453         my $emsg= $@;
 454         my $w=20;
 455         print STDERR "\n=== $tab retransfer failed, dumping:\n";
 456         my $dumph= $dbh->prepare("SELECT * FROM aside_$tab");
 457         $dumph->execute();
 458         my @cols= @{ $dumph->{NAME_lc} };
 459         dumptab_head(\*STDERR,$w,\@cols);
 460         my $row;
 461         while ($row= $dumph->fetchrow_hashref()) {
 462             dumptab_row_hashref(\*STDERR,$w,\@cols,$row);
 463         }
 464         die "\n$emsg";
 465     }
 466     print "\n";
 467     $table{$tab}= $tab;
 468 }
 469
 470 #---------- create indices ----------
 471
 472 foreach my $bs (qw(buy sell)) {
 473     db_doall(<<END)
 474  CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
 475  CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
 476 END
 477     ;
 478 }
 479
 480 db_check_referential_integrity(1);
 481
 482 #---------- compact IDs ----------
 483
 484 sub getminmax ($$$) {
 485     my ($tab,$minmax,$f) = @_;
 486     my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab");
 487     $sth->execute();
 488     my ($val)= $sth->fetchrow_array();
 489     return defined($val) ? $val : '?';
 490 }
 491
 492 foreach my $cp (@need_compact) {
 493     print "    Compacting $cp->{Table}";
 494     my $tab= $cp->{Table};
 495     my $id= $cp->{Id};
 496     my $tmp_field_specs= $cp->{FieldSpecs};
 497     my $fields= join ',', @{$cp->{Fields}};
 498     $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
 499         die "$tab $tmp_field_specs ?";
 500     db_doall(<<END);
 501  CREATE TEMPORARY TABLE idlookup_$tab (
 502         new_$id         INTEGER PRIMARY KEY NOT NULL,
 503 $tmp_field_specs
 504  );
 505  INSERT INTO idlookup_$tab ($fields)
 506         SELECT $fields
 507         FROM $tab;
 508 END
 509     my $oldmax= getminmax($tab,'max',$id);
 510     my $offset= $oldmax+1;
 511
 512     printf(" %s %s..%d=>1..%d:",
 513            $cp->{Id},
 514            getminmax($tab,'min',$id),
 515            $oldmax,
 516            getminmax("idlookup_$tab",'max',"new_$id"));
 517     my @updates= @{ $cp->{Updates} };
 518     while (@updates) {
 519         my $utabs= shift @updates;
 520         my $ufields= shift @updates;
 521         foreach my $utab (@$utabs) {
 522             printf(" %s",$utab);
 523             my $fh= '.';
 524             foreach my $ufield (@$ufields) {
 525                 printf("%s%s",$fh,$ufield); $fh=',';
 526                 db_doall(<<END);
 527  UPDATE $utab
 528     SET $ufield = $offset +
 529         (SELECT new_$id FROM idlookup_$tab
 530           WHERE idlookup_$tab.$id = $utab.$ufield);
 531  UPDATE $utab
 532     SET $ufield = $ufield - $offset;
 533 END
 534             }
 535         }
 536     }
 537     print "\n";
 538 }
 539
 540 #---------- put it all into effect ----------
 541
 542 db_chkcommit(1);
 543
 544 {
 545     local $dbh->{AutoCommit} = 1;
 546     $dbh->do('VACUUM');
 547 }