#!/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.

BEGIN { unshift @INC, qw(.) }

use strict (qw(vars));

use DBI;

use Commods;
use CommodsDatabase;

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

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

$|=1;

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

parse_info_serverside();

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

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


#---------- schema update code ----------

our @need_compact;
our @need_transfer_back;

our %table;

sub table ($$) {
    my ($table, $fields) = @_;
    table_maycompact($table,undef,undef,$fields);
}

sub table_maycompact ($$$$) {
    my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_;

    #----- parse $fields -----

    my @want_fields;
    my @want_field_specs;
    my %want_field_specs;

    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 ?";
	}
    }

    my $want_field_specs= join ",\n", @want_field_specs;

    #----- ensure table exists -----

    db_doall(<<END);
 CREATE TABLE IF NOT EXISTS $table (
$want_field_specs
	);
END
    my @need_recreate;

    #----- check whether we need to remove autoinc -----

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

    #----- check whether we need to add 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;
    my @aside_fields;
    my @have_field_specs;
    my @aside_field_specs;

    foreach my $f (@want_fields) {
	if ($have_fields{$f}) {
	    push @have_fields, $f;
	    push @have_field_specs, $want_field_specs{$f};
	} else {
	    my $aside= $want_field_specs{$f};
	    $aside =~ s/\bUNIQUE\b//i;
	    $aside =~ s/\bNOT\s*NULL\b//i;
	    $aside =~ s/\bPRIMARY\s*KEY\b//i;
	    $aside =~ s/\s+$//;
	    push @aside_fields, $f;
	    push @aside_field_specs, $aside;
	    push @need_recreate, "field $f";
	}
    }

    #----- Do we need to recreate ? -----
    if (!@need_recreate) {
	$table{$table}= $table;
	return;
    }
    #----- Yes, recreate: -----

    print "    Recreating $table: ", join('; ',@need_recreate);
    $table{$table}= "aside_$table";

    my $have_fields= join ',', @have_fields;
    my $aside_fields= join ',', @have_fields, @aside_fields;
    my $have_field_specs= join ",\n", @have_field_specs;
    my $aside_field_specs= join ",\n", @have_field_specs, @aside_field_specs;

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

 DROP TABLE $table;
END

    push @need_transfer_back, {
	Table => $table,
	Sql => <<END
 CREATE TABLE $table (
$want_field_specs
	);

 INSERT INTO $table ($aside_fields) SELECT $aside_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
	};
}


#---------- actual schema ----------

foreach my $bs (qw(buy sell)) {
    table($bs,<<END);
	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)
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
	commodclassid	INTEGER			NOT NULL
	ordval		INTEGER			NOT NULL
	posinclass	INTEGER			NOT NULL
	flags		TEXT			NOT NULL
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);
	commodclassid	INTEGER	PRIMARY KEY	NOT NULL
	commodclass	TEXT	UNIQUE		NOT NULL
	maxposinclass	INTEGER			NOT NULL
END

table('uploads', <<END);
	islandid	INTEGER PRIMARY KEY	NOT NULL
	timestamp	INTEGER			NOT NULL
	message		TEXT			NOT NULL
	clientspec	TEXT			NOT NULL
	serverspec	TEXT			NOT NULL
END

table('dists', <<END);
	aiid		INTEGER			NOT NULL
	biid		INTEGER			NOT NULL
	dist		INTEGER			NOT NULL
	+ PRIMARY KEY (aiid, biid)
END

table('routes', <<END);
	aiid		INTEGER			NOT NULL
	biid		INTEGER			NOT NULL
	dist		INTEGER			NOT NULL
	+ PRIMARY KEY (aiid, biid)
END

table('vessels', <<END);
	name		TEXT			NOT NULL
	mass		INTEGER			NOT NULL
	volume		INTEGER			NOT NULL
	shot		INTEGER			NOT NULL
	+ PRIMARY KEY (name)
END


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

sub commodsortkey ($) {
    my ($commod) = @_;
    return $commods{$commod}{Ordval} ||
	   $commods{$commod}{ClassOrdval};
}
sub commods_ordered () {
    sort {
	commodsortkey($a) <=> commodsortkey($b);
    } keys %commods;
}

our %posincl;

