Can compact ids and remove obsolete commodities

diff --git a/yarrg/CommodsDatabase.pm b/yarrg/CommodsDatabase.pm
index 6ed0b742f6d3d3f2d9d00c78515de2cb6bc327b6..d978358e4460e70c6e6e676b53a93817550238d3 100644 (file)
--- a/yarrg/CommodsDatabase.pm
+++ b/yarrg/CommodsDatabase.pm
@@ -188,7 +188,7 @@ END
            nooutput(<<END);
 
  # Every row in dists and routes must refer to two existing rows in islands:
- SELECT * FROM $tab d LEFT JOIN islands ON (d.$end=islandid)
+ SELECT * FROM $tab d LEFT JOIN islands ON d.$end=islandid
        WHERE islandname IS NULL;
 
 END
@@ -198,7 +198,7 @@ END
 
  # Every pair of islands must have an entry in dists:
  SELECT * FROM islands ia JOIN islands ib LEFT JOIN dists
-       ON (ia.islandid=aiid and ib.islandid=biid)
+       ON ia.islandid=aiid and ib.islandid=biid
        WHERE dist IS NULL;
 
  # Every stall and upload must refer to an island:

diff --git a/yarrg/TODO b/yarrg/TODO
index 16f3874f283c98f61ead16fb469201a7028908a8..b6d80598ac23424925105de9672cb69c9861d90f 100644 (file)
--- a/yarrg/TODO
+++ b/yarrg/TODO
@@ -8,16 +8,9 @@ windows uploader
 DATABASE/DICTIONARY MANAGER
 ---------------------------
 
-eliminate black dye from live database
-
-eliminate spurious autoincrements in existing tables
-and condense islandids (just this once)
-
 when update rejected print better error message including
  broken commodity name
 
-notice commodities deleted from source-info and warn about them
-
 support Opal and Jade (currently there are some unicode problems)
 
 WEBSITE

