Add flag_set and flag_clear to Wallet::Server.

2 files changed, 64 insertions, 1 deletions

diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index c417451..71294c8 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -352,6 +352,34 @@ sub destroy {
 }
 
 ##############################################################################
+# Object flag methods
+##############################################################################
+
+# Clear a flag on an object.  Takes the object and the flag.  Returns true on
+# success or undef and sets the internal error on failure.
+sub flag_clear {
+    my ($self, $type, $name, $flag) = @_;
+    my $object = $self->retrieve ($type, $name);
+    return undef unless defined $object;
+    return undef unless $self->acl_check ($object, 'flags');
+    my $result = $object->flag_clear ($flag, $self->{user}, $self->{host});
+    $self->error ($object->error) unless defined $result;
+    return $result;
+}
+
+# Set a flag on an object.  Takes the object and the flag.  Returns true on
+# success or undef and sets the internal error on failure.
+sub flag_set {
+    my ($self, $type, $name, $flag) = @_;
+    my $object = $self->retrieve ($type, $name);
+    return undef unless defined $object;
+    return undef unless $self->acl_check ($object, 'flags');
+    my $result = $object->flag_set ($flag, $self->{user}, $self->{host});
+    $self->error ($object->error) unless defined $result;
+    return $result;
+}
+
+##############################################################################
 # ACL methods
 ##############################################################################
 
@@ -692,6 +720,18 @@ seconds since epoch.  To set an expiration, the current user must be
 authorized by the ADMIN ACL.  Returns true for success and false for
 failure.
 
+=item flag_clear(TYPE, NAME, FLAG)
+
+Clears the flag FLAG on the object identified by TYPE and NAME.  To clear a
+flag, the current user must be authorized by the ADMIN ACL or the flags ACL
+on the object.
+
+=item flag_set(TYPE, NAME, FLAG)
+
+Sets the flag FLAG on the object identified by TYPE and NAME.  To set a
+flag, the current user must be authorized by the ADMIN ACL or the flags ACL
+on the object.
+
 =item get(TYPE, NAME)
 
 Returns the data associated with the object identified by TYPE and NAME.
diff --git a/perl/t/server.t b/perl/t/server.t
index 84fe901..8faccc1 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -3,7 +3,7 @@
 #
 # t/server.t -- Tests for the wallet server API.
 
-use Test::More tests => 221;
+use Test::More tests => 229;
 
 use Wallet::Config;
 use Wallet::Server;
@@ -301,6 +301,29 @@ is ($server->store ('base', 'service/admin', 'stuff'), undef,
 is ($server->error, "$admin not authorized to store base:service/admin",
     ' due to permissions again');
 
+# Test manipulating flags.
+is ($server->flag_clear ('base', 'service/admin', 'locked'), undef,
+    'Clearing an unset flag fails');
+is ($server->error,
+    "cannot clear flag locked on base:service/admin: flag not set",
+    ' with the right error');
+if ($server->flag_set ('base', 'service/admin', 'locked')) {
+    ok (1, ' but setting it works');
+} else {
+    is ($server->error, '', ' but setting it works');
+}
+is ($server->flag_clear ('base', 'service/admin', 'locked'), 1,
+    ' and then clearing it works');
+is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1,
+    ' and setting unchanging works');
+is ($server->flag_clear ('base', 'service/admin', 'locked'), undef,
+    ' and clearing locked still does not');
+is ($server->error,
+    "cannot clear flag locked on base:service/admin: flag not set",
+    ' with the right error');
+is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1,
+    ' and clearing unchanging works');
+
 # Now let's set up some additional ACLs for future tests.
 is ($server->owner ('base', 'service/user1', 'user1'), 1, 'Set user1 owner');
 is ($server->owner ('base', 'service/user2', 'user2'), 1, 'Set user2 owner');