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>

1 files changed, 59 insertions, 223 deletions

diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm
index 9a7fe44..d36b7ac 100644
--- a/perl/Wallet/Schema.pm
+++ b/perl/Wallet/Schema.pm
@@ -1,262 +1,85 @@
-# Wallet::Schema -- Database schema for the wallet system.
-#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010, 2011
-#     The Board of Trustees of the Leland Stanford Junior University
-#
-# See LICENSE for licensing terms.
-
-##############################################################################
-# Modules and declarations
-##############################################################################
-
 package Wallet::Schema;
-require 5.006;
 
 use strict;
-use vars qw(@SQL @TABLES $VERSION);
+use warnings;
 
-use DBI;
+use Wallet::Config;
+
+use base 'DBIx::Class::Schema';
 
 # This version should be increased on any code change to this module.  Always
 # use two digits for the minor version with a leading zero if necessary so
 # that it will sort properly.
-$VERSION = '0.07';
+our $VERSION = '0.08';
+
+__PACKAGE__->load_namespaces;
+__PACKAGE__->load_components (qw/Schema::Versioned/);
 
 ##############################################################################
-# Data manipulation
+# Core overrides
 ##############################################################################
 
-# Create a new Wallet::Schema object, parse the SQL out of the documentation,
-# 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 {
+# Override DBI::connect to supply our own connect string, username, and
+# password and to set some standard options.  Takes no arguments other than
+# the implicit class argument.
+sub connect {
     my ($class) = @_;
-    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;
+    unless ($Wallet::Config::DB_DRIVER
+            and (defined ($Wallet::Config::DB_INFO)
+                 or defined ($Wallet::Config::DB_NAME))) {
+        die "database connection information not configured\n";
     }
-    my $self = { sql => [ @SQL ] };
-    bless ($self, $class);
-    return $self;
-}
-
-# Returns the SQL as a list of commands.
-sub sql {
-    my ($self) = @_;
-    return @{ $self->{sql} };
-}
-
-##############################################################################
-# Initialization and cleanup
-##############################################################################
-
-# Run a set of SQL commands, forcing a transaction, rolling back on error, and
-# throwing an exception if anything fails.
-sub _run_sql {
-    my ($self, $dbh, @sql) = @_;
-    eval {
-        $dbh->begin_work if $dbh->{AutoCommit};
-        for my $sql (@sql) {
-            $dbh->do ($sql, { RaiseError => 1, PrintError => 0 });
-        }
-        $dbh->commit;
-    };
-    if ($@) {
-        $dbh->rollback;
-        die "$@\n";
+    my $dsn = "DBI:$Wallet::Config::DB_DRIVER:";
+    if (defined $Wallet::Config::DB_INFO) {
+        $dsn .= $Wallet::Config::DB_INFO;
+    } else {
+        $dsn .= "database=$Wallet::Config::DB_NAME";
+        $dsn .= ";host=$Wallet::Config::DB_HOST" if $Wallet::Config::DB_HOST;
+        $dsn .= ";port=$Wallet::Config::DB_PORT" if $Wallet::Config::DB_PORT;
     }
-}
-
-# Given a database handle, try to create our database by running the SQL.  Do
-# this in a transaction regardless of the database settings and throw an
-# exception if this fails.  We have to do a bit of fiddling to get syntax that
-# works with both MySQL and SQLite.
-sub create {
-    my ($self, $dbh) = @_;
-    my $driver = $dbh->{Driver}->{Name};
-    my @create = map {
-        if ($driver eq 'SQLite') {
-            s/auto_increment primary key/primary key autoincrement/;
-        } elsif ($driver eq 'mysql' and /^\s*create\s+table\s/) {
-            s/;$/ engine=InnoDB;/;
-        }
-        $_;
-    } @{ $self->{sql} };
-    $self->_run_sql ($dbh, @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} };
-    $self->_run_sql ($dbh, @drop);
-}
-
-# Given an open database handle, determine the current database schema
-# version.  If we can't read the version number, we currently assume a version
-# 0 database.  This will change in the future.
-sub _schema_version {
-    my ($self, $dbh) = @_;
-    my $version;
-    eval {
-        my $sql = 'select md_version from metadata';
-        my $result = $dbh->selectrow_arrayref ($sql);
-        $version = $result->[0];
-    };
+    my $user = $Wallet::Config::DB_USER;
+    my $pass = $Wallet::Config::DB_PASSWORD;
+    my %attrs = (PrintError => 0, RaiseError => 1);
+    my $dbh = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) };
     if ($@) {
-        $version = 0;
+        die "cannot connect to database: $@\n";
     }
-    return $version;
+    return $dbh;
 }
 
