Moved the Perl wallet modules and tests to DBIx::Class

Moved all the Perl code to use DBIx::Class for the database interface.
This includes updating all database calls, how the schema is generated
and maintained, and the tests in places where some output has changed.
We also remove the schema.t test, as the tests for it are more covered
in the admin.t tests now.

Change-Id: Ie5083432d09a0d9fe364a61c31378b77aa7b3cb7
Reviewed-on: https://gerrit.stanford.edu/598
Reviewed-by: Russ Allbery <rra@stanford.edu>
Tested-by: Russ Allbery <rra@stanford.edu>

5 files changed, 27 insertions, 114 deletions

diff --git a/perl/t/admin.t b/perl/t/admin.t
index 6250f8e..cf6a637 100755
--- a/perl/t/admin.t
+++ b/perl/t/admin.t
@@ -8,12 +8,13 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 18;
+use Test::More tests => 23;
 
 use Wallet::Admin;
 use Wallet::Report;
 use Wallet::Schema;
 use Wallet::Server;
+use DBI;
 
 use lib 't/lib';
 use Util;
@@ -56,6 +57,24 @@ is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), undef,
 is ($server->acl_add ('ADMIN', 'base', 'foo'), 1,
     ' and adding a base ACL now works');
 
+# Test an upgrade.  Reinitialize to an older version, then test upgrade to
+# the current version.
+$Wallet::Schema::VERSION = '0.07';
+is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1,
+    ' and re-initialization succeeds');
+$Wallet::Schema::VERSION = '0.08';
+my $schema = $admin->dbh;
+$schema->upgrade_directory ('sql/');
+my $retval = $admin->upgrade;
+is ($retval, 1, 'Performing an upgrade succeeds');
+my $dbh = $schema->storage->dbh;
+my $sql = "select version from dbix_class_schema_versions order by version "
+    ."DESC";
+$version = $dbh->selectall_arrayref ($sql);
+is (@$version, 2, ' and versions table has correct number of rows');
+is (@{ $version->[0] }, 1, ' and correct number of columns');
+is ($version->[0][0], '0.08', ' and the schema version is correct');
+
 # Clean up.
 is ($admin->destroy, 1, 'Destruction succeeds');
 unlink 'wallet-db';
diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm
index 8bbefc4..c15ccfe 100644
--- a/perl/t/lib/Util.pm
+++ b/perl/t/lib/Util.pm
@@ -45,6 +45,7 @@ sub contents {
 # for testing by default, but support t/data/test.database as a configuration
 # file to use another database backend.
 sub db_setup {
+    $Wallet::Config::DB_DDL_DIRECTORY = 'sql/';
     if (-f 't/data/test.database') {
         open (DB, '<', 't/data/test.database')
             or die "cannot open t/data/test.database: $!";
@@ -60,6 +61,10 @@ sub db_setup {
         $Wallet::Config::DB_USER = $user if $user;
         $Wallet::Config::DB_PASSWORD = $password if $password;
     } else {
+
+        # If we have a new SQLite db by default, disable version checking.
+        $ENV{DBIC_NO_VERSION_CHECK} = 1;
+
         $Wallet::Config::DB_DRIVER = 'SQLite';
         $Wallet::Config::DB_INFO = 'wallet-db';
         unlink 'wallet-db';
diff --git a/perl/t/report.t b/perl/t/report.t
index 363db20..13ef7b6 100755
--- a/perl/t/report.t
+++ b/perl/t/report.t
@@ -145,7 +145,7 @@ is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one');
 is ($lines[0][0], 'base', ' and it has the right type');
 is ($lines[0][1], 'service/admin', ' and the right name');
 @lines = $report->objects ('owner', 'null');
-is (scalar (@lines), 1, 'Searching for objects with no set ownerfinds one');
+is (scalar (@lines), 1, 'Searching for objects with no set owner finds one');
 is ($lines[0][0], 'base', ' and it has the right type');
 is ($lines[0][1], 'service/null', ' and the right name');
 @lines = $report->objects ('acl', 'ADMIN');
diff --git a/perl/t/schema.t b/perl/t/schema.t
deleted file mode 100755
index 5dd90d1..0000000
--- a/perl/t/schema.t
+++ /dev/null
@@ -1,111 +0,0 @@
-#!/usr/bin/perl -w
-#
-# Tests for the wallet schema class.
-#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2011
-#     The Board of Trustees of the Leland Stanford Junior University
-#
-# See LICENSE for licensing terms.
-
-use Test::More tests => 16;
-
-use DBI ();
-use POSIX qw(strftime);
-use Wallet::Config ();
-use Wallet::Schema ();
-
-use lib 't/lib';
-use Util;
-
-my $schema = Wallet::Schema->new;
-ok (defined $schema, 'Wallet::Schema creation');
-ok ($schema->isa ('Wallet::Schema'), ' and class verification');
-my @sql = $schema->sql;
-ok (@sql > 0, 'sql() returns something');
-is (scalar (@sql), 32, ' and returns the right number of statements');
-
-# Connect to a database and test create.
-db_setup;
-my $connect = "DBI:${Wallet::Config::DB_DRIVER}:${Wallet::Config::DB_INFO}";
-my $user = $Wallet::Config::DB_USER;
-my $password = $Wallet::Config::DB_PASSWORD;
-$dbh = DBI->connect ($connect, $user, $password);
-if (not defined $dbh) {
-    die "cannot connect to database $connect: $DBI::errstr\n";
-}
-$dbh->{RaiseError} = 1;
-$dbh->{PrintError} = 0;
-eval { $schema->create ($dbh) };
-is ($@, '', "create() doesn't die");
-
-# Check that the version number is correct.
-my $sql = "select md_version from metadata";
-my $version = $dbh->selectall_arrayref ($sql);
-is (@$version, 1, 'metadata has correct number of rows');
-is (@{ $version->[0] }, 1, ' and correct number of columns');
-is ($version->[0][0], 1, ' and the schema version is correct');
-
-# Test upgrading the database from version 0.  SQLite cannot drop table
-# columns, so we have to kill the table and then recreate it.
-$dbh->do ("drop table metadata");
-if (lc ($Wallet::Config::DB_DRIVER) eq 'sqlite') {
-    ($sql) = grep { /create table objects/ } $schema->sql;
-    $sql =~ s/ob_comment .*,//;
-    $dbh->do ("drop table objects")
-        or die "cannot drop objects table: $DBI::errstr\n";
-    $dbh->do ($sql)
-        or die "cannot recreate objects table: $DBI::errstr\n";
-} else {
-    $dbh->do ("alter table objects drop column ob_comment")
-        or die "cannot drop ob_comment column: $DBI::errstr\n";
-}
-eval { $schema->upgrade ($dbh) };
-is ($@, '', "upgrade() doesn't die");
-$sql = "select md_version from metadata";
-$version = $dbh->selectall_arrayref ($sql);
-is (@$version, 1, ' and metadata has correct number of rows');
-is (@{ $version->[0] }, 1, ' and correct number of columns');
-is ($version->[0][0], 1, ' and the schema version is correct');
-$sql = "insert into objects (ob_type, ob_name, ob_created_by, ob_created_from,
-    ob_created_on, ob_comment) values ('file', 'test', 'test',
-    'test.example.org', ?, 'a test comment')";
-$dbh->do ($sql, undef, strftime ('%Y-%m-%d %T', localtime time));
-$sql = "select ob_comment from objects where ob_name = 'test'";
-my ($comment) = $dbh->selectrow_array ($sql);
-is ($comment, 'a test comment', ' and ob_comment was added to objects');
-
-# Test dropping the database.
-eval { $schema->drop ($dbh) };
-is ($@, '', "drop() doesn't die");
-
-# Make sure all the tables are gone.
-SKIP: {
-    if (lc ($Wallet::Config::DB_DRIVER) eq 'sqlite') {
-        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');
-    } elsif (lc ($Wallet::Config::DB_DRIVER) eq 'mysql') {
-        my $sql = "show tables";
-        my $sth = $dbh->prepare ($sql);
-        $sth->execute;
-        my ($table, @tables);
-        while (defined ($table = $sth->fetchrow_array)) {
-            push (@tables, $table);
-        }
-        is ("@tables", '', ' and there are no tables in the database');
-    } else {
-        skip 1;
-    }
-}
-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 8e0a30d..63f2e76 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -1030,5 +1030,5 @@ is ($@, "database connection information not configured\n",
     ' or if DB_INFO is not set');
 $Wallet::Config::DB_INFO = 't';
 $server = eval { Wallet::Server->new ($user2, $host) };
-like ($@, qr/^cannot connect to database: /,
+like ($@, qr/unable to open database file/,
       ' or if the database connection fails');