-#!/usr/bin/perl -
+#!/usr/bin/perl -w
#
# This script is invoked to process an email sent by the
# commod-update-receiver Perl script.
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';
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;
+}