X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;ds=sidebyside;f=pctb%2Fdb-idempotent-populate;h=b7743ed9cb1ff3f78ef9b6be379d4635ec467e1e;hb=4082d99f96937ee23634130df98a376f1643086b;hp=893f4a74e84f8620a5ff581041348feac5a5fe7f;hpb=e3bd945bfba693d7467f28a2c59e77219387caa9;p=ypp-sc-tools.web-live.git diff --git a/pctb/db-idempotent-populate b/pctb/db-idempotent-populate index 893f4a7..b7743ed 100755 --- a/pctb/db-idempotent-populate +++ b/pctb/db-idempotent-populate @@ -31,35 +31,23 @@ use strict (qw(vars)); use DBI; use Commods; +use CommodsDatabase; @ARGV==1 or die; my ($oceanname) = @ARGV; -my $dbfn= "OCEAN-$oceanname.db"; - -our $dbh; - -sub dbdoall ($) { - foreach my $cmd (split /\;/, $_[0]) { - $dbh->do("$cmd;") if $cmd =~ m/\S/; - } -} - #---------- 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 ?"; +db_setocean($oceanname); +db_connect(); #---------- schema ---------- foreach my $bs (qw(buy sell)) { - dbdoall(<commit; { 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) { @@ -126,7 +115,7 @@ END { my $sth= $dbh->prepare(<<'END') - INSERT OR IGNORE INTO islands (islandname, archipelago) values (?, ?); + INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?); END ; foreach my $archname (sort keys %$ocean) { @@ -140,48 +129,84 @@ END #---------- routes ---------- -foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) { - warn "$route_mysteries{$oceanname}{$islandname} routes". - " for unknown island $islandname\n"; -} +{ + foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) { + warn "$route_mysteries{$oceanname}{$islandname} routes". + " for unknown island $islandname\n"; + } -#use Data::Dumper; -#print Dumper(\%routes); + my $allroutes= $routes{$oceanname}; -__DATA__ + my @propqueue= (); - /* 'distances' will hold the final results. */ - create table distances ( - a varchar(40) not null references islands(name), - b varchar(40) not null references islands(name), - distance int not null, - primary key (a,b) ); - - /* Create a rule such that insertion into the distances table is only - possible if a shorter route or a new route is being recorded; all other - inserts are ignored. */ - - create or replace rule update_only_if_shorter as - on insert to distances - where ((new.a,new.b) in (select a,b from distances)) - do instead - update distances set distance=(case when new.distance<=distance then - new.distance else distance end) - where a=new.a and b=new.b; - - /* Start by copying manually entered routes into distances */ - insert into distances (select a,b,distance from routes); - /* Also all the reverse routes */ - insert into distances (select b,a,distance from routes); - /* Also all the null routes */ - insert into distances (select distinct a,a,0 from routes); - insert into distances (select distinct b,b,0 from routes); - - /* Now extend the distances table by computing new routes */ - insert into distances (select source.a,dest.b, - min(source.distance+dest.distance) - from distances source,distances dest - where source.b=dest.a group by source.a,dest.b); - - /* Repeat that query until no new routes are added (i.e. select count(*) - from distances; returns the same value after the query as it does before) */ + 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); + } + + db_doall(<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__