diff --git a/yarrg/db-idempotent-populate b/yarrg/db-idempotent-populate
index 24dbf35c05b9fd3017007168bcdf1a998ce68adc..aa8026272f3727f77ccd7c740eb7da43040fe110 100755 (executable)
--- a/yarrg/db-idempotent-populate
+++ b/yarrg/db-idempotent-populate
@@ -45,6 +45,7 @@ if (@ARGV and $ARGV[0] eq '-D') {
 @ARGV==1 or die;
 my ($oceanname) = @ARGV;
 
+$|=1;
 
 #---------- setup ----------
 
@@ -140,8 +141,7 @@ END
     return unless @need_recreate;
     # yes:
 
-    print "    Recreating $table:\n";
-    print "        $_\n" foreach @need_recreate;
+    print "    Recreating $table: ", join('; ',@need_recreate);
 
     my $have_fields= join ',', @have_fields;
     my $have_field_specs= join ",\n", @have_field_specs;
@@ -163,12 +163,12 @@ $want_field_specs
 END
 
     #----- Do we need to compact ids ? -----
-    return unless
+    (print("\n"), return) unless
         defined $cpact_idfield
        and grep { m/^remove autoinc/ } @need_recreate;
     # yes:
 
-    print "        will compact\n";
+    print "; will compact.\n";
     unshift @$cpact_needupdates, [ $table ], [ $cpact_idfield ];
 
     push @need_compact, {
@@ -273,39 +273,34 @@ sub commodsortkey ($) {
 }
 
 {
-    my $insert= $dbh->prepare(<<'END')
+    my $insert= $dbh->prepare(<<'END');
  INSERT OR IGNORE INTO commods
      (unitmass,
       unitvolume,
       commodname)
      VALUES (?,?,?);
 END
-    ;
-    my $setsizes= $dbh->prepare(<<'END')
+    my $setsizes= $dbh->prepare(<<'END');
  UPDATE commods
      SET unitmass = ?,
          unitvolume = ?
      WHERE commodname = ?
 END
-    ;
-    my $setordval= $dbh->prepare(<<'END')
+    my $setordval= $dbh->prepare(<<'END');
  UPDATE commods
      SET ordval = ?
      WHERE commodname = ?
 END
-    ;
-    my $setclass= $dbh->prepare(<<'END')
+    my $setclass= $dbh->prepare(<<'END');
  UPDATE commods
      SET commodclass = ?
      WHERE commodname = ?
 END
-    ;
-    my $setinclass= $dbh->prepare(<<'END')
+    my $setinclass= $dbh->prepare(<<'END');
  UPDATE commods
      SET inclass = ?
      WHERE commodname = ?
 END
-    ;
     my %incl;
     foreach my $commod (sort {
                commodsortkey($a) cmp commodsortkey($b)
@@ -331,15 +326,60 @@ END
     db_doall(<<END);
  DELETE FROM commodclasses;
 END
-    my $addclass= $dbh->prepare(<<'END')
+    my $addclass= $dbh->prepare(<<'END');
  INSERT INTO commodclasses
      (commodclass, size)
      VALUES (?,?)
 END
-    ;
     foreach my $cl (sort keys %incl) {
        $addclass->execute($cl, $incl{$cl});    
     }
+
+    my $search= $dbh->prepare(<<'END');
+ SELECT commodname,commodid FROM commods;
+END
+    my %check;
+    foreach my $bs (qw(buy sell)) {
+       $check{$bs}= $dbh->prepare(<<END);
+ SELECT islandname,stallname,price,qty
+   FROM $bs
+   JOIN stalls USING (stallid)
+   JOIN islands ON ($bs.islandid = islands.islandid)
+   WHERE commodid = ? LIMIT 1
+END
+    }
+    my $delete= $dbh->prepare(<<'END');
+ DELETE FROM commods WHERE commodid = ?
+END
+    $search->execute();
+    my $any=0;
+    while (my $row= $search->fetchrow_hashref()) {
+       next if defined $commods{$row->{'commodname'}};
+       print $any++ ? '; ' : "    Dropping old commodities: ",
+             $row->{'commodname'};
+       foreach my $bs (qw(buy sell)) {
+           $check{$bs}->execute($row->{'commodid'});
+           my $problem= $check{$bs}->fetchrow_hashref();
+           if ($problem) {
+               print "\n";
+               die <<END
+
+FATAL ERROR
+    Removed commodity
+       $row->{'commodid'}
+       $row->{'commodname'}
+    but
+       $bs
+       $problem->{'islandname'}
+       $problem->{'stallname'}
+       $problem->{'qty'} at $problem->{'price'}
+END
+            }
+       }
+       $delete->execute($row->{'commodid'});
+    }
+    print ".\n" if $any;
+    db_check_referential_integrity();
 }
 
 
@@ -361,10 +401,69 @@ END
 }
 
 
+#---------- compact IDs ----------
+
+sub getminmax ($$$) {
+    my ($tab,$minmax,$f) = @_;
+    my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab");
+    $sth->execute();
+    my ($val)= $sth->fetchrow_array();
+    return defined($val) ? $val : '?';
+}
+
+foreach my $cp (@need_compact) {
+    print "    Compacting $cp->{Table}";
+    my $tab= $cp->{Table};
+    my $id= $cp->{Id};
+    my $tmp_field_specs= $cp->{FieldSpecs};
+    my $fields= join ',', @{$cp->{Fields}};
+    $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
+       die "$tab $tmp_field_specs ?";
+    db_doall(<<END);
+ CREATE TABLE aside_$tab (
+       new_$id         INTEGER PRIMARY KEY NOT NULL,
+$tmp_field_specs
+ );
+ INSERT INTO aside_$tab ($fields)
+       SELECT $fields
+       FROM $tab;
+END
+    my $oldmax= getminmax($tab,'max',$id);
+    my $offset= $oldmax+1;
+    
+    printf(" %s %s..%d=>1..%d:",
+          $cp->{Id},
+          getminmax($tab,'min',$id),
+          $oldmax,
+          getminmax("aside_$tab",'max',"new_$id"));
+    my @updates= @{ $cp->{Updates} };
+    while (@updates) {
+       my $utabs= shift @updates;
+       my $ufields= shift @updates;
+       foreach my $utab (@$utabs) {
+           printf(" %s",$utab);
+           my $fh= '.';
+           foreach my $ufield (@$ufields) {
+               printf("%s%s",$fh,$ufield); $fh=',';
+               db_doall(<<END);
+ UPDATE $utab
+    SET $ufield = $offset +
+        (SELECT new_$id FROM aside_$tab
+          WHERE aside_$tab.$id = $utab.$ufield);
+ UPDATE $utab
+    SET $ufield = $ufield - $offset;
+END
+            }
+       }
+    }
+    print "\n";
+}
+
 #---------- put it all into effect ----------
+
 db_chkcommit();
+
 {
     local $dbh->{AutoCommit} = 1;
-    print "    Vacuuming.\n";
     $dbh->do('VACUUM');
 }

diff --git a/yarrg/devel-notes b/yarrg/devel-notes
index f4f6066788c045383e68aac313b237c156e65d85..430523adfd3c9e069b426eebf7c30cf61c70f66d 100644 (file)
--- a/yarrg/devel-notes
+++ b/yarrg/devel-notes
@@ -1,21 +1,4 @@
 
-removing an obsolete commodity:
-
-  select * from (select * from sell union select * from buy) left outer join commods using (commodid) where commods.commodname = 'Black dye' limit 10;
-
-if that produces no output then:
-
-  begin;
-  delete from commods where commodname like 'Black dye';
-  select * from (select * from sell union select * from buy) left outer join commods using (commodid) where commods.commodname is null limit 10;
-
-and if that produces no output then:
-  commit;
-otherwise
-  rollback;
-
-=======================================
-
 ceb's example route:
   alpha,byrne,papaya,turtle,jorvik,luthien