diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Wallet/Server.pm | 24 | ||||
| -rwxr-xr-x | perl/t/server.t | 7 |
2 files changed, 29 insertions, 2 deletions
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index b5b76fe..b52f1aa 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -24,7 +24,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.06'; +$VERSION = '0.07'; ############################################################################## # Utility methods @@ -384,6 +384,22 @@ sub owner { return $result; } +# Checks for the existence of an object. Returns 1 if it does, 0 if it +# doesn't, and undef if there was an error in checking the existence of the +# object. +sub check { + my ($self, $type, $name) = @_; + my $object = $self->retrieve ($type, $name); + if (not defined $object) { + if ($self->error =~ /^cannot find/) { + return 0; + } else { + return; + } + } + return 1; +} + # Retrieve the information associated with an object, or returns undef and # sets the internal error if the retrieval fails or if the user isn't # authorized. If the object doesn't exist, attempts dynamic creation of the @@ -826,6 +842,12 @@ attribute values. Returns true on success and false on failure. To set an attribute value, the user must be authorized by the ADMIN ACL, the store ACL if set, or the owner ACL if the store ACL is not set. +=item check(TYPE, NAME) + +Check whether an object of type TYPE and name NAME exists. Returns 1 if +it does, 0 if it doesn't, and undef if some error occurred while checking +for the existence of the object. + =item create(TYPE, NAME) Creates a new object of type TYPE and name NAME. TYPE must be a recognized diff --git a/perl/t/server.t b/perl/t/server.t index 39e1090..f732af3 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -8,7 +8,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 334; +use Test::More tests => 338; use POSIX qw(strftime); use Wallet::Admin; @@ -172,9 +172,12 @@ is ($server->create ('base', 'service/admin'), 1, is ($server->create ('base', 'service/admin'), undef, ' but not twice'); like ($server->error, qr{^cannot create object base:service/admin: }, ' and returns the right error'); +is ($server->check ('base', 'service/admin'), 1, ' and check works'); is ($server->create ('srvtab', 'service.admin'), undef, 'Creating an unknown object fails'); is ($server->error, 'unknown object type srvtab', ' with the right error'); +is ($server->check ('srvtab', 'service.admin'), undef, ' and check fails'); +is ($server->error, 'unknown object type srvtab', ' with the right error'); is ($server->create ('', 'service.admin'), undef, ' and likewise with an empty type'); is ($server->error, 'unknown object type ', ' with the right error'); @@ -193,6 +196,8 @@ is ($server->destroy ('srvtab', 'service/test'), undef, is ($server->error, 'unknown object type srvtab', ' with a different error'); is ($server->destroy ('base', 'service/test'), 1, ' but destroying a good object works'); +is ($server->check ('base', 'service/test'), 0, + ' and now check says it is not there'); is ($server->destroy ('base', 'service/test'), undef, ' but not twice'); is ($server->error, 'cannot find base:service/test', ' with the right error'); |