cache commodid and stallid in Perl

[ypp-sc-tools.db-test.git] / pctb / commod-email-processor

diff --git a/pctb/commod-email-processor b/pctb/commod-email-processor
index 8b38fcfddf5c7edd468d3bf144ecba2e233aab2e..d2f0e819f6ef8c0f41626424fe13beb624d4f088 100755 (executable)
--- a/pctb/commod-email-processor
+++ b/pctb/commod-email-processor
@@ -50,11 +50,14 @@ use POSIX;
 use MIME::Parser;
 
 use Commods;
+use CommodsDatabase;
 
 setlocale(LC_CTYPE, "en_GB.UTF-8");
 my $parser= new MIME::Parser;
 our $entity;
 
+$|=1;
+
 sub find_part ($$$) {
     my ($filename, $type, $accepter) = @_;
     foreach my $part ($entity->parts()) {
@@ -76,32 +79,133 @@ sub main () {
 
     $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 (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_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, %sub_cs, %cache_cs, %sth_insert);
+
+    $sth_insert{'stall'}= $dbh->prepare(
+                "INSERT OR IGNORE
+                        INTO stalls
+                        (islandid, stallname) VALUES ($islandid, ?)
+                ");
+    $sth_insert{'commods'}= $dbh->prepare(
+                "INSERT OR IGNORE
+                        INTO commods
+                        (commodname) VALUES (?)
+                ");
+
+    foreach my $cs (qw(stall commod)) {
+       my $sth_lookup= $dbh->prepare(
+                "SELECT ${cs}id FROM ${cs}s WHERE ${cs}name == ?;
+                ");
+       $sub_cs{$cs}= sub {
+           my ($name)= @_;
+           my $r= $cache_cs{$cs}{$name};
+           return $r if defined $r;
+           $sth_lookup->execute($name) or die;
+           ($r)= $sth_lookup->fetchrow_array();
+           if (!defined $r) {
+               $sth_insert{$cs}->execute($name);
+               $sth_lookup->execute($name) or die;
+               ($r)= $sth_lookup->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>) {
-       my @v= check_tsv_line($_, \&bad_data_fail);
-       print "[",join('|',@v),"]\n";
+       @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);
+    pipethrough_run_finish($pt, 'gunzip <$deduped_tsv.gz');
+
+    print "\n";
+    $dbh->commit();
+
+    # 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 {