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 b7883fc69e574e9331c30c80ff76cf810bb68f77..d2f0e819f6ef8c0f41626424fe13beb624d4f088 100755 (executable)
--- a/pctb/commod-email-processor
+++ b/pctb/commod-email-processor
@@ -56,6 +56,8 @@ 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()) {
@@ -132,37 +134,78 @@ sub main () {
             $islandid, $mid,
             map { $md{$_} } (qw(timestamp clientspec serverspec)));
 
-    my %sth_cs;
-    foreach my $cs (qw(commod stall)) {
-       $sth_cs{$cs}= $dbh->prepare(
+    my (%sth, %sub_cs, %cache_cs, %sth_insert);
+
+    $sth_insert{'stall'}= $dbh->prepare(
                 "INSERT OR IGNORE
-                        INTO ${cs}s
-                        (${cs}id) VALUES (?)
+                        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 %sth_bs;
+    my %sub_bs;
     foreach my $bs (qw(buy sell)) {
-       $sth_bs{$bs}= $dbh->prepare(
+       my $sth= $dbh->prepare(
               "INSERT INTO $bs
-                       (commodid, islandid, stallid, price, qty)
-                       VALUES (
-                        (SELECT commodid FROM commods WHERE commodname = ?),
-                        $islandid,
-                        (SELECT stallid  FROM stalls  WHERE stallname = ?),
-                        ?, ?
-                       )
+                       (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);
+       @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, '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 {