diff options
author | Russ Allbery <rra@stanford.edu> | 2008-02-13 01:13:15 +0000 |
---|---|---|
committer | Russ Allbery <rra@stanford.edu> | 2008-02-13 01:13:15 +0000 |
commit | 17d6530bd3835663ddca59f276b0f8de07e3a287 (patch) | |
tree | 8cf90bbafd4b284a005aa075121a0c49a3b15346 | |
parent | 5dd1bb69f28e1a38259dd939cfd00469c5b786eb (diff) |
Move register_object and register_verifier into Wallet::Admin.
-rw-r--r-- | perl/Wallet/Admin.pm | 56 | ||||
-rw-r--r-- | perl/Wallet/Schema.pm | 58 | ||||
-rwxr-xr-x | perl/t/admin.t | 11 | ||||
-rwxr-xr-x | perl/t/server.t | 3 |
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 |