diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Wallet/Schema.pm | 81 | ||||
| -rwxr-xr-x | perl/t/schema.t | 11 |
2 files changed, 70 insertions, 22 deletions
diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 07e5ffe..911d7a9 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -67,23 +67,13 @@ sub sql { # Initialization and cleanup ############################################################################## -# 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}; +# 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}; - my @sql = @{ $self->{sql} }; for my $sql (@sql) { - if ($driver eq 'SQLite') { - $sql =~ s{auto_increment primary key} - {primary key autoincrement}; - } elsif ($driver eq 'mysql' and $sql =~ /^\s*create\s+table\s/) { - $sql =~ s/;$/ engine=InnoDB;/; - } $dbh->do ($sql, { RaiseError => 1, PrintError => 0 }); } $dbh->commit; @@ -94,6 +84,24 @@ sub create { } } +# 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. @@ -106,17 +114,42 @@ sub drop { (); } } 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 { - $dbh->begin_work if $dbh->{AutoCommit}; - for my $sql (@drop) { - $dbh->do ($sql, { RaiseError => 1, PrintError => 0 }); - } - $dbh->commit; + my $sql = 'select md_version from metadata'; + my $result = $dbh->selectrow_arrayref ($sql); + $version = $result->[0][0]; }; if ($@) { - $dbh->rollback; - die "$@\n"; + $version = 0; + } + return $version; +} + +# 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)'); + } else { + die "unknown database version $version\n"; } + $self->_run_sql ($dbh, @sql); } ############################################################################## @@ -187,6 +220,12 @@ 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 =head1 SCHEMA diff --git a/perl/t/schema.t b/perl/t/schema.t index 11774d6..c66ad59 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -8,7 +8,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 11; +use Test::More tests => 15; use DBI; use Wallet::Config; @@ -45,6 +45,15 @@ 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. +$dbh->do ("drop table metadata"); +eval { $schema->upgrade ($dbh) }; +is ($@, '', "upgrade() doesn't die"); +$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'); + # Test dropping the database. eval { $schema->drop ($dbh) }; is ($@, '', "drop() doesn't die"); |