diff options
Diffstat (limited to 'perl/lib')
| -rw-r--r-- | perl/lib/Wallet/ACL.pm | 35 | ||||
| -rw-r--r-- | perl/lib/Wallet/Server.pm | 38 | 
2 files changed, 73 insertions, 0 deletions
| diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index a3b0146..370df8b 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -17,6 +17,7 @@ use strict;  use warnings;  use vars qw($VERSION); +use Wallet::Object::Base;  use DateTime;  use DBI; @@ -207,6 +208,32 @@ sub rename {      return 1;  } +# Moves everything owned by one ACL to instead be owned by another.  You'll +# normally want to use rename, but this exists for cases where the replacing +# ACL already exists and has things assigned to it.  Returns true on success, +# false on failure. +sub replace { +    my ($self, $replace_id, $user, $host, $time) = @_; +    $time ||= time; + +    my %search = (ob_owner => $self->{id}); +    my @objects = $self->{schema}->resultset('Object')->search (\%search); +    if (@objects) { +        for my $object (@objects) { +            my $type   = $object->ob_type; +            my $name   = $object->ob_name; +            my $object = eval { +                Wallet::Object::Base->new($type, $name, $self->{schema}); +            }; +            $object->owner ($replace_id, $user, $host, $time); +        } +    } else { +        $self->error ("no objects found for ACL $self->{id}"); +        return; +    } +    return 1; +} +  # Destroy the ACL, deleting it out of the database.  Returns true on success,  # false on failure.  # @@ -643,6 +670,14 @@ On failure, the caller should call error() to get the error message.  Note that rename() operations are not logged in the ACL history. +=item replace(ID) + +Replace this ACL with another.  This goes through each object owned by +the ACL and changes its ownership to the new ACL, leaving this acl owning +nothing (and probably then needing to be deleted).  Returns true on +success and false on failure.  On failure, the caller should call error() +to get the error message. +  =item show()  Returns a human-readable description of this ACL, including its diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index f6ea342..6af0570 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -734,6 +734,36 @@ sub acl_rename {      return 1;  } +# Move all ACLs owned by one ACL to another, or return undef and set the +# internal error. +sub acl_replace { +    my ($self, $old_id, $replace_id) = @_; +    unless ($self->{admin}->check ($self->{user})) { +        $self->acl_error ($old_id, 'replace'); +        return; +    } +    my $acl = eval { Wallet::ACL->new ($old_id, $self->{schema}) }; +    if ($@) { +        $self->error ($@); +        return; +    } +    if ($acl->name eq 'ADMIN') { +        $self->error ('cannot replace the ADMIN ACL'); +        return; +    } +    my $replace_acl = eval { Wallet::ACL->new ($replace_id, $self->{schema}) }; +    if ($@) { +        $self->error ($@); +        return; +    } + +    unless ($acl->replace ($replace_id, $self->{user}, $self->{host})) { +        $self->error ($acl->error); +        return; +    } +    return 1; +} +  # Destroy an ACL, deleting it out of the database.  Returns true on success.  # On failure, returns undef, setting the internal error.  sub acl_destroy { @@ -942,6 +972,14 @@ either the current name or the numeric ID.  NEW must not be all-numeric.  To rename an ACL, the current user must be authorized by the ADMIN ACL.  Returns true on success and false on failure. +=item acl_replace(OLD, NEW) + +Moves any object owned by the ACL identified by OLD to be instead owned by +NEW.  This goes through all objects owned by OLD and individually changes +the owner, along with history updates.  OLD and NEW may be either the name +or the numeric ID.  To replace an ACL, the current user must be authorized +by the ADMIN ACL.  Returns true on success and false on failure. +  =item acl_show(ID)  Returns a human-readable description, including membership, of the ACL | 
