Rework of commodity classes and ordering

 * Commodity classes in source-info.txt have _'s in not -'s, in
   case in the future we have classes which actually have _'s.
 * Table dumping functionality used by referential integrity check
   error reporter broken out into new functions dumptab_*
 * Complete rework of the commodclass and ordering schema
 * Multiple -D options on db-idempotent-populate increase trace level
 * Table recreation overhauled and improved:
    - temporary table now contains all columns of intended table
      (but with NOT NULL, PRIMARY KEY and UNIQUE constraints removed)
    - copy-back deferred until we have finished updating info;
      general info update works on the temporary table; this is
      so we can add a column which is NOT NULL
    - db-idempotent-update's index creation and first referential
      integrity check are deferred until after all new data has been
      incorporated
    - id compaction temporary table has a different name to the
      table recreation temporary table just in case of future
      accidents
    - table recreation copy-back dumps the entire data for the
      temporary table if the copy-back insert fails
    - all table creation in schema setup is done with table()
    - index creation is deferred until
 * Fix bugs in commodity class system

diff --git a/yarrg/Commods.pm b/yarrg/Commods.pm
index b7b18a615a2384e0b2dd51b5e0bc3d58fcde916e..91781126d319a32c5f0a5d15f3ec499c82af1fbb 100644 (file)
--- a/yarrg/Commods.pm
+++ b/yarrg/Commods.pm
@@ -102,7 +102,7 @@ my %colours; # eg $colours{'c'}{'black'}= $sources
 my (@rawcm, @nocm); # eg $rawcm[0]='fine rum'; $rawcm[1]='fine %c cloth'
 
 my %colour_ordvals; # $colour_ordvals{'c'}{'green'}= '30';
 my (@rawcm, @nocm); # eg $rawcm[0]='fine rum'; $rawcm[1]='fine %c cloth'
 
 my %colour_ordvals; # $colour_ordvals{'c'}{'green'}= '30';

-my %commodclasses; # $commodclasses{'dye'}= '3';
+our %commodclasses; # $commodclasses{'dye'}= '3';

 
 # IMPORTANT
 #  when extending the format of source-info in a non-backward
 
 # IMPORTANT
 #  when extending the format of source-info in a non-backward


@@ -137,7 +137,7 @@ sub parse_info1 ($$$) {
            @ctx= (sub { push @nocm, lc $_; });
        } elsif (m/^commodclasses$/) {
            @ctx= (sub {
            @ctx= (sub { push @nocm, lc $_; });
        } elsif (m/^commodclasses$/) {
            @ctx= (sub {

-               die unless m/^\*([-a-z]+)$/;
+               die unless m/^\*([_a-z]+)$/;

                $commodclasses{$1}= scalar keys %commodclasses;
            });
        } elsif (m/^ocean (\w+)$/) {
                $commodclasses{$1}= scalar keys %commodclasses;
            });
        } elsif (m/^ocean (\w+)$/) {


@@ -213,7 +213,7 @@ sub parse_info1 ($$$) {
                    $c->{Mass}= $1 * ($2 ? 1000 : 1);
                } elsif ($prop =~ m/^([1-9]\d*)l$/) {
                    $c->{Volume}= $1 * 1000;
                    $c->{Mass}= $1 * ($2 ? 1000 : 1);
                } elsif ($prop =~ m/^([1-9]\d*)l$/) {
                    $c->{Volume}= $1 * 1000;

-               } elsif ($prop =~ m/^\*([-a-z]+)$/) {
+               } elsif ($prop =~ m/^\*([_a-z]+)$/) {

                    $c->{Class}= $1;
                    die "$1" unless exists $commodclasses{$1};
                    $ordclassval= 1e7 + $commodclasses{$1} * 1e7;
                    $c->{Class}= $1;
                    die "$1" unless exists $commodclasses{$1};
                    $ordclassval= 1e7 + $commodclasses{$1} * 1e7;


@@ -224,6 +224,7 @@ sub parse_info1 ($$$) {
                    die "unknown property $prop for $ucname";
                }
            }
                    die "unknown property $prop for $ucname";
                }
            }

