Detect a few more inconsistencies

[ypp-sc-tools.web-live.git] / pctb / db-idempotent-populate

diff --git a/pctb/db-idempotent-populate b/pctb/db-idempotent-populate
index 1b0ef02214a005d834ac20dbe5b50960eb1bb757..2cae151b3a236a62386c8b554ffcf6d51a396bde 100755 (executable)
--- a/pctb/db-idempotent-populate
+++ b/pctb/db-idempotent-populate
@@ -33,9 +33,9 @@ use DBI;
 use Commods;
 
 @ARGV==1 or die;
-my ($ocean) = @ARGV;
+my ($oceanname) = @ARGV;
 
-my $dbfn= "OCEAN-$ocean.db";
+my $dbfn= "OCEAN-$oceanname.db";
 
 our $dbh;
 
@@ -45,20 +45,27 @@ sub dbdoall ($) {
     }
 }
 
+#---------- setup ----------
+
+parse_masters_ocean($oceanname);
+our $ocean= $oceans{$oceanname};
+
 $dbh= DBI->connect("dbi:SQLite:$dbfn",'','',
                   { AutoCommit=>0,
                     RaiseError=>1, ShowErrorStatement=>1,
                     unicode=>1 })
     or die "$dbfn $DBI::errstr ?";
 
+#---------- schema ----------
+
 foreach my $bs (qw(buy sell)) {
     dbdoall(<<END)
  CREATE TABLE IF NOT EXISTS $bs (
        commodid        INTEGER                 NOT NULL,
        islandid        INTEGER                 NOT NULL,
        stallid         INTEGER                 NOT NULL,
-       price           INTEGER,
-       qty             INTEGER,
+       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);
@@ -68,7 +75,7 @@ END
 }
 
 dbdoall(<<END)
- CREATE TABLE IF NOT EXISTS commodities (
+ CREATE TABLE IF NOT EXISTS commods (
        commodid        INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
        commodname      TEXT    UNIQUE          NOT NULL,
        unitmass        INTEGER,
@@ -91,10 +98,10 @@ dbdoall(<<END)
        clientspec      TEXT                    NOT NULL,
        serverspec      TEXT                    NOT NULL
  );
- CREATE TABLE IF NOT EXISTS distances (
+ CREATE TABLE IF NOT EXISTS dists (
        aiid            INTEGER                 NOT NULL,
        biid            INTEGER                 NOT NULL,
-       distance        INTEGER                 NOT NULL,
+       dist            INTEGER                 NOT NULL,
        PRIMARY KEY (aiid, biid)
  );
 END
@@ -102,11 +109,11 @@ END
 
 $dbh->commit;
 
-parse_masters();
+#---------- commodity list ----------
 
 {
     my $sth= $dbh->prepare(<<'END')
- INSERT OR IGNORE INTO commodities (commodname) values (?);
+ INSERT OR IGNORE INTO commods (commodname) VALUES (?);
 END
     ;
     foreach my $commod (sort keys %commods) {
@@ -114,3 +121,103 @@ END
     }
     $dbh->commit;
 }
+
+#---------- island list ----------
+
+{
+    my $sth= $dbh->prepare(<<'END')
+ INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?);
+END
+    ;
+    foreach my $archname (sort keys %$ocean) {
+       my $arch= $ocean->{$archname};
+       foreach my $islandname (sort keys %$arch) {
+           $sth->execute($islandname, $archname);
+       }
+    }
+    $dbh->commit;
+}
+
+#---------- routes ----------
+
+{
+    foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) {
+       warn "$route_mysteries{$oceanname}{$islandname} routes".
+           " for unknown island $islandname\n";
+    }
+
+    my $allroutes= $routes{$oceanname};
+
+    my @propqueue= ();
+
+    sub distance_set_propagate ($$$$) {
+       my ($lev, $start, $upto, $start2upto) = @_;
+       $allroutes->{$start}{$upto}= $start2upto;
+       push @propqueue, [ $lev, $start, $upto ];
+    }
+
+    sub distance_propagate_now {
+       my ($lev, $start, $upto) = @_;
+       my $startref= $allroutes->{$start};
+       my $start2upto= $startref->{$upto};
+       my $uptoref=  $allroutes->{$upto};
+
+       for my $next (keys %$uptoref) {
+           next if $next eq $upto;
+           my $unext= $uptoref->{$next};
+           next unless defined $unext;
+           distance_update("${lev}p", $start, $next, $start2upto + $unext);
+       }
+    }
+
+    sub distance_update ($$$$) {
+       my ($lev, $x, $y, $newdist) = @_;
+       distance_update_one("${lev}x",$x,$y,$newdist);
+       distance_update_one("${lev}y",$y,$x,$newdist);
+    }
+
+    sub distance_update_one ($$$$) {
+       my ($lev, $x, $y, $newdist) = @_;
+       my $xref= $allroutes->{$x};
+       my $currently= $xref->{$y};
+       return if defined($currently) and $currently <= $newdist;
+       distance_set_propagate("${lev}o",$x,$y,$newdist);
+    }
+
+    foreach my $xn (keys %$allroutes) {
+       my $routes= $allroutes->{$xn};
+       distance_set_propagate('0', $xn, $xn, 0);
+       foreach my $yn (keys %$routes) {
+           distance_set_propagate('0', $yn, $yn, 0);
+           distance_set_propagate('X', $xn, $yn, $routes->{$yn});
+           distance_set_propagate('Y', $yn, $xn, $routes->{$yn});
+       }
+    }
+    my $ref;
+    while ($ref= shift @propqueue) {
+       distance_propagate_now(@$ref);
+    }
+
+    dbdoall(<<END)
+ DELETE FROM dists;
+END
+    ;
+    my $sth= $dbh->prepare(<<'END')
+ INSERT INTO dists VALUES
+       ((SELECT islandid FROM islands WHERE islandname == ?),
+        (SELECT islandid FROM islands WHERE islandname == ?),
+        ?);
+END
+    ;
+    foreach my $xn (keys %$allroutes) {
+       my $routes= $allroutes->{$xn};
+       foreach my $yn (keys %$routes) {
+           $sth->execute($xn, $yn, $routes->{$yn});
+       }
+    }
+    $dbh->commit();
+
+    # select ia.islandname, ib.islandname,dists.dist from dists, islands as ia on dists.aiid = ia.islandid, islands as ib on dists.biid = ib.islandid order by ia.islandname, ib.islandname;
+}
+
+__DATA__