#!/usr/bin/perl -w
#
# This script is invoked to process an email sent by the
# commod-update-receiver Perl script.

# This is part of ypp-sc-tools, a set of third-party tools 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 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 General Public License for more details.
#
# You should have received a copy of the GNU 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 POSIX;
use MIME::Parser;

BEGIN {
    my $selfdir= $0;
    $selfdir =~ s,/+[^/]*$,,;
    chdir("$selfdir") or die "$selfdir $!";

    unshift @INC, qw(.);
}

use Commods;
use CommodsDatabase;

set_ctype_utf8();
my $parser= new MIME::Parser;
our $entity;

$|=1;

sub find_part ($$$) {
    my ($filename, $type, $accepter) = @_;
    foreach my $part ($entity->parts()) {
	my $h= $part->head();
	next unless $h->recommended_filename() eq $filename;
	next unless $h->mime_type()            eq $type;
	next unless $part->effective_type()    eq $type;
	next if defined $accepter and !&$accepter($h);
	return $part;
    }
    die "no appropriate part with name $filename and type $type";
}

sub bad_data_fail ($) { die $_[0]; }

sub main () {
    $parser->extract_nested_messages(0);
    $parser->ignore_errors(0);

    $entity= $parser->parse(\*STDIN);
    my $eff_type= $entity->effective_type();
    die "effective type $eff_type\n" unless $eff_type eq 'multipart/mixed';

    my $mdpart= find_part('metadata', 'text/plain', sub {
	my $charset= $_[0]->mime_attr('content-type.charset');
	return 1 if grep { $_ eq $charset } qw(utf-8 us-ascii);
    });

    my $mdh= $mdpart->open('r') or die "failed to open metadata $!\n";
    my %md;
    while (defined($_= $mdh->getline())) {
	m/^([a-z]+)\t(.*)$/ or next;
	$md{$1}= $2;
    }

    foreach my $needed (qw(ocean island timestamp clientspec serverspec)) {
	defined $md{$needed} or die "missing metadata $needed\n";
    }

    my $mid= $entity->head()->get('message-id');
    defined $mid or die "missing Message-ID\n";
    chomp($mid);
    $mid !~ m/[^ -~]/ or die "Message-ID has strange character(s)\n";

    my $tsvpart= find_part('deduped.tsv.gz', 'application/octet-stream',
			   undef);
    my $tsv= pipethrough_prep();
    $tsvpart->bodyhandle()->print($tsv);
    my $pt= pipethrough_run_along($tsv,undef, 'gunzip','gunzip');

    db_setocean($md{'ocean'});
    my $dbfn= db_filename();
    (stat $dbfn) or die "stat database $dbfn failed $!\n";
    db_writer();
    db_connect();
    db_onconflict(sub { print STDERR "temporary failure: @_\n"; exit 75; });

    my ($islandid) = $dbh->selectrow_array(
              "SELECT islands.islandid
                      FROM islands
                      WHERE islandname == ?;
              ", {}, $md{'island'});

    die "unknown island\n" unless defined $islandid;

    db_doall("DELETE FROM uploads WHERE islandid == $islandid;
	      DELETE FROM buy     WHERE islandid == $islandid;
	      DELETE FROM sell    WHERE islandid == $islandid;
             ");
    
    $dbh->do("INSERT INTO uploads
                     (islandid, message,
                      timestamp, clientspec, serverspec)
	             VALUES (?,?,?,?,?);
             ", {},
	     $islandid, $mid,
	     map { $md{$_} } (qw(timestamp clientspec serverspec)));

    my (%sth, %sub_cs, %cache_cs, %sth_insert, %sth_lookup);

    $sth_insert{'stall'}= $dbh->prepare(
                "INSERT OR IGNORE
                        INTO stalls
                        (islandid, stallname) VALUES ($islandid, ?)
                ");
    $sth_lookup{'stall'}= $dbh->prepare(
                "SELECT stallid FROM stalls
			WHERE islandid == $islandid AND stallname == ?
                ");
    $sth_insert{'commod'}= $dbh->prepare(
                "INSERT OR IGNORE
                        INTO commods
                        (commodname) VALUES (?)
                ");
    $sth_lookup{'commod'}= $dbh->prepare(
                "SELECT commodid FROM commods
			WHERE commodname == ?
                ");

    foreach my $cs (qw(stall commod)) {
	$sub_cs{$cs}= sub {
	    my ($name)= @_;
	    my $r= $cache_cs{$cs}{$name};
	    return $r if defined $r;
	    $sth_lookup{$cs}->execute($name) or die;
	    ($r)= $sth_lookup{$cs}->fetchrow_array();
	    if (!defined $r) {
		$sth_insert{$cs}->execute($name);
		$sth_lookup{$cs}->execute($name) or die;
		($r)= $sth_lookup{$cs}->fetchrow_array();
		die unless defined $r;
	    }
	    $cache_cs{$cs}{$name}= $r;
	    return $r;
	};
    }
    my @v;

    my %sub_bs;
    foreach my $bs (qw(buy sell)) {
	my $sth= $dbh->prepare(
	       "INSERT INTO $bs
                       (commodid, stallid, islandid, price, qty)
                       VALUES (?,?,?,?,?);
               ");
	$sub_bs{$bs}= sub {
	    my ($priceix) = @_;
	    my $price= $v[$priceix];  return if !length $price;
	    my $qty= $v[$priceix+1];
	    $qty++ if $qty =~ s/^\>//;
	    $sth->execute($sub_cs{'commod'}($v[0]),
			  $sub_cs{'stall'}($v[1]),
			  $islandid,$price,$qty);
	};	    
    }

    while (<$pt>) {
	@v= check_tsv_line($_, \&bad_data_fail);
#	chomp;
#	@v= split /\t/, $_, -1;

	&{$sub_bs{'buy'}}(2);
	&{$sub_bs{'sell'}}(4);

#	print ".";
    }

    pipethrough_run_finish($pt, 'gunzip <$deduped_tsv.gz');

#    print "\n";
    db_chkcommit(0);

    # Warning!  Below runes are bogus.  Do not use NATURAL JOIN!
    # select * from ((buy natural join commods) natural join stalls) natural join islands;
    # select * from ((sell natural join commods) natural join stalls) natural join islands;

}

my $ok= eval {
    main();
    1;
};
my $err= $@;

$parser->filer->purge();

if (!$ok) {
    print STDERR "PROCESSING FAILED\n $@\n";
    exit 1;
}