+           $c->{ClassOrdval}= $ordclassval;

            if (defined $ordbase && defined $ordval && defined $ordclassval) {
                my $ordvalout= $ordbase + $ordval + $ordclassval;
                $c->{Ordval}= $ordvalout;
            if (defined $ordbase && defined $ordval && defined $ordclassval) {
                my $ordvalout= $ordbase + $ordval + $ordclassval;
                $c->{Ordval}= $ordvalout;

diff --git a/yarrg/CommodsDatabase.pm b/yarrg/CommodsDatabase.pm
index d978358e4460e70c6e6e676b53a93817550238d3..e14c0eb401e10a0f299b9b2c0564ce69d492266a 100644 (file)
--- a/yarrg/CommodsDatabase.pm
+++ b/yarrg/CommodsDatabase.pm
@@ -46,6 +46,7 @@ BEGIN {
     @EXPORT      = qw(&db_setocean &db_writer &db_connect $dbh
                      &db_filename &db_doall &db_onconflict
                      &dbr_filename &dbr_connect &db_connect_core
     @EXPORT      = qw(&db_setocean &db_writer &db_connect $dbh
                      &db_filename &db_doall &db_onconflict
                      &dbr_filename &dbr_connect &db_connect_core

+                     &dumptab_head &dumptab_row_hashref

                      &db_chkcommit &db_check_referential_integrity);
     %EXPORT_TAGS = ( );
 
                      &db_chkcommit &db_check_referential_integrity);
     %EXPORT_TAGS = ( );
 


@@ -120,6 +121,22 @@ sub db_doall ($) {
     }
 }
 
     }
 }
 

+#---------- table dump helper ----------
+
+sub dumptab_head ($$$) {
+    my ($fh,$w,$cols) = @_;
+    printf $fh "|%-${w}s", $_ foreach @$cols;  print $fh "|\n";
+    print $fh "+",('-'x$w)  foreach @$cols;    print $fh "+\n";
+}
+
+sub dumptab_row_hashref ($$$$) {
+    my ($fh,$w,$cols,$row) = @_;
+    printf $fh "|%-$w.${w}s",
+          (defined $row->{$_} ? $row->{$_} : 'NULL')
+       foreach @$cols;
+    print $fh "\n";
+}
+

 #---------- referential integrity constraints ----------
 
 # SQLite doesn't support foreign key constraints so we do it by steam:
 #---------- referential integrity constraints ----------
 
 # SQLite doesn't support foreign key constraints so we do it by steam:


@@ -147,14 +164,10 @@ sub nooutput ($) {
            if (!$ecount++) {
                print STDERR "REFERENTIAL INTEGRITY ERROR\n";
                print STDERR "\n$etxt\n $stmt\n\n";
            if (!$ecount++) {
                print STDERR "REFERENTIAL INTEGRITY ERROR\n";
                print STDERR "\n$etxt\n $stmt\n\n";

-               printf STDERR "|%-${w}s", $_ foreach @cols; print STDERR "|\n";
-               print STDERR "+",('-'x$w)  foreach @cols; print STDERR "+\n";
+               dumptab_head(\*STDERR,$w,\@cols);

            }
            if ($ecount>5) { print STDERR "...\n"; last; }
            }
            if ($ecount>5) { print STDERR "...\n"; last; }

-           printf STDERR "|%-$w.${w}s",
-               (defined $row->{$_} ? $row->{$_} : 'NULL')
-                   foreach @cols;
-           print STDERR "\n";
+           dumptab_row_hashref(\*STDERR,$w,\@cols,$row);

        }
        next unless $ecount;
        
        }
        next unless $ecount;
        


@@ -205,20 +218,35 @@ END
  SELECT * FROM stalls NATURAL LEFT JOIN islands WHERE islandname IS NULL;
  SELECT * FROM uploads NATURAL LEFT JOIN islands WHERE islandname IS NULL;
 
  SELECT * FROM stalls NATURAL LEFT JOIN islands WHERE islandname IS NULL;
  SELECT * FROM uploads NATURAL LEFT JOIN islands WHERE islandname IS NULL;
 

