diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Wallet/Object/Base.pm | 12 | ||||
| -rwxr-xr-x | perl/t/object.t | 1 | ||||
| -rwxr-xr-x | perl/t/server.t | 30 |
3 files changed, 42 insertions, 1 deletions
diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 1075c13..8d01ae8 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -467,7 +467,19 @@ sub show { } my $output = ''; my @acls; + + # Format the results. We use a hack to insert the flags before the first + # trace field since they're not a field in the object in their own right. for (my $i = 0; $i < @data; $i++) { + if ($attrs[$i][0] eq 'ob_created_by') { + my @flags = $self->flag_list; + if (@flags == 1 and not defined $flags[0]) { + return undef; + } + if (@flags) { + $output .= sprintf ("%15s: %s\n", 'Flags', "@flags"); + } + } next unless defined $data[$i]; if ($attrs[$i][0] =~ /^ob_(owner|acl_)/) { my $acl = eval { Wallet::ACL->new ($data[$i], $self->{dbh}) }; diff --git a/perl/t/object.t b/perl/t/object.t index 2514c04..db7cb98 100755 --- a/perl/t/object.t +++ b/perl/t/object.t @@ -169,6 +169,7 @@ my $output = <<"EOO"; Destroy ACL: ADMIN Flags ACL: ADMIN Expires: $now + Flags: locked unchanging Created by: $user Created from: $host Created on: $created diff --git a/perl/t/server.t b/perl/t/server.t index 8faccc1..8dc2b89 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 => 229; +use Test::More tests => 241; use Wallet::Config; use Wallet::Server; @@ -331,6 +331,7 @@ is ($server->owner ('base', 'service/both', 'both'), 1, 'Set both owner'); is ($server->acl ('base', 'service/both', 'show', 'user1'), 1, ' and show'); is ($server->acl ('base', 'service/both', 'destroy', 'user2'), 1, ' and destroy'); +is ($server->acl ('base', 'service/both', 'flags', 'user1'), 1, ' and flags'); # Okay, now we can switch users and be sure we don't have admin rights. $server = eval { Wallet::Server->new ($user1, $host) }; @@ -375,6 +376,16 @@ is ($server->acl ('base', 'service/user1', 'get', 'user1'), undef, is ($server->error, "$user1 not authorized to set ACL for base:service/user1", ' with error'); +is ($server->flag_set ('base', 'service/user1', 'unchanging'), undef, + ' or set flags'); +is ($server->error, + "$user1 not authorized to set flags for base:service/user1", + ' with error'); +is ($server->flag_clear ('base', 'service/user1', 'unchanging'), undef, + ' or clear flags'); +is ($server->error, + "$user1 not authorized to set flags for base:service/user1", + ' with error'); # However, we can perform object actions on things we own. $result = eval { $server->get ('base', 'service/user1') }; @@ -424,6 +435,11 @@ is ($server->store ('base', 'service/both', 'stuff'), undef, is ($server->error, "cannot store base:service/both: object type is immutable", ' and the method is called'); +is ($server->flag_set ('base', 'service/both', 'unchanging'), 1, + ' and set flags on an object we have an ACL'); +is ($server->flag_set ('base', 'service/both', 'locked'), 1, ' both flags'); +is ($server->flag_clear ('base', 'service/both', 'locked'), 1, + ' and clear flags'); $show = $server->show ('base', 'service/both'); $show =~ s/(Created on:) \d+$/$1 0/m; $expected = <<"EOO"; @@ -432,6 +448,8 @@ $expected = <<"EOO"; Owner: both Show ACL: user1 Destroy ACL: user2 + Flags ACL: user1 + Flags: unchanging Created by: $admin Created from: $host Created on: 0 @@ -506,6 +524,16 @@ is ($server->error, is ($server->show ('base', 'service/both'), undef, ' but we cannot show it'); is ($server->error, "$user2 not authorized to show base:service/both", ' with the right error'); +is ($server->flag_set ('base', 'service/both', 'locked'), undef, + ' or set flags on it'); +is ($server->error, + "$user2 not authorized to set flags for base:service/both", + ' with the right error'); +is ($server->flag_clear ('base', 'service/both', 'unchanging'), undef, + ' or clear flags on it'); +is ($server->error, + "$user2 not authorized to set flags for base:service/both", + ' with the right error'); is ($server->destroy ('base', 'service/both'), 1, ' and we can destroy it'); is ($server->get ('base', 'service/both'), undef, ' and now cannot get it'); is ($server->error, 'cannot find base:service/both', ' because it is gone'); |