{
    my %classorderedcount;

    foreach my $cl (keys %commodclasses) {
	$classorderedcount{$cl}= 0;
    }
    foreach my $commod (commods_ordered()) {
	my $cl= $commods{$commod}{Class};
	die "no class for commodity $commod" unless defined $cl;

	my $clid= $commodclasses{$cl};
	die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid;

	if (defined $commods{$commod}{Ordval}) {
	    $posincl{$commod}= ++$classorderedcount{$cl};
	} else {
	    $posincl{$commod}= 0;
	}
    }

    db_doall(<<END);
 DELETE FROM $table{commodclasses};
END
    my $addclass= $dbh->prepare(<<END);
 INSERT INTO $table{commodclasses}
     (commodclassid, commodclass, maxposinclass)
     VALUES (?,?,?)
END
    foreach my $cl (sort keys %commodclasses) {
	my $clname= $cl;
	$clname =~ s/_/ /g;
	$addclass->execute($commodclasses{$cl}+1,
			   ucfirst $clname,
			   $classorderedcount{$cl});
    }
}

{
    my @valuefields= qw(
			unitmass
			unitvolume
			commodclassid
			ordval
			posinclass
			flags
			);
    my $insert= $dbh->prepare("
 INSERT OR IGNORE INTO $table{commods}
      ( commodname,
	".join(",
	", @valuefields)." )
     VALUES (?,".join(',', map {'?'} @valuefields).")
");
    my $update= $dbh->prepare("
 UPDATE $table{commods}
     SET ".join(",
	", map { "$_ = ?" } @valuefields)."
     WHERE commodname = ?
");
    foreach my $commod (commods_ordered()) {
	my $c= $commods{$commod};
        die "no mass for $commod" unless defined $c->{Mass};
        die "no volume for $commod" unless defined $c->{Volume};
	
	my $cl= $c->{Class};
	my $clid= $commodclasses{$cl}+1;

	my @valuevalues= (
			  $c->{Mass},
			  $c->{Volume},
			  $clid,
			  commodsortkey($commod),
			  $posincl{$commod},
			  $c->{Flags}
			  );
	$insert->execute($commod, @valuevalues);
	$update->execute(@valuevalues, $commod);
    }

    my $search= $dbh->prepare(<<END);
 SELECT commodname,commodid FROM $table{commods};
END
    my %check;
    foreach my $bs (qw(buy sell)) {
	$check{$bs}= $dbh->prepare(<<END);
 SELECT islandname,stallname,price,qty
   FROM $table{$bs}
   JOIN $table{stalls} USING (stallid)
   JOIN $table{islands} ON ($bs.islandid = $table{islands}.islandid)
   WHERE commodid = ? LIMIT 1
END
    }
    my $delete= $dbh->prepare(<<END);
 DELETE FROM $table{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;
}

#---------- vessel types ----------
{
    my $idempotent= $dbh->prepare(<<END)
 INSERT OR REPLACE INTO $table{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);
    }
}

#---------- transfer data back from any recreated tables ----------

foreach my $tb (@need_transfer_back) {
    my $tab= $tb->{Table};
    print "    Retransferring $tab...";

    if (!eval {
	db_doall($tb->{Sql});
	1;
    }) {
	my $emsg= $@;
	my $w=20;
	print STDERR "\n=== $tab retransfer failed, dumping:\n";
	my $dumph= $dbh->prepare("SELECT * FROM aside_$tab");
	$dumph->execute();
	my @cols= @{ $dumph->{NAME_lc} };
	dumptab_head(\*STDERR,$w,\@cols);
	my $row;
	while ($row= $dumph->fetchrow_hashref()) {
	    dumptab_row_hashref(\*STDERR,$w,\@cols,$row);
	}
	die "\n$emsg";
    }
    print "\n";
    $table{$tab}= $tab;
}

#---------- create indices ----------

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

db_check_referential_integrity(1);

#---------- 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 TEMPORARY TABLE idlookup_$tab (
	new_$id		INTEGER PRIMARY KEY NOT NULL,
$tmp_field_specs
 );
 INSERT INTO idlookup_$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("idlookup_$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 idlookup_$tab
          WHERE idlookup_$tab.$id = $utab.$ufield);
 UPDATE $utab
    SET $ufield = $ufield - $offset;
END
            }
	}
    }
    print "\n";
}

#---------- put it all into effect ----------

db_chkcommit(1);

{
    local $dbh->{AutoCommit} = 1;
    $dbh->do('VACUUM');
}