Initial work on supporting testing with MySQL.

Add a drop() method to Wallet::Schema to destroy the wallet database.  Add
a test suite for it.  Add a reinitialize() method to Wallet;:Server that
drops the database before creating it.

Modify the wallet object test cases to call reinitialize() to create the
initial database and drop() to clean up the database after the test is
complete.

Fix a bug preventing Wallet::Schema from being initialized multiple times.
We now stash the schema in a class static variable and reuse it for
subsequent initializations, since re-reading DATA doesn't work.

5 files changed, 99 insertions, 19 deletions

diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm
index 6a07366..f04217e 100644
--- a/perl/Wallet/ACL.pm
+++ b/perl/Wallet/ACL.pm
@@ -50,8 +50,12 @@ sub new {
     } else {
         $sql = 'select ac_id, ac_name from acls where ac_name = ?';
     }
-    ($data, $name) = eval { $dbh->selectrow_array ($sql, undef, $id) };
+    eval {
+        ($data, $name) = $dbh->selectrow_array ($sql, undef, $id);
+        $dbh->commit;
+    };
     if ($@) {
+        $dbh->rollback;
         die "cannot search for ACL $id: $@\n";
     } elsif (not defined $data) {
         die "ACL $id not found\n";
@@ -271,9 +275,11 @@ sub list {
         while (defined ($entry = $sth->fetchrow_arrayref)) {
             push (@entries, [ @$entry ]);
         }
+        $self->{dbh}->commit;
     };
     if ($@) {
         $self->error ("cannot retrieve ACL $self->{id}: $@");
+        $self->{dbh}->rollback;
         return;
     } else {
         return @entries;
@@ -320,9 +326,11 @@ sub history {
             }
             $output .= "\n    by $data[3] from $data[4]\n";
         }
+        $self->{dbh}->commit;
     };
     if ($@) {
         $self->error ("cannot read history for $self->{id}: $@");
+        $self->{dbh}->rollback;
         return undef;
     }
     return $output;
diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm
index ada211c..1371f7f 100644
--- a/perl/Wallet/Object/Base.pm
+++ b/perl/Wallet/Object/Base.pm
@@ -41,6 +41,7 @@ sub new {
     $dbh->{PrintError} = 0;
     my $sql = 'select ob_name from objects where ob_type = ? and ob_name = ?';
     my $data = $dbh->selectrow_array ($sql, undef, $type, $name);
+    $dbh->commit;
     die "cannot find ${type}:${name}\n" unless ($data and $data eq $name);
     my $self = {
         dbh  => $dbh,
@@ -240,9 +241,11 @@ sub _get_internal {
         my $sql = "select $attr from objects where ob_type = ? and
             ob_name = ?";
         $value = $self->{dbh}->selectrow_array ($sql, undef, $type, $name);
+        $self->{dbh}->commit;
     };
     if ($@) {
         $self->error ($@);
+        $self->{dbh}->rollback;
         return;
     }
     return $value;
@@ -345,9 +348,11 @@ sub flag_check {
         my $sql = 'select fl_flag from flags where fl_type = ? and fl_name = ?
             and fl_flag = ?';
         $value = $dbh->selectrow_array ($sql, undef, $type, $name, $flag);
+        $dbh->commit;
     };
     if ($@) {
         $self->error ("cannot check flag $flag for ${type}:${name}: $@");
+        $dbh->rollback;
         return;
     } elsif ($value) {
         return 1;
@@ -401,10 +406,12 @@ sub flag_list {
         while (defined ($flag = $sth->fetchrow_array)) {
             push (@flags, $flag);
         }
+        $self->{dbh}->commit;
     };
     if ($@) {
         my $id = $self->{type} . ':' . $self->{name};
         $self->error ("cannot retrieve flags for $id: $@");
+        $self->{dbh}->rollback;
         return;
     } else {
         return @flags;
@@ -490,10 +497,12 @@ sub history {
             }
             $output .= "\n    by $data[5] from $data[6]\n";
         }
+        $self->{dbh}->commit;
     };
     if ($@) {
         my $id = $self->{type} . ':' . $self->{name};
         $self->error ("cannot read history for $id: $@");
+        $self->{dbh}->rollback;
         return undef;
     }
     return $output;
@@ -550,9 +559,11 @@ sub show {
         my $sql = "select $fields from objects where ob_type = ? and
             ob_name = ?";
         @data = $self->{dbh}->selectrow_array ($sql, undef, $type, $name);
+        $self->{dbh}->commit;
     };
     if ($@) {
         $self->error ("cannot retrieve data for ${type}:${name}: $@");
+        $self->{dbh}->rollback;
         return undef;
     }
     my $output = '';
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index f91abff..025c9e1 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -467,9 +467,11 @@ sub enctypes_list {
         while (defined ($entry = $sth->fetchrow_arrayref)) {
             push (@enctypes, @$entry);
         }
+        $self->{dbh}->commit;
     };
     if ($@) {
         $self->error ($@);
+        $self->{dbh}->rollback;
         return;
     }
     return @enctypes;
@@ -562,9 +564,11 @@ sub attr {
                 while (defined ($target = $sth->fetchrow_array)) {
                     push (@targets, $target);
                 }
+                $self->{dbh}->commit;
             };
             if ($@) {
                 $self->error ($@);
+                $self->{dbh}->rollback;
                 return;
             }
             return @targets;
diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm
index ec690e1..030905e 100644
--- a/perl/Wallet/Schema.pm
+++ b/perl/Wallet/Schema.pm
@@ -14,7 +14,7 @@ package Wallet::Schema;
 require 5.006;
 
 use strict;
-use vars qw(@TABLES $VERSION);
+use vars qw(@SQL @TABLES $VERSION);
 
 use DBI;
 
@@ -28,28 +28,31 @@ $VERSION = '0.02';
 ##############################################################################
 
 # Create a new Wallet::Schema object, parse the SQL out of the documentation,
-# and store it in the object.
+# and store it in the object.  We have to store the SQL in a static variable,
+# since we can't read DATA multiple times.
 sub new {
     my ($class) = @_;
-    local $_;
-    my ($found, @sql);
-    my $command = '';
-    while (<DATA>) {
-        if (not $found and /^=head1 SCHEMA/) {
-            $found = 1;
-        } elsif ($found and /^=head1 /) {
-            last;
-        } elsif ($found and /^  /) {
-            s/^  //;
-            $command .= $_;
-            if (/;$/) {
-                push (@sql, $command);
-                $command = '';
+    unless (@SQL) {
+        local $_;
+        my $found;
+        my $command = '';
+        while (<DATA>) {
+            if (not $found and /^=head1 SCHEMA/) {
+                $found = 1;
+            } elsif ($found and /^=head1 /) {
+                last;
+            } elsif ($found and /^  /) {
+                s/^  //;
+                $command .= $_;
+                if (/;$/) {
+                    push (@SQL, $command);
+                    $command = '';
+                }
             }
         }
+        close DATA;
     }
-    close DATA;
-    my $self = { sql => [ @sql ] };
+    my $self = { sql => [ @SQL ] };
     bless ($self, $class);
     return $self;
 }
@@ -84,6 +87,31 @@ sub create {
     }
 }
 
+# Given a database handle, try to remove the wallet database tables by
+# reversing the SQL.  Do this in a transaction regardless of the database
+# settings and throw an exception if this fails.
+sub drop {
+    my ($self, $dbh) = @_;
+    my @drop = map {
+        if (/^\s*create\s+table\s+(\S+)/i) {
+            "drop table if exists $1;";
+        } else {
+            ();
+        }
+    } reverse @{ $self->{sql} };
+    eval {
+        $dbh->begin_work if $dbh->{AutoCommit};
+        for my $sql (@drop) {
+            $dbh->do ($sql, { RaiseError => 1, PrintError => 0 });
+        }
+        $dbh->commit;
+    };
+    if ($@) {
+        $dbh->rollback;
+        die "$@\n";
+    }
+}
+
 ##############################################################################
 # Schema
 ##############################################################################
@@ -134,6 +162,14 @@ drop any existing tables and will therefore fail if a wallet database has
 already been created.  On any error, this method will throw a database
 exception.
 
+=item drop(DBH)
+
+Given a connected database handle, drop all of the wallet tables from that
+database if any of those tables exist.  This method will only remove tables
+that are part of the current schema or one of the previous known schema and
+won't remove other tables.  On any error, this method will throw a database
+exception.
+
 =item sql()
 
 Returns the schema and the population of the normalization tables as a list
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index 429b3fb..04e8fd9 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -85,6 +85,18 @@ sub initialize {
     return $class->new ($user, 'localhost');
 }
 
+# The same as initialize, but also drops any existing tables first before
+# creating the schema.  Takes the same arguments and throws an exception on
+# failure.
+sub reinitialize {
+    my ($class, $user) = @_;
+    my $dbh = $class->_open_db;
+    my $schema = Wallet::Schema->new;
+    $schema->drop ($dbh);
+    $dbh->disconnect;
+    return $class->initialize ($user);
+}
+
 # Create a new wallet server object.  A new server should be created for each
 # user who is making changes to the wallet.  Takes the principal and host who
 # are sending wallet requests.  Opens a connection to the database that will
@@ -752,6 +764,15 @@ privileged operations.
 
 On any error, this method throws an exception.
 
+=item reinitialize(PRINCIPAL)
+
+Performs the same actions as initialize(), but first drops any existing
+wallet database tables from the database, allowing this function to be
+called on a prior wallet database.  All data stored in the database will be
+deleted and a fresh set of wallet database tables will be created.
+
+On any error, this method throws an exception.
+
 =back
 
 =head1 INSTANCE METHODS