summaryrefslogtreecommitdiff
path: root/perl/Wallet/Server.pm
diff options
context:
space:
mode:
authorJon Robertson <jonrober@stanford.edu>2012-12-02 22:07:16 -0800
committerRuss Allbery <rra@stanford.edu>2013-01-30 18:33:23 -0800
commit593e9b1e100ace54d1d9da7eb16e60f4e37c34ff (patch)
tree6d29f76135fff795f6a15f9b379fc6dee72d14f0 /perl/Wallet/Server.pm
parent6530fb472f1c64d3e80c723d3073ca3d256a58ce (diff)
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>
Diffstat (limited to 'perl/Wallet/Server.pm')
-rw-r--r--perl/Wallet/Server.pm19
1 files changed, 10 insertions, 9 deletions
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index dfb7dbb..402fbe0 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -18,13 +18,12 @@ use vars qw(%MAPPING $VERSION);
use Wallet::ACL;
use Wallet::Config;
-use Wallet::Database;
use Wallet::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.10';
+$VERSION = '0.11';
##############################################################################
# Utility methods
@@ -38,7 +37,7 @@ $VERSION = '0.10';
# for various things. Throw an exception if anything goes wrong.
sub new {
my ($class, $user, $host) = @_;
- my $dbh = Wallet::Database->connect;
+ my $dbh = Wallet::Schema->connect;
my $acl = Wallet::ACL->new ('ADMIN', $dbh);
my $self = {
dbh => $dbh,
@@ -71,8 +70,9 @@ sub error {
# Disconnect the database handle on object destruction to avoid warnings.
sub DESTROY {
my ($self) = @_;
- if ($self->{dbh} and not $self->{dbh}->{InactiveDestroy}) {
- $self->{dbh}->disconnect;
+
+ if ($self->{dbh}) {
+ $self->{dbh}->storage->dbh->disconnect;
}
}
@@ -86,13 +86,14 @@ sub type_mapping {
my ($self, $type) = @_;
my $class;
eval {
- my $sql = 'select ty_class from types where ty_name = ?';
- ($class) = $self->{dbh}->selectrow_array ($sql, undef, $type);
- $self->{dbh}->commit;
+ my $guard = $self->{dbh}->txn_scope_guard;
+ my %search = (ty_name => $type);
+ my $type_rec = $self->{dbh}->resultset('Type')->find (\%search);
+ $class = $type_rec->ty_class;
+ $guard->commit;
};
if ($@) {
$self->error ($@);
- $self->{dbh}->rollback;
return;
}
if (defined $class) {