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(<<END)
+ db_doall(<<END)
CREATE TABLE IF NOT EXISTS $bs (
commodid INTEGER NOT NULL,
islandid INTEGER NOT NULL,
;
}
-dbdoall(<<END)
- CREATE TABLE IF NOT EXISTS commodities (
+db_doall(<<END)
+ CREATE TABLE IF NOT EXISTS commods (
commodid INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
commodname TEXT UNIQUE NOT NULL,
unitmass INTEGER,
);
CREATE TABLE IF NOT EXISTS uploads (
islandid INTEGER PRIMARY KEY NOT NULL,
- age INTEGER NOT NULL,
+ timestamp INTEGER NOT NULL,
+ message TEXT NOT NULL,
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
{
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) {
{
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) {
#---------- 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(<<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__
~yarrgweb / ypp-sc-tools.web-live.git / blobdiff