#!/usr/bin/perl -w
#
# Normally run from
#  update-master-info
#
# usage: ./db-idempotent-populate <Oceanname>
#  creates or updates OCEAN-Oceanname.db
#  from source-info.txt

# This is part of the YARRG website.  YARRG is a tool and website
# for assisting players of Yohoho Puzzle Pirates.
#
# Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
# are used without permission.  This program is not endorsed or
# sponsored by Three Rings.

use strict (qw(vars));

use DBI;

use Commods;
use CommodsDatabase;

my $trace;
if (@ARGV and $ARGV[0] eq '-D') {
	$trace=1;
	shift @ARGV;
}

@ARGV==1 or die;
my ($oceanname) = @ARGV;

#---------- setup ----------

parse_info_serverside();

db_setocean($oceanname);
db_writer();
db_connect();

$dbh->trace(1) if $trace;

#---------- referential integrity constraints ----------

# SQLite doesn't support foreign key constraints so we do it by steam:

sub nooutput ($) {
    my ($stmts) = @_;
    my $ekindcount= 0;
    my $letxt= '';
    foreach my $stmt (split /\;/, $stmts) {
	next unless $stmt =~ /\S/;

	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 check_referential_integrity () {
    foreach my $bs (qw(buy sell)) {
	nooutput(<<END);

 # 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;

 # Every buy/sell must be part of an upload:
 SELECT * FROM $bs NATURAL LEFT JOIN uploads WHERE timestamp IS NULL;

 # 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
	}
    }
    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);

 # 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;

END
}

sub chkcommit () {
    check_referential_integrity();
    $dbh->commit();
}

#---------- 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
    ;
}

sub table ($$) {
    my ($table,$fields) = @_;
    db_doall(" CREATE TABLE IF NOT EXISTS $table (\n$fields );");

    my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
    $check->execute();
    my %have_fields;
    $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
    $check->finish();

    my (@have_fields, @missing_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);
	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";
	} else {
	    push @missing_fields, $f;
	}
    }

    return unless @missing_fields;
    print "    Adding missing fields to $table: @missing_fields ...\n";

    my $have_fields= join ',', @have_fields;

    db_doall(<<END);
 CREATE TEMPORARY TABLE aside_$table (
$have_field_specs );
 INSERT INTO aside_$table SELECT $have_fields FROM $table;

 DROP TABLE $table;
 CREATE TABLE $table (
$fields );

 INSERT INTO $table ($have_fields) SELECT $have_fields FROM aside_$table;

 DROP TABLE aside_$table;
END
}

table('commods', <<END);
	commodid	INTEGER	PRIMARY KEY	NOT NULL,
	commodname	TEXT	UNIQUE		NOT NULL,
	unitmass	INTEGER,
	unitvolume	INTEGER,
	ordval		INTEGER,
	commodclass	TEXT,
	inclass		INTEGER
END

table('commodclasses', <<END);
	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,
	message		TEXT			NOT NULL,
	clientspec	TEXT			NOT NULL,
	serverspec	TEXT			NOT NULL
 );
 CREATE TABLE IF NOT EXISTS dists (
	aiid		INTEGER			NOT NULL,
	biid		INTEGER			NOT NULL,
	dist		INTEGER			NOT NULL,
	PRIMARY KEY (aiid, biid)
 );
 CREATE TABLE IF NOT EXISTS routes (
	aiid		INTEGER			NOT NULL,
	biid		INTEGER			NOT NULL,
	dist		INTEGER			NOT NULL,
	PRIMARY KEY (aiid, biid)
 );
 CREATE TABLE IF NOT EXISTS vessels (
	name		TEXT			NOT NULL,
	mass		INTEGER			NOT NULL,
	volume		INTEGER			NOT NULL,
	shot		INTEGER			NOT NULL,
	PRIMARY KEY (name)
 );
END
    ;

chkcommit();

#---------- commodity list ----------

sub commodsortkey ($) {
    my ($commod) = @_;
    my $ordval= $commods{$commod}{Ordval};
    return sprintf "B %20d", $ordval if defined $ordval;
    return sprintf "A %s", $commod;
}

{
    my $insert= $dbh->prepare(<<'END')
 INSERT OR IGNORE INTO commods
     (unitmass,
      unitvolume,
      commodname)
     VALUES (?,?,?);
END
    ;
    my $setsizes= $dbh->prepare(<<'END')
 UPDATE commods
     SET unitmass = ?,
         unitvolume = ?
     WHERE commodname = ?
END
    ;
    my $setordval= $dbh->prepare(<<'END')
 UPDATE commods
     SET ordval = ?
     WHERE commodname = ?
END
    ;
    my $setclass= $dbh->prepare(<<'END')
 UPDATE commods
     SET commodclass = ?
     WHERE commodname = ?
END
    ;
    my $setinclass= $dbh->prepare(<<'END')
 UPDATE commods
     SET inclass = ?
     WHERE commodname = ?
END
    ;
    my %incl;
    foreach my $commod (sort {
	        commodsortkey($a) cmp commodsortkey($b)
	    } keys %commods) {
	my $c= $commods{$commod};
        die "no mass for $commod" unless defined $c->{Mass};
        die "no volume for $commod" unless defined $c->{Volume};
	
	my @qa= ($c->{Mass}, $c->{Volume}, $commod);
	$insert->execute(@qa);
	$setsizes->execute(@qa);
	$setordval->execute($c->{Ordval} || 0, $commod);
	my $cl= $c->{Class};
	$setclass->execute($cl, $commod);

	if (defined $c->{Ordval} and defined $cl) {
	    $incl{$cl}++;
	    $setinclass->execute($incl{$cl}, $commod);
	}
    }
    db_doall(<<END);
 DELETE FROM commodclasses;
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();
}

#---------- vessel types ----------
{
    my $idempotent= $dbh->prepare(<<'END')
 INSERT OR REPLACE INTO vessels (name, shot, mass, volume)
                         VALUES (?,?,?,?)
END
    ;
    foreach my $name (sort keys %vessels) {
	my $v= $vessels{$name};
	my $shotdamage= $shotname2damage{$v->{Shot}};
	die "no shot damage for shot $v->{Shot} for vessel $name"
	    unless defined $shotdamage;
	my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
	$idempotent->execute(@qa);
    }
    chkcommit();
}