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.

10 files changed, 144 insertions, 26 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
diff --git a/perl/t/init.t b/perl/t/init.t
index 3fa026f..81c034d 100755
--- a/perl/t/init.t
+++ b/perl/t/init.t
@@ -8,7 +8,7 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 8;
+use Test::More tests => 16;
 
 use Wallet::ACL;
 use Wallet::Config;
@@ -34,5 +34,22 @@ isnt ($entries[0], undef, ' which is a valid entry');
 is ($entries[0][0], 'krb5', ' of krb5 scheme');
 is ($entries[0][1], 'admin@EXAMPLE.COM', ' with the right user');
 
+# Test reinitialization.
+$server = eval { Wallet::Server->reinitialize ('admin@EXAMPLE.COM') };
+is ($@, '', 'Reinitialization did not die');
+ok ($server->isa ('Wallet::Server'), ' and returned the right class');
+
+# Now repeat the database content checks.
+$acl = eval { Wallet::ACL->new ('ADMIN', $server->dbh) };
+is ($@, '', 'Retrieving ADMIN ACL successful');
+ok ($acl->isa ('Wallet::ACL'), ' and is the right class');
+@entries = $acl->list;
+is (scalar (@entries), 1, ' and has only one entry');
+isnt ($entries[0], undef, ' which is a valid entry');
+is ($entries[0][0], 'krb5', ' of krb5 scheme');
+is ($entries[0][1], 'admin@EXAMPLE.COM', ' with the right user');
+
 # Clean up.
+my $schema = Wallet::Schema->new;
+$schema->drop ($server->dbh);
 unlink 'wallet-db';
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index d7c2a02..f08bd31 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -200,7 +200,7 @@ sub stop_remctld {
 }
 
 # Use Wallet::Server to set up the database.
-my $server = eval { Wallet::Server->initialize ($user) };
+my $server = eval { Wallet::Server->reinitialize ($user) };
 is ($@, '', 'Database initialization did not die');
 ok ($server->isa ('Wallet::Server'), ' and returned the right class');
 my $dbh = $server->dbh;
@@ -861,4 +861,6 @@ EOO
 }
 
 # Clean up.
+my $schema = Wallet::Schema->new;
+$schema->drop ($dbh);
 unlink ('wallet-db', 'krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid');
diff --git a/perl/t/object.t b/perl/t/object.t
index bf100ea..42700d0 100755
--- a/perl/t/object.t
+++ b/perl/t/object.t
@@ -28,7 +28,7 @@ my @trace = ($user, $host, time);
 my $princ = 'service/test@EXAMPLE.COM';
 
 # Use Wallet::Server to set up the database.
-my $server = eval { Wallet::Server->initialize ($user) };
+my $server = eval { Wallet::Server->reinitialize ($user) };
 is ($@, '', 'Database initialization did not die');
 ok ($server->isa ('Wallet::Server'), ' and returned the right class');
 my $dbh = $server->dbh;
@@ -321,4 +321,6 @@ EOO
 is ($object->history, $output, ' and the history is correct');
 
 # Clean up.
+my $schema = Wallet::Schema->new;
+$schema->drop ($dbh);
 unlink 'wallet-db';
diff --git a/perl/t/schema.t b/perl/t/schema.t
index 01b2b88..9e2d84f 100755
--- a/perl/t/schema.t
+++ b/perl/t/schema.t
@@ -8,7 +8,7 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 5;
+use Test::More tests => 8;
 
 use DBI;
 use Wallet::Schema;
@@ -31,5 +31,20 @@ $dbh->{PrintError} = 0;
 eval { $schema->create ($dbh) };
 is ($@, '', "create() doesn't die");
 
+# Test dropping the database.
+eval { $schema->drop ($dbh) };
+is ($@, '', "drop() doesn't die");
+my $sql = "select name from sqlite_master where type = 'table'";
+my $sth = $dbh->prepare ($sql);
+$sth->execute;
+my ($table, @tables);
+while (defined ($table = $sth->fetchrow_array)) {
+    push (@tables, $table) unless $table =~ /^sqlite_/;
+}
+is ("@tables", '', ' and there are no tables in the database');
+eval { $schema->create ($dbh) };
+is ($@, '', ' and we can run create again');
+
 # Clean up.
+eval { $schema->drop ($dbh) };
 unlink 'wallet-db';
diff --git a/perl/t/server.t b/perl/t/server.t
index b0c196b..2520e62 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -866,6 +866,11 @@ is ($server->store ('base', 'service/foo', 'stuff'), undef,
 is ($server->error, "$user2 not authorized to create base:service/foo",
     ' with the right error');
 
+# Clean up.
+my $schema = Wallet::Schema->new;
+$schema->drop ($server->dbh);
+unlink 'wallet-db';
+
 # Now test handling of some configuration errors.
 undef $Wallet::Config::DB_DRIVER;
 $server = eval { Wallet::Server->new ($user2, $host) };
@@ -880,6 +885,3 @@ $Wallet::Config::DB_INFO = 't';
 $server = eval { Wallet::Server->new ($user2, $host) };
 like ($@, qr/^cannot connect to database: /,
       ' or if the database connection fails');
-
-# Clean up.
-unlink 'wallet-db';