- # Every commod which refers to a commodclass refers to an existing one:
- SELECT * FROM commods WHERE commodclass NOT IN
-       (SELECT commodclass FROM commodclasses);
-
- # There are no empty commodclasses:
+ # Every commod must refers to a commodclass and vice versa:
+ SELECT * FROM commods NATURAL LEFT JOIN commodclasses
+       WHERE commodclass IS NULL;

  SELECT * FROM commodclasses NATURAL LEFT JOIN commods
        WHERE commodname IS NULL;
 
  SELECT * FROM commodclasses NATURAL LEFT JOIN commods
        WHERE commodname IS NULL;
 

- # Ordvals which are not zero are unique:
- SELECT ordval,count(*) FROM COMMODS
-       WHERE ordval IS NOT NULL AND ordval != 0
+ # Ordvals which are not commodclass ordvals are unique:
+ SELECT ordval,count(*),commodname,commodid,posinclass
+       FROM commods
+       WHERE posinclass > 0

        GROUP BY ordval
        HAVING count(*) > 1;
 
        GROUP BY ordval
        HAVING count(*) > 1;
 

+ # For every class, posinclass is dense from 1 to maxposinclass,
+ # apart from the commods for which it is zero.
+ SELECT commodclass,commodclassid,posinclass,count(*)
+       FROM commods NATURAL JOIN commodclasses
+       WHERE posinclass > 0
+       GROUP BY commodclassid,posinclass
+       HAVING count(*) > 1;
+ SELECT commodclass,commodclassid,count(*)
+       FROM commods NATURAL JOIN commodclasses
+       WHERE posinclass > 0
+       GROUP BY commodclassid
+       HAVING count(*) != maxposinclass;
+ SELECT *
+       FROM commods NATURAL JOIN commodclasses
+       WHERE posinclass < 0 OR posinclass > maxposinclass;
+

 END
 }
 
 END
 }
 

diff --git a/yarrg/db-idempotent-populate b/yarrg/db-idempotent-populate
index aa8026272f3727f77ccd7c740eb7da43040fe110..691f77ba8af294d0f8e47e3463137df30d2205f5 100755 (executable)
--- a/yarrg/db-idempotent-populate
+++ b/yarrg/db-idempotent-populate
@@ -36,9 +36,9 @@ use DBI;
 use Commods;
 use CommodsDatabase;
 
 use Commods;
 use CommodsDatabase;
 

-my $trace;
-if (@ARGV and $ARGV[0] eq '-D') {
-       $trace=1;
+my $trace=0;
+while (@ARGV and $ARGV[0] eq '-D') {
+       $trace++;

        shift @ARGV;
 }
 
        shift @ARGV;
 }
 


@@ -61,6 +61,9 @@ $dbh->trace(1) if $trace;
 #---------- schema update code ----------
 
 our @need_compact;
 #---------- schema update code ----------
 
 our @need_compact;

