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

# Emails are:
#  multipart/mixed, containing
#   text/plain; name="metadata"; charset="utf-8"
#   Content-Disposition: inline; filename="metadata"
#     ocean\t<ocean>		canonical mixed case
#     island\t<island>		canonical mixed case
#     timestamp\t<digits>	time_t (non-leap secs since start of 1970 UTC)
#     clientname\t<cname>	may contain spaces
#     clientversion\t<cversion>	may contain spaces
#     clientfixes\t<cfixes>	space-delimited list
#     clientspec\t<cspec>	<cname>\t<cversion>\t<cfixes>
#     servername\t<sname>	may contain spaces
#     serverversion\t<sversion>	may contain spaces
#     serverfixes\t<sfixes>	space-delimited list
#     serverspec\t<sspec>	<sname>\t<serverversion>\t<serverfixes>
#   application/octet-stream; name="deduped.tsv.gz"
#   Content-Disposition: attachment; filename="deduped.tsv.gz"
#     <base64>

use strict (qw(vars));

use MIME::Parser;

setlocale(LC_CTYPE, "en_GB.UTF-8");
my $mp= new MIME::Parser;
our $entity;

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 unless &$accepter($h) if defined $accepter;
	return $part;
    }
    die "no appropriate part with name $filename and type $type";
}

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

    $entity= $mp->parse(\*STDIN);
    my $eff_type= $entity->effective_type();
    die "effective type $eff_type" 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;
    my %md;
    while (<$mdh>) {
	m/^([a-z]+)\t(.*)$/ or next;
	$md{$1}= $2;
    }

    my $tsvpart= find_part('deduped.tsv.gz', 'application/octet-stream');
    $tsvpart->binmode(1);