view release on metacpan or  search on metacpan

lib/XML/eXistDB/RPC.pm  view on Meta::CPAN

    $rc==0 or return ($rc, $details);
    (0, rpcarray_values $details);
}


#T
sub describeResourcePermissions($)
{   my ($rc, $details) = $_[0]->{rpc}->getPermissions(string => $_[1]);
    $rc==0 or return ($rc, $details);
    ($rc, struct_to_hash $details);
}


#T
sub listDocumentPermissions($)
{   my ($self, $coll) = @_;
    $coll ||= $self->{repository};
    my ($rc, $details) = $_[0]->{rpc}->listDocumentPermissions(string => $coll);
    $rc==0 or return ($rc, $details);
    my $h = struct_to_hash $details;
    my %h;
    while( my ($k,$v) = each %$h)
    {   $h{$k} = [ rpcarray_values $v ];
    }
    (0, \%h);
}


#T
sub describeUser($)
{   my ($self, $user) = @_;
    my ($rc, $details) = $self->{rpc}->getUser(string => $user);
    $rc==0 or return ($rc, $details);
    my $h = struct_to_hash $details;
    $h->{groups} = [ rpcarray_values $h->{groups} ];
    (0, $h);
}


#T
sub listUsers()
{   my ($rc, $details) = shift->{rpc}->getUsers;
    $rc==0 or return ($rc, $details);
    my %h;
    foreach my $user (rpcarray_values $details)
    {   my $u = struct_to_hash $user;
        $u->{groups} = [ rpcarray_values $u->{groups} ];
        $h{$u->{name}} = $u;
    }
    (0, \%h);
}


#T
sub removeUser($) { $_[0]->{rpc}->removeUser(string => $_[1]) }


sub setPermissions($$;$$)
{   my ($self, $target, $perms, $user, $group) = @_;

    my @chown = ($user && $group) ? (string => $user, string => $group) : ();
    $self->{rpc}->setPermissions(string => $target, @chown
       , ($perms =~ m/\D/ ? 'string' : 'int') => $perms);
}


#T
sub setUser($$$;$)
{   my ($self, $user, $password, $groups, $home) = @_;
    my @groups = ref $groups eq 'ARRAY' ? @$groups : $groups;

    $self->{rpc}->setUser(string => $user
       , string => md5_base64($password)
       , string => md5_hex("$user:exist:$password")
       , rpcarray_from(string => @groups)
       , ($home ? (string => $home) : ())
       );
}


#T
sub describeCollectionPermissions(;$)
{   my ($self, $coll) = @_;
    $coll ||= $self->{repository};
    my ($rc, $data) = $self->{rpc}->listCollectionPermissions(string => $coll);
    $rc==0 or return ($rc, $data);
    my $h = struct_to_hash $data;
    my %p;
    foreach my $relname (keys %$h)
    {  my %perms;
       @perms{ qw/user group mode/ } = rpcarray_values $h->{$relname};
       $p{"$coll/$relname"} = \%perms;
    }
    ($rc, \%p);
}

#-----------------

### need two-arg version?
sub copyResource($$$)
{   my $self = shift;
    $self->{rpc}->copyResource(string=> $_[0], string=> $_[1], string=> $_[2]);
}


#T
sub uniqueResourceName(;$)
{   my ($self, $coll) = @_;
    $coll ||= $self->{repository};
    $self->{rpc}->createResourceId(string => $coll);
}


sub describeResource($)
{   my ($self, $resource) = @_;
    my ($rc, $details) = $self->{rpc}->describeResource(string => $resource);
    $rc==0 or return ($rc, $details);
    ($rc, struct_to_hash $details);
}


#T