X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=pctb%2Fcommod-email-processor;fp=pctb%2Fcommod-email-processor;h=8b38fcfddf5c7edd468d3bf144ecba2e233aab2e;hp=2f2231ba5b6831d89c18aa862fe18675fb6d6ab7;hb=9d525e44bd9642a72eb7acd81bd9956b014e3872;hpb=dd3abc97940e71298a764e8c5c0d0ce94e052ca6

diff --git a/pctb/commod-email-processor b/pctb/commod-email-processor
old mode 100644
new mode 100755
index 2f2231b..8b38fcf
--- 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,30 +46,35 @@
 
 use strict (qw(vars));
 
+use POSIX;
 use MIME::Parser;
 
+use Commods;
+
 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';
 
@@ -80,11 +85,34 @@ sub main () {
 
     my $mdh= $mdpart->open('r') or die;
     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);
-    
+    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');
+
+    while (<$pt>) {
+	my @v= check_tsv_line($_, \&bad_data_fail);
+	print "[",join('|',@v),"]\n";
+    }
+
+    pipethrough_run_finish($pt);
+}
+
+my $ok= eval {
+    main();
+    1;
+};
+my $err= $@;
+
+$parser->filer->purge();
+
+if (!$ok) {
+    print STDERR "PROCESSING FAILED\n $@\n";
+    exit 1;
+}