aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRuss Allbery <rra@stanford.edu>2008-02-13 01:13:15 +0000
committerRuss Allbery <rra@stanford.edu>2008-02-13 01:13:15 +0000
commit17d6530bd3835663ddca59f276b0f8de07e3a287 (patch)
tree8cf90bbafd4b284a005aa075121a0c49a3b15346
parent5dd1bb69f28e1a38259dd939cfd00469c5b786eb (diff)
Move register_object and register_verifier into Wallet::Admin.
-rw-r--r--perl/Wallet/Admin.pm56
-rw-r--r--perl/Wallet/Schema.pm58
-rwxr-xr-xperl/t/admin.t11
-rwxr-xr-xperl/t/server.t3
4 files changed, 65 insertions, 63 deletions
diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm
index 9e89e5e..dab5d64 100644
--- a/perl/Wallet/Admin.pm
+++ b/perl/Wallet/Admin.pm
@@ -23,7 +23,7 @@ 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.01';
+$VERSION = '0.02';
##############################################################################
# Constructor, destructor, and accessors
@@ -172,6 +172,48 @@ sub list_acls {
}
}
+##############################################################################
+# Object registration
+##############################################################################
+
+# Given an object type and class name, add a new class mapping to that
+# database for the given object type. This is used to register new object
+# types. Returns true on success, false on failure, and sets the internal
+# error on failure.
+sub register_object {
+ my ($self, $type, $class) = @_;
+ eval {
+ my $sql = 'insert into types (ty_name, ty_class) values (?, ?)';
+ $self->{dbh}->do ($sql, undef, $type, $class);
+ $self->{dbh}->commit;
+ };
+ if ($@) {
+ $self->error ("cannot register $class for $type: $@");
+ $self->{dbh}->rollback;
+ return;
+ }
+ return 1;
+}
+
+# Given an ACL verifier scheme and class name, add a new class mapping to that
+# database for the given ACL verifier scheme. This is used to register new
+# ACL schemes. Returns true on success, false on failure, and sets the
+# internal error on failure.
+sub register_verifier {
+ my ($self, $scheme, $class) = @_;
+ eval {
+ my $sql = 'insert into acl_schemes (as_name, as_class) values (?, ?)';
+ $self->{dbh}->do ($sql, undef, $scheme, $class);
+ $self->{dbh}->commit;
+ };
+ if ($@) {
+ $self->error ("cannot registery $class for $scheme: $@");
+ $self->{dbh}->rollback;
+ return;
+ }
+ return 1;
+}
+
1;
__DATA__
@@ -273,6 +315,18 @@ database containing no objects, the caller should call error(). error()
is guaranteed to return the error message if there was an error and undef
if there was no error.
+=item register_object (TYPE, CLASS)
+
+Register in the database a mapping from the object type TYPE to the class
+CLASS. Returns true on success and false on failure (including when the
+verifier is already registered).
+
+=item register_verifier (DBH, SCHEME, CLASS)
+
+Register in the database a mapping from the ACL scheme SCHEME to the class
+CLASS. Returns true on success and false on failure (including when the
+verifier is already registered).
+
=item reinitialize(PRINCIPAL)
Performs the same actions as initialize(), but first drops any existing
diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm
index 5fb6618..2fb3d64 100644
--- a/perl/Wallet/Schema.pm
+++ b/perl/Wallet/Schema.pm
@@ -21,7 +21,7 @@ use DBI;
# 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.04';
+$VERSION = '0.05';
##############################################################################
# Data manipulation
@@ -120,44 +120,6 @@ sub drop {
}
##############################################################################
-# Administrative actions
-##############################################################################
-
-# Given a database handle, object type, and class name, add a new class
-# mapping to that database for the given object type. This is used to
-# register new object types. Throws an exception on failure.
-sub register_object {
- my ($self, $dbh, $type, $class) = @_;
- eval {
- $dbh->begin_work if $dbh->{AutoCommit};
- my $sql = 'insert into types (ty_name, ty_class) values (?, ?)';
- $dbh->do ($sql, undef, $type, $class);
- $dbh->commit;
- };
- if ($@) {
- $dbh->rollback;
- die "$@\n";
- }
-}
-
-# Given a database handle, ACL verifier scheme, and class name, add a new
-# class mapping to that database for the given ACL verifier scheme. This is
-# used to register new ACL schemes. Throws an exception on failure.
-sub register_verifier {
- my ($self, $dbh, $scheme, $class) = @_;
- eval {
- $dbh->begin_work if $dbh->{AutoCommit};
- my $sql = 'insert into acl_schemes (as_name, as_class) values (?, ?)';
- $dbh->do ($sql, undef, $scheme, $class);
- $dbh->commit;
- };
- if ($@) {
- $dbh->rollback;
- die "$@\n";
- }
-}
-
-##############################################################################
# Schema
##############################################################################
@@ -215,24 +177,6 @@ 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 register_object (DBH, TYPE, CLASS)
-
-Given a connected database handle, register in that database a mapping from
-the object type TYPE to the class CLASS. On any error, including attempting
-to add a mapping for a type that already exists, this method will throw a
-database exception.
-
-This method will eventually move to another class.
-
-=item register_verifier (DBH, SCHEME, CLASS)
-
-Given a connected database handle, register in that database a mapping from
-the ACL scheme SCHEME to the class CLASS. On any error, including
-attempting to add a mapping for a scheme that already exists, this method
-will throw a database exception.
-
-This method will eventually move to another class.
-
=item sql()
Returns the schema and the population of the normalization tables as a list
diff --git a/perl/t/admin.t b/perl/t/admin.t
index 9795f19..4b8302d 100755
--- a/perl/t/admin.t
+++ b/perl/t/admin.t
@@ -8,7 +8,7 @@
#
# See LICENSE for licensing terms.
-use Test::More tests => 27;
+use Test::More tests => 29;
use Wallet::Admin;
use Wallet::Schema;
@@ -35,8 +35,8 @@ is ($acls[0][0], 1, ' and that is ACL ID 1');
is ($acls[0][1], 'ADMIN', ' with the right name');
# Register a base object so that we can create a simple object.
-my $schema = Wallet::Schema->new;
-$schema->register_object ($admin->dbh, 'base', 'Wallet::Object::Base');
+is ($admin->register_object ('base', 'Wallet::Object::Base'), 1,
+ 'Registering Wallet::Object::Base works');
# Create an object.
$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') };
@@ -50,6 +50,11 @@ is (scalar (@objects), 1, ' and now there is one object');
is ($objects[0][0], 'base', ' with the right type');
is ($objects[0][1], 'service/admin', ' and the right name');
+# Test registering a new ACL type. We don't have a good way of really using
+# this right now.
+is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), 1,
+ 'Registering Wallet::ACL::Base works');
+
# Create another ACL.
is ($server->acl_create ('first'), 1, 'ACL creation succeeds');
@acls = $admin->list_acls;
diff --git a/perl/t/server.t b/perl/t/server.t
index 423127f..08edd56 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -40,8 +40,7 @@ my $dbh = $server->dbh;
ok (defined ($dbh), ' and returns a defined database handle');
# Allow creation of base objects for testing purposes.
-my $schema = Wallet::Schema->new;
-$schema->register_object ($dbh, 'base', 'Wallet::Object::Base');
+$setup->register_object ('base', 'Wallet::Object::Base');
# We're currently running as the administrator, so everything should succeed.
# Set up a bunch of data for us to test with, starting with some ACLs. Test