X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=pctb%2Fcommod-email-processor;h=28a7082ca640878c5fa46fcbf3dec8a0a8c81aa7;hb=e46db4903b59c52a73243e3541cf6eb77fd82b25;hp=2f2231ba5b6831d89c18aa862fe18675fb6d6ab7;hpb=dd3abc97940e71298a764e8c5c0d0ce94e052ca6;p=ypp-sc-tools.main.git

diff --git a/pctb/commod-email-processor b/pctb/commod-email-processor
old mode 100644
new mode 100755
index 2f2231b..28a7082
--- a/pctb/commod-email-processor
+++ b/pctb/commod-email-processor
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -
+#!/usr/bin/perl -w
 #
 # This script is invoked to process an email sent by the
 # commod-update-receiver Perl script.
@@ -46,45 +46,134 @@
 
 use strict (qw(vars));
 
+use POSIX;
 use MIME::Parser;
 
+use Commods;
+use CommodsDatabase;
+
 setlocale(LC_CTYPE, "en_GB.UTF-8");
-my $mp= new MIME::Parser;
+my $parser= new MIME::Parser;
 our $entity;
 
-sub find_part ($$) {
-    my ($filename, $type, $accepter) = @_
+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;
+	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= $mp->parse(\*STDIN);
+    $entity= $parser->parse(\*STDIN);
     my $eff_type= $entity->effective_type();
-    die "effective type $eff_type" unless $eff_type eq 'multipart/mixed';
+    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;
+    my $mdh= $mdpart->open('r') or die "failed to open metadata $!\n";
     my %md;
-    while (<$mdh>) {
+    while (defined($_= $mdh->getline())) {
 	m/^([a-z]+)\t(.*)$/ or next;
 	$md{$1}= $2;
     }
 
-    my $tsvpart= find_part('deduped.tsv.gz', 'application/octet-stream');
-    $tsvpart->binmode(1);
+    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_connect();
+
+    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_cs;
+    foreach my $cs (qw(commod stall)) {
+	$sth_cs{$cs}= $dbh->prepare(
+                "INSERT OR IGNORE
+                        INTO ${cs}s
+                        (${cs}id) VALUES (?)
+                ");
+    }
+
+    my %sth_bs;
+    foreach my $bs (qw(buy sell)) {
+	$sth_bs{$bs}= $dbh->prepare(
+	       "INSERT INTO $bs
+                       (commodid, islandid, stallid, price, qty)
+                       VALUES (
+		         (SELECT commodid FROM commods WHERE commodname = ?),
+		         $islandid,
+		         (SELECT stallid  FROM stalls  WHERE stallname = ?),
+		         ?, ?
+                       )
+               ");
+    }
+
+    while (<$pt>) {
+	my @v= check_tsv_line($_, \&bad_data_fail);
+
+	
+    }
+
+    pipethrough_run_finish($pt);
+
+}
+
+my $ok= eval {
+    main();
+    1;
+};
+my $err= $@;
+
+$parser->filer->purge();
+
+if (!$ok) {
+    print STDERR "PROCESSING FAILED\n $@\n";
+    exit 1;
+}