+our @need_transfer_back;
+
+our %table;

 
 sub table ($$) {
     my ($table, $fields) = @_;
 
 sub table ($$) {
     my ($table, $fields) = @_;


@@ -126,44 +129,66 @@ END
     $check->finish();
 
     my @have_fields;
     $check->finish();
 
     my @have_fields;

+    my @aside_fields;

     my @have_field_specs;
     my @have_field_specs;

+    my @aside_field_specs;

 
     foreach my $f (@want_fields) {
        if ($have_fields{$f}) {
            push @have_fields, $f;
            push @have_field_specs, $want_field_specs{$f};
        } else {
 
     foreach my $f (@want_fields) {
        if ($have_fields{$f}) {
            push @have_fields, $f;
            push @have_field_specs, $want_field_specs{$f};
        } else {

+           my $aside= $want_field_specs{$f};
+           $aside =~ s/\bUNIQUE\b//i;
+           $aside =~ s/\bNOT\s*NULL\b//i;
+           $aside =~ s/\bPRIMARY\s*KEY\b//i;
+           $aside =~ s/\s+$//;
+           push @aside_fields, $f;
+           push @aside_field_specs, $aside;

            push @need_recreate, "field $f";
        }
     }
 
     #----- Do we need to recreate ? -----
            push @need_recreate, "field $f";
        }
     }
 
     #----- Do we need to recreate ? -----

-    return unless @need_recreate;
-    # yes:
+    if (!@need_recreate) {
+       $table{$table}= $table;
+       return;
+    }
+    #----- Yes, recreate: -----

 
     print "    Recreating $table: ", join('; ',@need_recreate);
 
     print "    Recreating $table: ", join('; ',@need_recreate);

+    $table{$table}= "aside_$table";

 
     my $have_fields= join ',', @have_fields;
 
     my $have_fields= join ',', @have_fields;

+    my $aside_fields= join ',', @have_fields, @aside_fields;

     my $have_field_specs= join ",\n", @have_field_specs;
     my $have_field_specs= join ",\n", @have_field_specs;

+    my $aside_field_specs= join ",\n", @have_field_specs, @aside_field_specs;

 
     db_doall(<<END);
  CREATE TEMPORARY TABLE aside_$table (
 
     db_doall(<<END);
  CREATE TEMPORARY TABLE aside_$table (

-$have_field_specs
+$aside_field_specs

        );
        );

- INSERT INTO aside_$table SELECT $have_fields FROM $table;
+ INSERT INTO aside_$table ($have_fields) 
+       SELECT $have_fields FROM $table;

 
  DROP TABLE $table;
 
  DROP TABLE $table;

+END
+
+    push @need_transfer_back, {
+       Table => $table,
+       Sql => <<END

  CREATE TABLE $table (
 $want_field_specs
        );
 
  CREATE TABLE $table (
 $want_field_specs
        );
 

- INSERT INTO $table ($have_fields) SELECT $have_fields FROM aside_$table;
+ INSERT INTO $table ($aside_fields) SELECT $aside_fields FROM aside_$table;

 
  DROP TABLE aside_$table;
 END
 
  DROP TABLE aside_$table;
 END

-
+    };
+    

     #----- Do we need to compact ids ? -----
     #----- Do we need to compact ids ? -----

-    (print("\n"), return) unless
+    (print(".\n"), return) unless

         defined $cpact_idfield
        and grep { m/^remove autoinc/ } @need_recreate;
     # yes:
         defined $cpact_idfield
        and grep { m/^remove autoinc/ } @need_recreate;
     # yes:


@@ -184,19 +209,14 @@ END
 #---------- actual schema ----------
 
 foreach my $bs (qw(buy sell)) {
 #---------- actual schema ----------
 
 foreach my $bs (qw(buy sell)) {

-    db_doall(<<END)
- CREATE TABLE IF NOT EXISTS $bs (
-       commodid        INTEGER                 NOT NULL,
-       islandid        INTEGER                 NOT NULL,
-       stallid         INTEGER                 NOT NULL,
-       price           INTEGER                 NOT NULL,
-       qty             INTEGER                 NOT NULL,
-       PRIMARY KEY (commodid, islandid, stallid)
- );
- CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
- CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
+    table($bs,<<END);
+       commodid        INTEGER                 NOT NULL
+       islandid        INTEGER                 NOT NULL
+       stallid         INTEGER                 NOT NULL
+       price           INTEGER                 NOT NULL
+       qty             INTEGER                 NOT NULL
+       + PRIMARY KEY (commodid, islandid, stallid)

 END
 END

-    ;

 }
 
 table_maycompact('commods', 'commodid',
 }
 
 table_maycompact('commods', 'commodid',


@@ -206,9 +226,9 @@ table_maycompact('commods', 'commodid',
        commodname      TEXT    UNIQUE          NOT NULL
        unitmass        INTEGER
        unitvolume      INTEGER
        commodname      TEXT    UNIQUE          NOT NULL
        unitmass        INTEGER
        unitvolume      INTEGER

-       ordval          INTEGER
-       commodclass     TEXT
-       inclass         INTEGER
+       commodclassid   INTEGER                 NOT NULL
+       ordval          INTEGER                 NOT NULL
+       posinclass      INTEGER                 NOT NULL

 END
 
 table_maycompact('islands', 'islandid',
 END
 
 table_maycompact('islands', 'islandid',


@@ -228,128 +248,149 @@ table('stalls', <<END);
 END
 
 table('commodclasses', <<END);
 END
 
 table('commodclasses', <<END);

-       commodclass     TEXT    PRIMARY KEY     NOT NULL
-       size            INTEGER
+       commodclassid   INTEGER PRIMARY KEY     NOT NULL
+       commodclass     TEXT    UNIQUE          NOT NULL
+       maxposinclass   INTEGER                 NOT NULL

 END
 
 END
 

-db_doall(<<END)
- CREATE TABLE IF NOT EXISTS uploads (
-       islandid        INTEGER PRIMARY KEY     NOT NULL,
-       timestamp       INTEGER                 NOT NULL,
-       message         TEXT                    NOT NULL,
-       clientspec      TEXT                    NOT NULL,
+table('uploads', <<END);
+       islandid        INTEGER PRIMARY KEY     NOT NULL
+       timestamp       INTEGER                 NOT NULL
+       message         TEXT                    NOT NULL
+       clientspec      TEXT                    NOT NULL

        serverspec      TEXT                    NOT NULL
        serverspec      TEXT                    NOT NULL

- );
- CREATE TABLE IF NOT EXISTS dists (
-       aiid            INTEGER                 NOT NULL,
-       biid            INTEGER                 NOT NULL,
-       dist            INTEGER                 NOT NULL,
-       PRIMARY KEY (aiid, biid)
- );
- CREATE TABLE IF NOT EXISTS routes (
-       aiid            INTEGER                 NOT NULL,
-       biid            INTEGER                 NOT NULL,
-       dist            INTEGER                 NOT NULL,
-       PRIMARY KEY (aiid, biid)
- );
- CREATE TABLE IF NOT EXISTS vessels (
-       name            TEXT                    NOT NULL,
-       mass            INTEGER                 NOT NULL,
-       volume          INTEGER                 NOT NULL,
-       shot            INTEGER                 NOT NULL,
-       PRIMARY KEY (name)
- );

 END
 END

-    ;
+
+table('dists', <<END);
+       aiid            INTEGER                 NOT NULL
+       biid            INTEGER                 NOT NULL
+       dist            INTEGER                 NOT NULL
+       + PRIMARY KEY (aiid, biid)
+END
+
+table('routes', <<END);
+       aiid            INTEGER                 NOT NULL
+       biid            INTEGER                 NOT NULL
+       dist            INTEGER                 NOT NULL
+       + PRIMARY KEY (aiid, biid)
+END
+
+table('vessels', <<END);
+       name            TEXT                    NOT NULL
+       mass            INTEGER                 NOT NULL
+       volume          INTEGER                 NOT NULL
+       shot            INTEGER                 NOT NULL
+       + PRIMARY KEY (name)
+END

 
 
 #---------- commodity list ----------
 
 sub commodsortkey ($) {
     my ($commod) = @_;
 
 
 #---------- commodity list ----------
 
 sub commodsortkey ($) {
     my ($commod) = @_;

-    my $ordval= $commods{$commod}{Ordval};
-    return sprintf "B %20d", $ordval if defined $ordval;
-    return sprintf "A %s", $commod;
+    return $commods{$commod}{Ordval} ||
+          $commods{$commod}{ClassOrdval};
+}
+sub commods_ordered () {
+    sort {
+       commodsortkey($a) <=> commodsortkey($b);
+    } keys %commods;

 }
 
 }
 

+our %posincl;
+

 {
 {

-    my $insert= $dbh->prepare(<<'END');
- INSERT OR IGNORE INTO commods
-     (unitmass,
-      unitvolume,
-      commodname)
-     VALUES (?,?,?);
-END
-    my $setsizes= $dbh->prepare(<<'END');
- UPDATE commods
-     SET unitmass = ?,
-         unitvolume = ?
-     WHERE commodname = ?
-END
-    my $setordval= $dbh->prepare(<<'END');
- UPDATE commods
-     SET ordval = ?
-     WHERE commodname = ?
+    my %classorderedcount;
+
+    foreach my $cl (keys %commodclasses) {
+       $classorderedcount{$cl}= 0;
+    }
+    foreach my $commod (commods_ordered()) {
+       my $cl= $commods{$commod}{Class};
+       die "no class for commodity $commod" unless defined $cl;
+
+       my $clid= $commodclasses{$cl};
+       die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid;
+
+       if (defined $commods{$commod}{Ordval}) {
+           $posincl{$commod}= ++$classorderedcount{$cl};
+       } else {
+           $posincl{$commod}= 0;
+       }
+    }
+
+    db_doall(<<END);
+ DELETE FROM $table{commodclasses};

 END
 END

-    my $setclass= $dbh->prepare(<<'END');
- UPDATE commods
-     SET commodclass = ?
-     WHERE commodname = ?
+    my $addclass= $dbh->prepare(<<END);
+ INSERT INTO $table{commodclasses}
+     (commodclassid, commodclass, maxposinclass)
+     VALUES (?,?,?)

 END
 END

-    my $setinclass= $dbh->prepare(<<'END');
- UPDATE commods
-     SET inclass = ?
+    foreach my $cl (sort keys %commodclasses) {
+       my $clname= $cl;
+       $clname =~ s/_/ /g;
+       $addclass->execute($commodclasses{$cl}+1,
+                          ucfirst $clname,
+                          $classorderedcount{$cl});
+    }
+}
+
+{
+    my @valuefields= qw(
+                       unitmass
+                       unitvolume
+                       commodclassid
+                       ordval
+                       posinclass
+                       );
+    my $insert= $dbh->prepare("
+ INSERT OR IGNORE INTO $table{commods}
+      ( commodname,
+       ".join(",
+       ", @valuefields)." )
+     VALUES (?,".join(',', map {'?'} @valuefields).")
+");
+    my $update= $dbh->prepare("
+ UPDATE $table{commods}
+     SET ".join(",
+       ", map { "$_ = ?" } @valuefields)."

      WHERE commodname = ?
      WHERE commodname = ?

-END
-    my %incl;
-    foreach my $commod (sort {
-               commodsortkey($a) cmp commodsortkey($b)
-           } keys %commods) {
+");
+    foreach my $commod (commods_ordered()) {

        my $c= $commods{$commod};
         die "no mass for $commod" unless defined $c->{Mass};
         die "no volume for $commod" unless defined $c->{Volume};
        
        my $c= $commods{$commod};
         die "no mass for $commod" unless defined $c->{Mass};
         die "no volume for $commod" unless defined $c->{Volume};
        

-       my @qa= ($c->{Mass}, $c->{Volume}, $commod);
-       $insert->execute(@qa);
-       $setsizes->execute(@qa);
-       $setordval->execute($c->{Ordval} || 0, $commod);

        my $cl= $c->{Class};
        my $cl= $c->{Class};

-       $setclass->execute($cl, $commod);
-
-       if (defined $c->{Ordval} and defined $cl) {
-           $incl{$cl}++;
-           $setinclass->execute($incl{$cl}, $commod);
-       } elsif (defined $cl) {
-           $incl{$cl} += 0;
-       }
-    }
-    db_doall(<<END);
- DELETE FROM commodclasses;
-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 $clid= $commodclasses{$cl}+1;
+
+       my @valuevalues= (
+                         $c->{Mass},
+                         $c->{Volume},
+                         $clid,
+                         commodsortkey($commod),
+                         $posincl{$commod}
+                         );
+       $insert->execute($commod, @valuevalues);
+       $update->execute(@valuevalues, $commod);

     }
 
     }
 

-    my $search= $dbh->prepare(<<'END');
- SELECT commodname,commodid FROM commods;
+    my $search= $dbh->prepare(<<END);
+ SELECT commodname,commodid FROM $table{commods};

 END
     my %check;
     foreach my $bs (qw(buy sell)) {
        $check{$bs}= $dbh->prepare(<<END);
  SELECT islandname,stallname,price,qty
 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)
+   FROM $table{$bs}
+   JOIN $table{stalls} USING (stallid)
+   JOIN $table{islands} ON ($bs.islandid = $table{islands}.islandid)

    WHERE commodid = ? LIMIT 1
 END
     }
    WHERE commodid = ? LIMIT 1
 END
     }

-    my $delete= $dbh->prepare(<<'END');
- DELETE FROM commods WHERE commodid = ?
+    my $delete= $dbh->prepare(<<END);
+ DELETE FROM $table{commods} WHERE commodid = ?

 END
     $search->execute();
     my $any=0;
 END
     $search->execute();
     my $any=0;


@@ -379,15 +420,14 @@ END
        $delete->execute($row->{'commodid'});
     }
     print ".\n" if $any;
        $delete->execute($row->{'commodid'});
     }
     print ".\n" if $any;

-    db_check_referential_integrity();

 }
 
 }
 

-

 #---------- vessel types ----------
 {
 #---------- vessel types ----------
 {

-    my $idempotent= $dbh->prepare(<<'END')
- INSERT OR REPLACE INTO vessels (name, shot, mass, volume)
-                         VALUES (?,?,?,?)
+    my $idempotent= $dbh->prepare(<<END)
+ INSERT OR REPLACE INTO $table{vessels}
+       (name, shot, mass, volume)
+       VALUES (?,?,?,?)

 END
     ;
     foreach my $name (sort keys %vessels) {
 END
     ;
     foreach my $name (sort keys %vessels) {


@@ -400,6 +440,44 @@ END
     }
 }
 
     }
 }
 

+#---------- transfer data back from any recreated tables ----------
+
+foreach my $tb (@need_transfer_back) {
+    my $tab= $tb->{Table};
+    print "    Retransferring $tab...";
+
+    if (!eval {
+       db_doall($tb->{Sql});
+       1;
+    }) {
+       my $emsg= $@;
+       my $w=20;
+       print STDERR "\n=== $tab retransfer failed, dumping:\n";
+       my $dumph= $dbh->prepare("SELECT * FROM aside_$tab");
+       $dumph->execute();
+       my @cols= @{ $dumph->{NAME_lc} };
+       dumptab_head(\*STDERR,$w,\@cols);
+       my $row;
+       while ($row= $dumph->fetchrow_hashref()) {
+           dumptab_row_hashref(\*STDERR,$w,\@cols,$row);
+       }
+       die "\n$emsg";
+    }
+    print "\n";
+    $table{$tab}= $tab;
+}
+
+#---------- create indices ----------
+
+foreach my $bs (qw(buy sell)) {
+    db_doall(<<END)
+ CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
+ CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
+END
+    ;
+}
+
+db_check_referential_integrity();

 
 #---------- compact IDs ----------
 
 
 #---------- compact IDs ----------
 


@@ -420,11 +498,11 @@ foreach my $cp (@need_compact) {
     $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
        die "$tab $tmp_field_specs ?";
     db_doall(<<END);
     $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
        die "$tab $tmp_field_specs ?";
     db_doall(<<END);

- CREATE TABLE aside_$tab (
+ CREATE TEMPORARY TABLE idlookup_$tab (

        new_$id         INTEGER PRIMARY KEY NOT NULL,
 $tmp_field_specs
  );
        new_$id         INTEGER PRIMARY KEY NOT NULL,
 $tmp_field_specs
  );

- INSERT INTO aside_$tab ($fields)
+ INSERT INTO idlookup_$tab ($fields)

        SELECT $fields
        FROM $tab;
 END
        SELECT $fields
        FROM $tab;
 END


@@ -435,7 +513,7 @@ END
           $cp->{Id},
           getminmax($tab,'min',$id),
           $oldmax,
           $cp->{Id},
           getminmax($tab,'min',$id),
           $oldmax,

-          getminmax("aside_$tab",'max',"new_$id"));
+          getminmax("idlookup_$tab",'max',"new_$id"));

     my @updates= @{ $cp->{Updates} };
     while (@updates) {
        my $utabs= shift @updates;
     my @updates= @{ $cp->{Updates} };
     while (@updates) {
        my $utabs= shift @updates;


@@ -448,8 +526,8 @@ END
                db_doall(<<END);
  UPDATE $utab
     SET $ufield = $offset +
                db_doall(<<END);
  UPDATE $utab
     SET $ufield = $offset +

-        (SELECT new_$id FROM aside_$tab
-          WHERE aside_$tab.$id = $utab.$ufield);
+        (SELECT new_$id FROM idlookup_$tab
+          WHERE idlookup_$tab.$id = $utab.$ufield);

  UPDATE $utab
     SET $ufield = $ufield - $offset;
 END
  UPDATE $utab
     SET $ufield = $ufield - $offset;
 END

diff --git a/yarrg/source-info.txt b/yarrg/source-info.txt
index d35468ddfe79ca48409cfc2c80ca9987e1c68c01..acfca81575a08185382e6620edf9ac3adcc55361 100644 (file)
--- a/yarrg/source-info.txt
+++ b/yarrg/source-info.txt
@@ -33,8 +33,8 @@ shot
  large 4
 
 commodclasses
  large 4
 
 commodclasses

- *basic-commodities
- *ship-supplies
+ *basic_commodities
+ *ship_supplies

  *herbs
  *minerals
  *cloth
  *herbs
  *minerals
  *cloth


@@ -121,12 +121,12 @@ commods
  tigereye                                                      @200000+
 
 commods
  tigereye                                                      @200000+
 
 commods

- swill                 1kg             *ship-supplies          @0+
- grog                  1kg             *ship-supplies          @0+
- fine rum              1kg             *ship-supplies          @0+
- small cannon balls    7100g           *ship-supplies          @0+
- medium cannon balls   14200g 2l       *ship-supplies          @0+
- large cannon balls    21300g 3l       *ship-supplies          @0+
+ swill                 1kg             *ship_supplies          @0+
+ grog                  1kg             *ship_supplies          @0+
+ fine rum              1kg             *ship_supplies          @0+
+ small cannon balls    7100g           *ship_supplies          @0+
+ medium cannon balls   14200g 2l       *ship_supplies          @0+
+ large cannon balls    21300g 3l       *ship_supplies          @0+

 
  broom flower          200g            *herbs
  butterfly weed                100g            *herbs
 
  broom flower          200g            *herbs
  butterfly weed                100g            *herbs


@@ -168,14 +168,14 @@ commods
  tellurium             6200g           *minerals
  thorianite            100g            *minerals
 
  tellurium             6200g           *minerals
  thorianite            100g            *minerals
 

- iron                  7800g           *basic-commodities      @110
- sugar cane            50kg 100l       *basic-commodities      @120
- hemp                  125kg 250l      *basic-commodities      @130
- wood                  175kg 250l      *basic-commodities      @140
- stone                 2600g           *basic-commodities      @150
- hemp oil              1kg             *basic-commodities      @160
- varnish               1kg             *basic-commodities      @180
- lacquer               1kg             *basic-commodities      @190
+ iron                  7800g           *basic_commodities      @110
+ sugar cane            50kg 100l       *basic_commodities      @120
+ hemp                  125kg 250l      *basic_commodities      @130
+ wood                  175kg 250l      *basic_commodities      @140
+ stone                 2600g           *basic_commodities      @150
+ hemp oil              1kg             *basic_commodities      @160
+ varnish               1kg             *basic_commodities      @180
+ lacquer               1kg             *basic_commodities      @190

 
 
 client ypp-sc-tools yarrg
 
 
 client ypp-sc-tools yarrg