-# Given a database handle, try to upgrade the schema of that database to the
-# current version while preserving all data.  Do this in a transaction
-# regardless of the database settings and throw an exception if this fails.
-sub upgrade {
-    my ($self, $dbh) = @_;
-    my $version = $self->_schema_version ($dbh);
-    my @sql;
-    if ($version == 1) {
-        return;
-    } elsif ($version == 0) {
-        @sql = ('create table metadata (md_version integer)',
-                'insert into metadata (md_version) values (1)',
-                'alter table objects add ob_comment varchar(255) default null'
-               );
-    } else {
-        die "unknown database version $version\n";
-    }
-    $self->_run_sql ($dbh, @sql);
-}
+__END__
+
+1;
 
 ##############################################################################
-# Schema
+# Documentation
 ##############################################################################
 
-# The following POD is also parsed by the code to extract SQL blocks.  Don't
-# add any verbatim blocks to this documentation in the SCHEMA section that
-# aren't intended to be SQL.
-
-1;
-__DATA__
-
 =head1 NAME
 
-Wallet::Schema - Database schema for the wallet system
-
-=for stopwords
-SQL ACL API APIs enums Enums Keytab Backend keytab backend enctypes
-enctype Allbery Metadata metadata verifier
+Wallet::Schema - Database schema and connector for the wallet system
 
 =head1 SYNOPSIS
 
     use Wallet::Schema;
-    my $schema = Wallet::Schema->new;
-    my @sql = $schema->sql;
-    $schema->create ($dbh);
+    my $dbh = Wallet::Schema->connect;
 
 =head1 DESCRIPTION
 
 This class encapsulates the database schema for the wallet system.  The
-documentation you're reading explains and comments the schema.  The Perl
-object extracts the schema from the documentation and can either return it
-as a list of SQL commands to run or run those commands given a connected
-database handle.
+documentation you're reading explains and comments the schema.  The
+class runs using the DBIx::Class module.
 
-This schema attempts to be portable SQL, but it is designed for use with
-MySQL and may require some modifications for other databases.
-
-=head1 METHODS
-
-=over 4
-
-=item new()
-
-Instantiates a new Wallet::Schema object.  This parses the documentation
-and extracts the schema, but otherwise doesn't do anything.
-
-=item create(DBH)
-
-Given a connected database handle, runs the SQL commands necessary to
-create the wallet database in an otherwise empty database.  This method
-will not 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 of SQL commands to run to create the wallet database in an otherwise
-empty database.
-
-=item upgrade(DBH)
-
-Given a connected database handle, runs the SQL commands necessary to
-upgrade that database to the current schema version.  On any error, this
-method will throw a database exception.
-
-=back
+connect() will obtain the database connection information from the wallet
+configuration; see L<Wallet::Config> for more details.  It will also
+automatically set the RaiseError attribute to true and the PrintError and
+AutoCommit attributes to false, matching the assumptions made by the
+wallet database code.
 
 =head1 SCHEMA
 
-=head2 Metadata Tables
-
-This table is used to store metadata about the wallet database, used for
-upgrades and in similar situations:
-
-  create table metadata
-     (md_version          integer);
-  insert into metadata (md_version) values (1);
-
-This table will normally only have one row.  md_version holds the version
-number of the schema (which does not necessarily have any relationship to
-the version number of wallet itself).
-
 =head2 Normalization Tables
 
-The following are normalization tables used to constrain the values in
-other tables.
-
-Holds the supported flag names:
-
-  create table flag_names
-     (fn_name             varchar(32) primary key);
-  insert into flag_names (fn_name) values ('locked');
-  insert into flag_names (fn_name) values ('unchanging');
-
 Holds the supported object types and their corresponding Perl classes:
 
   create table types
@@ -390,8 +213,8 @@ object may have zero or more flags associated with it:
           not null references objects(ob_type),
       fl_name             varchar(255)
           not null references objects(ob_name),
-      fl_flag             varchar(32)
-          not null references flag_names(fn_name),
+      fl_flag             enum('locked', 'unchanging')
+          not null,
       primary key (fl_type, fl_name, fl_flag));
   create index fl_object on flags (fl_type, fl_name);
 
@@ -477,9 +300,22 @@ To use this functionality, you will need to populate the enctypes table
 with the enctypes that a keytab may be restricted to.  Currently, there is
 no automated mechanism to do this.
 
+=head1 CLASS METHODS
+
+=over 4
+
+=item connect()
+
+Opens a new database connection and returns the database object.  On any
+failure, throws an exception.  Unlike the DBI method, connect() takes no
+arguments; all database connection information is derived from the wallet
+configuration.
+
+=back
+
 =head1 SEE ALSO
 
-wallet-backend(8)
+wallet-backend(8), Wallet::Config(3)
 
 This module is part of the wallet system.  The current version is
 available from L<http://www.eyrie.org/~eagle/software/wallet/>.