@ARGV==1 or die;
my ($oceanname) = @ARGV;
+$|=1;
+
#---------- setup ----------
parse_info_serverside();
$dbh->trace(1) if $trace;
-#---------- referential integrity constraints ----------
-# SQLite doesn't support foreign key constraints so we do it by steam:
+#---------- schema update code ----------
-sub nooutput ($) {
- my ($stmts) = @_;
- my $ekindcount= 0;
- my $letxt= '';
- foreach my $stmt (split /\;/, $stmts) {
- next unless $stmt =~ /\S/;
+our @need_compact;
- my $etxt= '';
- $stmt =~ s/^([ \t]*\#.*)$/ $etxt .= $1."\n"; ''; /mge;
- $etxt= $letxt unless length $etxt;
- $letxt= $etxt;
-
- $stmt =~ s/^\s+//; $stmt =~ s/\s+$//;
- my $sth= $dbh->prepare($stmt);
- $sth->execute();
- my $row;
- my $ecount= 0;
- my @cols= @{ $sth->{NAME_lc} };
- my $w= 11;
- while ($row= $sth->fetchrow_hashref) {
- if (!$ecount++) {
- print STDERR "REFERENTIAL INTEGRITY ERROR\n";
- print STDERR "\n$etxt\n $stmt\n\n";
- printf STDERR "|%-${w}s", $_ foreach @cols; print STDERR "|\n";
- print STDERR "+",('-'x$w) foreach @cols; print STDERR "+\n";
- }
- if ($ecount>5) { print STDERR "...\n"; last; }
- printf STDERR "|%-$w.${w}s",
- (defined $row->{$_} ? $row->{$_} : 'NULL')
- foreach @cols;
- print STDERR "\n";
- }
- next unless $ecount;
-
- $ekindcount++;
- print STDERR "\n\n";
- }
- die "REFERENTIAL INTEGRITY ERRORS $ekindcount\n"
- if $ekindcount;
+sub table ($$) {
+ my ($table, $fields) = @_;
+ table_maycompact($table,undef,undef,$fields);
}
-sub check_referential_integrity () {
- foreach my $bs (qw(buy sell)) {
- nooutput(<<END);
+sub table_maycompact ($$$$) {
+ my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_;
- # Every buy/sell must refer to an entry in commods, islands, and stalls:
- SELECT * FROM $bs NATURAL LEFT JOIN commods WHERE commodname IS NULL;
- SELECT * FROM $bs NATURAL LEFT JOIN islands WHERE islandname IS NULL;
- SELECT * FROM $bs LEFT JOIN STALLS USING (stallid) WHERE stallname IS NULL;
+ #----- parse $fields -----
- # Every buy/sell must be part of an upload:
- SELECT * FROM $bs NATURAL LEFT JOIN uploads WHERE timestamp IS NULL;
+ my @want_fields;
+ my @want_field_specs;
+ my %want_field_specs;
- # The islandid in stalls must be the same as the islandid in buy/sell:
- SELECT * FROM $bs JOIN stalls USING (stallid)
- WHERE $bs.islandid != stalls.islandid;
-
-END
- }
- foreach my $end (qw(aiid biid)) {
- foreach my $tab (qw(dists routes)) {
- nooutput(<<END);
-
- # Every row in dists and routes must refer to two existing rows in islands:
- SELECT * FROM $tab d LEFT JOIN islands ON (d.$end=islandid)
- WHERE islandname IS NULL;
-
-END
+ foreach my $fspec (split /\n/, $fields) {
+ next unless $fspec =~ m/\S/;
+ if ($fspec =~ m/^\s*\+/) {
+ push @want_field_specs, "\t".$';
+ next;
+ } elsif ($fspec =~ m/^\s*(\w+)(\s+)(\w.*\S)\s*$/) {
+ my ($f,$spaces,$rhs) = ($1,$2,$3);
+ my $spec= "\t".$f.$spaces.$rhs;
+ push @want_fields, $f;
+ push @want_field_specs, $spec;
+ $want_field_specs{$f}= $spec;
+ } else {
+ die "$table $fspec ?";
}
}
- nooutput(<<END);
-
- # Every pair of islands must have an entry in dists:
- SELECT * FROM islands ia JOIN islands ib LEFT JOIN dists
- ON (ia.islandid=aiid and ib.islandid=biid)
- WHERE dist IS NULL;
-
- # Every stall and upload must refer to an island:
- SELECT * FROM stalls NATURAL LEFT JOIN islands WHERE islandname IS NULL;
- SELECT * FROM uploads NATURAL LEFT JOIN islands WHERE islandname IS NULL;
- # Every commod which refers to a commodclass refers to an existing one:
- SELECT * FROM commods WHERE commodclass NOT IN
- (SELECT commodclass FROM commodclasses);
+ my $want_field_specs= join ",\n", @want_field_specs;
- # There are no empty commodclasses:
- SELECT * FROM commodclasses NATURAL LEFT JOIN commods
- WHERE commodname IS NULL;
-
- # Ordvals which are not zero are unique:
- SELECT ordval,count(*) FROM COMMODS
- WHERE ordval IS NOT NULL AND ordval != 0
- GROUP BY ordval
- HAVING count(*) > 1;
+ #----- ensure table exists -----
+ db_doall(<<END);
+ CREATE TABLE IF NOT EXISTS $table (
+$want_field_specs
+ );
END
-}
+ my @need_recreate;
-sub chkcommit () {
- check_referential_integrity();
- $dbh->commit();
-}
-
-#---------- schema ----------
+ #----- check whether we need to remove autoinc -----
-foreach my $bs (qw(buy sell)) {
- db_doall(<<END)
- CREATE TABLE IF NOT EXISTS $bs (
- commodid INTEGER NOT NULL,
- islandid INTEGER NOT NULL,
- stallid INTEGER NOT NULL,
- price INTEGER NOT NULL,
- qty INTEGER NOT NULL,
- PRIMARY KEY (commodid, islandid, stallid)
- );
- CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
- CREATE INDEX IF NOT EXISTS ${bs}_by_price ON $bs (commodid, price, islandid);
+ if ($fields !~ /\bautoinc/i) {
+ my $autoinc= $dbh->prepare(<<END);
+ SELECT sql FROM sqlite_master
+ WHERE type='table' and name=? and tbl_name=?
END
- ;
-}
+ $autoinc->execute($table,$table);
+ my ($sql)= $autoinc->fetchrow_array();
+ die unless defined $sql;
+ push @need_recreate, 'remove autoinc'
+ if $sql =~ m/\bautoinc/i;
+ }
-sub table ($$) {
- my ($table,$fields) = @_;
- db_doall(" CREATE TABLE IF NOT EXISTS $table (\n$fields );");
+ #----- check whether we need to add fields -----
my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
$check->execute();
$have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
$check->finish();
- my (@have_fields, @missing_fields);
- my $have_field_specs='';
+ my @have_fields;
+ my @have_field_specs;
- foreach my $fspec (split /,/, $fields) {
- next unless $fspec =~ m/\S/;
- $fspec =~ m/^\s*(\w+)\s+(\w.*\S)\s*$/ or die "$table $fspec ?";
- my ($f,$spec) = ($1,$2);
+ foreach my $f (@want_fields) {
if ($have_fields{$f}) {
push @have_fields, $f;
- $have_field_specs .= ",\n" if length $have_field_specs;
- $have_field_specs .= "\t$f\t\t$spec\n";
+ push @have_field_specs, $want_field_specs{$f};
} else {
- push @missing_fields, $f;
+ push @need_recreate, "field $f";
}
}
- return unless @missing_fields;
- print " Adding missing fields to $table: @missing_fields ...\n";
+ #----- Do we need to recreate ? -----
+ return unless @need_recreate;
+ # yes:
+
+ print " Recreating $table: ", join('; ',@need_recreate);
my $have_fields= join ',', @have_fields;
+ my $have_field_specs= join ",\n", @have_field_specs;
db_doall(<<END);
CREATE TEMPORARY TABLE aside_$table (
-$have_field_specs );
+$have_field_specs
+ );
INSERT INTO aside_$table SELECT $have_fields FROM $table;
DROP TABLE $table;
CREATE TABLE $table (
-$fields );
+$want_field_specs
+ );
INSERT INTO $table ($have_fields) SELECT $have_fields FROM aside_$table;
DROP TABLE aside_$table;
END
+
+ #----- Do we need to compact ids ? -----
+ (print("\n"), return) unless
+ defined $cpact_idfield
+ and grep { m/^remove autoinc/ } @need_recreate;
+ # yes:
+
+ print "; will compact.\n";
+ unshift @$cpact_needupdates, [ $table ], [ $cpact_idfield ];
+
+ push @need_compact, {
+ Table => $table,
+ Id => $cpact_idfield,
+ Updates => $cpact_needupdates,
+ Fields => [ @want_fields ],
+ FieldSpecs => $want_field_specs
+ };
}
-table('commods', <<END);
- commodid INTEGER PRIMARY KEY NOT NULL,
- commodname TEXT UNIQUE NOT NULL,
- unitmass INTEGER,
- unitvolume INTEGER,
- ordval INTEGER,
- commodclass TEXT,
+
+#---------- actual schema ----------
+
+foreach my $bs (qw(buy sell)) {
+ db_doall(<<END)
+ CREATE TABLE IF NOT EXISTS $bs (
+ commodid INTEGER NOT NULL,
+ islandid INTEGER NOT NULL,
+ stallid INTEGER NOT NULL,
+ price INTEGER NOT NULL,
+ qty INTEGER NOT NULL,
+ PRIMARY KEY (commodid, islandid, stallid)
+ );
+ CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
+ CREATE INDEX IF NOT EXISTS ${bs}_by_price ON $bs (commodid, price, islandid);
+END
+ ;
+}
+
+table_maycompact('commods', 'commodid',
+ [ [ qw(buy sell) ], [ qw(commodid) ],
+ ], <<END);
+ commodid INTEGER PRIMARY KEY NOT NULL
+ commodname TEXT UNIQUE NOT NULL
+ unitmass INTEGER
+ unitvolume INTEGER
+ ordval INTEGER
+ commodclass TEXT
inclass INTEGER
END
+table_maycompact('islands', 'islandid',
+ [ [ qw(buy sell stalls uploads) ], [ qw(islandid) ],
+ [ qw(dists routes) ], [ qw(aiid biid) ],
+ ], <<END);
+ islandid INTEGER PRIMARY KEY NOT NULL
+ islandname TEXT UNIQUE NOT NULL
+ archipelago TEXT NOT NULL
+END
+
+table('stalls', <<END);
+ stallid INTEGER PRIMARY KEY NOT NULL
+ islandid INTEGER NOT NULL
+ stallname TEXT NOT NULL
+ + UNIQUE (islandid, stallname)
+END
+
table('commodclasses', <<END);
- commodclass TEXT PRIMARY KEY NOT NULL,
+ commodclass TEXT PRIMARY KEY NOT NULL
size INTEGER
END
db_doall(<<END)
- CREATE TABLE IF NOT EXISTS islands (
- islandid INTEGER PRIMARY KEY NOT NULL,
- islandname TEXT UNIQUE NOT NULL,
- archipelago TEXT NOT NULL
- );
- CREATE TABLE IF NOT EXISTS stalls (
- stallid INTEGER PRIMARY KEY NOT NULL,
- islandid INTEGER NOT NULL,
- stallname TEXT NOT NULL,
- UNIQUE (islandid, stallname)
- );
CREATE TABLE IF NOT EXISTS uploads (
islandid INTEGER PRIMARY KEY NOT NULL,
timestamp INTEGER NOT NULL,
END
;
-chkcommit();
#---------- commodity list ----------
}
{
- my $insert= $dbh->prepare(<<'END')
+ my $insert= $dbh->prepare(<<'END');
INSERT OR IGNORE INTO commods
(unitmass,
unitvolume,
commodname)
VALUES (?,?,?);
END
- ;
- my $setsizes= $dbh->prepare(<<'END')
+ my $setsizes= $dbh->prepare(<<'END');
UPDATE commods
SET unitmass = ?,
unitvolume = ?
WHERE commodname = ?
END
- ;
- my $setordval= $dbh->prepare(<<'END')
+ my $setordval= $dbh->prepare(<<'END');
UPDATE commods
SET ordval = ?
WHERE commodname = ?
END
- ;
- my $setclass= $dbh->prepare(<<'END')
+ my $setclass= $dbh->prepare(<<'END');
UPDATE commods
SET commodclass = ?
WHERE commodname = ?
END
- ;
- my $setinclass= $dbh->prepare(<<'END')
+ my $setinclass= $dbh->prepare(<<'END');
UPDATE commods
SET inclass = ?
WHERE commodname = ?
END
- ;
my %incl;
foreach my $commod (sort {
commodsortkey($a) cmp commodsortkey($b)
if (defined $c->{Ordval} and defined $cl) {
$incl{$cl}++;
$setinclass->execute($incl{$cl}, $commod);
+ } elsif (defined $cl) {
+ $incl{$cl} += 0;
}
}
db_doall(<<END);
DELETE FROM commodclasses;
END
- my $addclass= $dbh->prepare(<<'END')
+ my $addclass= $dbh->prepare(<<'END');
INSERT INTO commodclasses
(commodclass, size)
VALUES (?,?)
END
- ;
foreach my $cl (sort keys %incl) {
$addclass->execute($cl, $incl{$cl});
}
- chkcommit();
+
+ my $search= $dbh->prepare(<<'END');
+ SELECT commodname,commodid FROM commods;
+END
+ my %check;
+ foreach my $bs (qw(buy sell)) {
+ $check{$bs}= $dbh->prepare(<<END);
+ SELECT islandname,stallname,price,qty
+ FROM $bs
+ JOIN stalls USING (stallid)
+ JOIN islands ON ($bs.islandid = islands.islandid)
+ WHERE commodid = ? LIMIT 1
+END
+ }
+ my $delete= $dbh->prepare(<<'END');
+ DELETE FROM commods WHERE commodid = ?
+END
+ $search->execute();
+ my $any=0;
+ while (my $row= $search->fetchrow_hashref()) {
+ next if defined $commods{$row->{'commodname'}};
+ print $any++ ? '; ' : " Dropping old commodities: ",
+ $row->{'commodname'};
+ foreach my $bs (qw(buy sell)) {
+ $check{$bs}->execute($row->{'commodid'});
+ my $problem= $check{$bs}->fetchrow_hashref();
+ if ($problem) {
+ print "\n";
+ die <<END
+
+FATAL ERROR
+ Removed commodity
+ $row->{'commodid'}
+ $row->{'commodname'}
+ but
+ $bs
+ $problem->{'islandname'}
+ $problem->{'stallname'}
+ $problem->{'qty'} at $problem->{'price'}
+END
+ }
+ }
+ $delete->execute($row->{'commodid'});
+ }
+ print ".\n" if $any;
+ db_check_referential_integrity();
}
+
#---------- vessel types ----------
{
my $idempotent= $dbh->prepare(<<'END')
my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
$idempotent->execute(@qa);
}
- chkcommit();
+}
+
+
+#---------- compact IDs ----------
+
+sub getminmax ($$$) {
+ my ($tab,$minmax,$f) = @_;
+ my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab");
+ $sth->execute();
+ my ($val)= $sth->fetchrow_array();
+ return defined($val) ? $val : '?';
+}
+
+foreach my $cp (@need_compact) {
+ print " Compacting $cp->{Table}";
+ my $tab= $cp->{Table};
+ my $id= $cp->{Id};
+ my $tmp_field_specs= $cp->{FieldSpecs};
+ my $fields= join ',', @{$cp->{Fields}};
+ $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
+ die "$tab $tmp_field_specs ?";
+ db_doall(<<END);
+ CREATE TABLE aside_$tab (
+ new_$id INTEGER PRIMARY KEY NOT NULL,
+$tmp_field_specs
+ );
+ INSERT INTO aside_$tab ($fields)
+ SELECT $fields
+ FROM $tab;
+END
+ my $oldmax= getminmax($tab,'max',$id);
+ my $offset= $oldmax+1;
+
+ printf(" %s %s..%d=>1..%d:",
+ $cp->{Id},
+ getminmax($tab,'min',$id),
+ $oldmax,
+ getminmax("aside_$tab",'max',"new_$id"));
+ my @updates= @{ $cp->{Updates} };
+ while (@updates) {
+ my $utabs= shift @updates;
+ my $ufields= shift @updates;
+ foreach my $utab (@$utabs) {
+ printf(" %s",$utab);
+ my $fh= '.';
+ foreach my $ufield (@$ufields) {
+ printf("%s%s",$fh,$ufield); $fh=',';
+ db_doall(<<END);
+ UPDATE $utab
+ SET $ufield = $offset +
+ (SELECT new_$id FROM aside_$tab
+ WHERE aside_$tab.$id = $utab.$ufield);
+ UPDATE $utab
+ SET $ufield = $ufield - $offset;
+END
+ }
+ }
+ }
+ print "\n";
+}
+
+#---------- put it all into effect ----------
+
+db_chkcommit();
+
+{
+ local $dbh->{AutoCommit} = 1;
+ $dbh->do('VACUUM');
}
~yarrgweb / ypp-sc-tools.db-test.git / blobdiff