File Coverage

lib/XML/eXistDB/RPC.pm

Criterion	Covered	Total	%
statement	39	433	9.0
branch	0	200	0.0
condition	0	67	0.0
subroutine	13	99	13.1
pod	80	82	97.5
total	132	881	14.9

# Copyrights 2010-2021 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution XML-ExistsDB.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package XML::eXistDB::RPC;
use vars '$VERSION';
$VERSION = '0.99_1';

use base 'XML::eXistDB';

use warnings;
use strict;

use Log::Report 'xml-existdb', syntax => 'LONG';

use XML::Compile::RPC::Util;
use XML::Compile::RPC::Client ();

use XML::eXistDB::Util;
use XML::eXistDB;

use Digest::MD5  qw/md5_base64 md5_hex/;
use Encode       qw/encode/;
use MIME::Base64 qw/encode_base64/;

use Data::Dumper;
$Data::Dumper::Indent = 1;

my $dateTime = 'dateTime.iso8601';  # too high chance on typos


sub init($)
{   my ($self, $args) = @_;

    my $rpc = $args->{rpc};
    unless($rpc)
    {   my $dest = $args->{destination}
            or report ERROR =>
                    __x"{pkg} object required option `rpc' or `destination'"
                 , pkg => ref $self;
        $rpc = XML::Compile::RPC::Client->new(destination => $dest);
    }
    $args->{schemas} ||= $rpc->schemas;

    $self->SUPER::init($args);

    $self->{rpc}      = $rpc;
    $self->{repository}
      = exists $args->{repository} ? $args->{repository} : '/db';
    $self->{compr_up} = $args->{compress_upload} // 128;
    $self->{chunks}   = $args->{chunk_size}      // 32;

    $self->login($args->{user} // 'guest', $args->{password} // 'guest');
    $self->{pp_up}   = $args->{prettyprint_upload} ? 1 : 0;

    my $f = $args->{format} || [];
    $self->{format}  = [ ref $f eq 'HASH' ? %$f : @$f ];
    $self;
}

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

sub rpcClient() {shift->{rpc}}

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

# private method; "options" is an overloaded term, abused by eXist.
sub _format(@)
{   my $self = shift;
    my %args = (@{$self->{format}}, @_);

    if(my $sp = delete $args{'stylesheet-params'})
    {   while(my($k,$v) = each %$sp)
        {   $args{"stylesheet-param.$k"} = $v;
        }
    }
    struct_from_hash string => \%args;
}

sub _date_options($$)
{   my ($created, $modified) = @_;

     !($created || $modified) ? ()
    : ($created && $modified) ? ($dateTime => $created, $dateTime => $modified)
    : report ERROR => "either both or neither creation and modification date";
}

# in Perl, any value is either true or false, in rpc only 0 and 1
sub _bool($) { $_[0] ? 0 : 1 }


sub _document($)
{   my $self = shift;

    return $_[0]->toString($self->{pp_up})
        if UNIVERSAL::isa($_[0], 'XML::LibXML::Document');

    return encode 'utf-8', ${$_[0]}
        if ref $_[0] eq 'SCALAR';

    return encode 'utf-8', $_[0]
        if $_[0] =~ m/^\s*\

    if($_[0] !~ m/[\r\n]/ && -f $_[0])
    {   local *DOC;
        open DOC, '<:raw', $_[0]
            or report FAULT => "cannot read document from file $_[0]";
        local $/ = undef;
        my $xml = ;
        close DOC
            or report FAULT => "read error for document from file $_[0]";
        return $xml;
   }

   report ERROR => "do not understand document via $_[0]";
}

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

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


sub hasDocument($) { $_[0]->rpcClient->hasDocument(string => $_[1]) }


#T
sub isXACMLEnabled() { shift->rpcClient->isXACMLEnabled }


sub backup($$$$)
{   $_[0]->rpcClient->backup(string => $_[1], string => $_[2]
      , string => $_[3], string => $_[4]);
}


sub shutdown(;$)
{   my $self = shift;
    $self->rpcClient->shutdown(@_ ? (int => shift) : ());
}


sub sync() { shift->rpcClient->sync }

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

#T
sub createCollection($;$)
{   my ($self, $coll, $date) = @_;
    my @date = $date ? ($dateTime => $date) : ();
    $self->rpcClient->createCollection(string => $coll, @date);
}


#T
sub configureCollection($$%)
{   my ($self, $coll, $conf, %args) = @_;
    my $format = (exists $args{beautify} ? $args{beautify} : $self->{pp_up})
      ? 1 : 0;
    my $config;

    if(UNIVERSAL::isa($conf, 'XML::LibXML::Document'))
    {   # ready document, hopefully correct
        $config = $conf->toString($format);
    }
    elsif(!ref $conf && $conf =~ m/^\s*\
    {   # preformatted xml
        $config = $conf;
    }
    else
    {   $config = $self->createCollectionConfig($conf, %args);
    }

    $self->rpcClient->configureCollection(string => $coll, string => $config);
}


sub copyCollection($$;$)
{   my ($self, $from, $sec) = (shift, shift, shift);
    my @param = (string => $from, string => $sec);
    push @param, string => shift if @_;
    $self->rpcClient->copyCollection(@param);
}


# the two params version is missing from the interface description, so
# we use a little work-around
sub moveCollection($$;$)
{   my ($self, $from, $tocoll, $subcoll) = @_;
    defined $subcoll
        or ($tocoll, $subcoll) = $tocoll =~ m! ^ (.*) / ([^/]+) $ !x;

    $self->rpcClient->moveCollection(string => $from, string => $tocoll
      , string => $subcoll);
}


#T
sub describeCollection(;$%)
{   my $self = shift;
    my $coll = @_ % 2 ? shift : $self->{repository};
    my %args = @_;
    my ($rc, $data, $trace) = $args{documents}
      ? $self->rpcClient->getCollectionDesc(string => $coll)
      : $self->rpcClient->describeCollection(string => $coll);
    $rc==0 or return ($rc, $data, $trace);

    my $h = struct_to_hash $data;
    $h->{collections} = [ rpcarray_values $h->{collections} ];
    if(my $docs = $h->{documents})
    {   my %docs;
        foreach (rpcarray_values $docs)
        {   my $h = struct_to_hash $_;
            $docs{$h->{name}} = $h;
        }
        $h->{documents} =\%docs;
    }
    (0, $h, $trace);
}


#T
sub subCollections(;$)
{   my ($self, $coll) = @_;
    $coll ||= $self->{repository};
    my ($rc, $data, $trace) = $_[0]->describeCollection($coll, documents => 0);
    $rc==0 or return ($rc, $data, $trace);

    my @coll = map "$data->{name}/$_", @{$data->{collections} || []};
    (0, \@coll, $trace);
}


#T
sub collectionCreationDate(;$)
{   my ($self, $coll) = @_;
    $coll ||= $self->{repository};
    $self->rpcClient->getCreationDate(string => $coll);
}


#T
sub listResources(;$)
{   my ($self, $coll) = @_;
    $coll ||= $self->{repository};
    my ($rc, $details, $trace)
       = $self->rpcClient->getDocumentListing($coll ? (string => $coll) : ());
    $rc==0 or return ($rc, $details, $trace);

    ($rc, [rpcarray_values $details], $trace);
}


#T
sub reindexCollection($)
{   my ($self, $coll) = @_;
    $self->rpcClient->reindexCollection(string => $coll);
}


#T
sub removeCollection($)
{   my ($self, $coll) = @_;
    $self->rpcClient->removeCollection(string => $coll);
}

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

#T
sub login($;$)
{   my ($self, $user, $password) = @_;
    $self->{user}     = $user;
    $self->{password} = defined $password ? $password : '';
    $self->rpcClient->headers->header(Authorization => 'Basic '
      . encode_base64("$user:$password", ''));
    (0);
}


#T
sub listGroups()
{   my ($rc, $details, $trace) = shift->rpcClient->getGroups;
    $rc==0 or return ($rc, $details, $trace);
    (0, [rpcarray_values $details], $trace);
}


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


#T
sub listDocumentPermissions($)
{   my ($self, $coll) = @_;
    $coll ||= $self->{repository};
    my ($rc, $details, $trace)
      = $self->rpcClient->listDocumentPermissions(string => $coll);

    $rc==0 or return ($rc, $details, $trace);
    my $h = struct_to_hash $details;
    my %h;
    while( my ($k,$v) = each %$h)
    {   $h{$k} = [ rpcarray_values $v ];
    }
    (0, \%h, $trace);
}


#T
sub describeAccount($)
{   my ($self, $user) = @_;

    my $call = $self->serverVersion lt "3.0" ? 'getUser' : 'getAccount';
    my ($rc, $details, $trace) = $self->rpcClient->$call(string => $user);
    $rc==0 or return ($rc, $details, $trace);

    my $h = struct_to_hash $details;
    $h->{groups}   = [ rpcarray_values $h->{groups} ];
    $h->{metadata} = struct_to_hash $h->{metadata};
    (0, $h, $trace);
}


*describeUser = \&describeAccount;


#T
sub listAccounts()
{   my $self = shift;
    my $call = $self->serverVersion lt "3.0" ? 'getUsers' : 'getAccounts';

    my ($rc, $details, $trace) = $self->rpcClient->$call;
    $rc==0 or return ($rc, $details, $trace);
    my %h;
    foreach my $user (rpcarray_values $details)
    {   my $u = struct_to_hash $user;
        $u->{groups}   = [ rpcarray_values $u->{groups} ];
        $u->{metadata} = struct_to_hash $u->{metadata};
        $h{$u->{name}} = $u;
    }
    (0, \%h, $trace);
}


*listUsers = \&listAccounts;



#T
sub removeAccount($)
{   my ($self, $username) = @_;
    my $call = $self->serverVersion lt "3.0" ? 'removeUser' : 'removeAccount';
    $_[0]->rpcClient->$call(string => $username);
}
*removeUser = \&removeAccount;


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

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


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

    my $call = $self->serverVersion lt '3.0' ? 'setUser' : 'addAccount';

    $self->rpcClient->$call(string => $user
      , string => md5_base64($password)
      , string => md5_hex("$user:exist:$password")
      , rpcarray_from(string => @groups)
      , ($home ? (string => $home) : ())
      );
}
*setUser = \&addAccount;



#T
sub describeCollectionPermissions(;$)
{   my ($self, $coll) = @_;
    $coll ||= $self->{repository};
    my ($rc, $data, $trace)
      = $self->rpcClient->listCollectionPermissions(string => $coll);
    $rc==0 or return ($rc, $data, $trace);

    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, $trace);
}

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

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


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


sub describeResource($)
{   my ($self, $resource) = @_;

    my ($rc, $details, $trace)
      = $self->rpcClient->describeResource(string => $resource);
    $rc==0 or return ($rc, $details, $trace);

    ($rc, struct_to_hash $details, $trace);
}


#T
sub countResources(;$)
{   my ($self, $coll) = @_;
    $coll ||= $self->{repository};
    $self->rpcClient->getResourceCount(string => $coll);
}


### two-params version needed?
sub moveResource($$$)
{   my $self = shift;
    $self->rpcClient->moveResource(string=> $_[0], string=> $_[1], string=> $_[2]);
}


#T
sub getDocType($)
{   my ($rc, $details, $trace) = $_[0]->rpcClient->getDocType(string => $_[1]);
    $rc==0 or return ($rc, $details, $trace);

    my @d = rpcarray_values $details;
    ($rc, +{docname => $d[0], public_id => $d[1], system_id => $d[2]}, $trace);
}


#T
sub setDocType($$$$)
{   my ($self, $doc, $name, $pub, $sys) = @_;
    $self->rpcClient->setDocType(string => $doc
      , string => $name, string => $pub, string => $sys);
}


sub whoLockedResource($) {$_[0]->rpcClient->hasUserLock(string => $_[1]) }


sub unlockResource($) {$_[0]->rpcClient->unlockResource(string => $_[1]) }


sub lockResource($;$)
{   my ($self, $resource, $user) = @_;
    $user ||= $self->{user}
        or report ERROR => "no default username set nor specified for lock";
    $self->rpcClient->lockResource(string => $resource, string => $user);
}


sub removeResource($) { $_[0]->rpcClient->remove(string => $_[1]) }

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

#T
sub downloadDocument($@)
{   my $self = shift;
    my ($rc, $chunk, $trace) = $self->getDocumentData(@_);
    my @trace = $trace;

    $rc==0 or return ($rc, $chunk, \@trace);

    my @data = \$chunk->{data};
    while($rc==0 && $chunk->{offset})
    {   ($rc, $chunk, $trace) = $chunk->{'supports-long-offset'}
        ? $self->getNextExtendedChunk($chunk->{handle}, $chunk->{offset})
        : $self->getNextChunk($chunk->{handle}, $chunk->{offset});

        $rc or push @data, \$chunk->{data};
        push @trace, $trace;
    }
    $rc==0 or return ($rc, $chunk, \@trace);

    (0, (join '', map $$_, @data), \@trace);
}

# does this also work for binary resources?


sub listResourceTimestamps($)
{   my ($self, $resource) = @_;
    my ($rc, $stamps, $trace)
       = $self->rpcClient->getTimestamps(string => $resource);

    $rc==0 or return ($rc, $stamps, $trace);

    my @s = rpcarray_values $stamps;
    (0, +{created => $s[0], modified => $s[1]}, $trace);
}

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

#T
sub uploadDocument($$@)
{   my ($self, $resource, undef, %args) = @_;
    my $doc    = $self->_document($_[2]);

    my $chunks = exists $args{chunk_size} ? $args{chunk_size} : $self->{chunks};
    my $compr  = exists $args{compress} ? $args{compress} : $args{compr_upload};
    for ($chunks, $compr) { $_ *= 1024 if defined $_ }

    my @dates   = _date_options $args{creation_date}, $args{modify_date};
    my $replace = $args{replace}   || 0;
    my $mime    = $args{mime_type} || 'text/xml';

    # Send file in chunks
    my $to_sent = length $doc;
    my $sent    = 0;

    my ($rc, $tmp, @trace);
    while($sent < $to_sent)
    {   ($rc, $tmp, my $t) = $self->upload($tmp, substr($doc, $sent, $chunks));
        push @trace, $t;
        $rc==0 or return ($rc, $tmp, \@trace);

        $sent += $chunks;
    }

    ($rc, my $d, my $t)
       = $self->parseLocal($tmp, $resource, $replace, $mime, @dates);
    push @trace, $t;
    ($rc, $d, \@trace);
}


sub downloadBinary($) { $_[0]->rpcClient->getBinaryResource(string => $_[1]) }


sub uploadBinary($$$$;$$)
{   my ($self, $resource, $bytes, $mime, $replace, $created, $modified) = @_;

    $self->rpcClient->storeBinary
      ( base64 => (ref $bytes ? $$bytes : $bytes)
      , string => $resource, string => $mime, boolean => _bool $replace
      , _date_options($created, $modified)
      );
}

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

#T
### compile doesn't return anything
sub compile($@)
{   my ($self, $query) = (shift, shift);
    my @format = $self->_format(@_);

    my ($rc, $d, $trace) = $self->rpcClient->compile(base64 => $query, @format);
    ($rc, ($rc==0 ? struct_to_hash($d) : $d), $trace);
}


#T
# printDiagnostics should accept a base64
sub describeCompile($@)
{   my ($self, $query) = (shift, shift);
    my @format = $self->_format(@_);
    $self->rpcClient->printDiagnostics(string => $query, @format);
}


sub execute($@)
{   my ($self, $handle) = (shift, shift);
    my @format = $self->_format(@_);
    my ($rc, $d, $trace) = $self->rpcClient->execute(string => $handle, @format);
    ($rc, ($rc==0 ? struct_to_hash $d : $d), $trace);
}

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

sub executeQuery($@)
{   my ($self, $query) = @_;
    my @args = (base64 => $query);
    push @args, string => shift if @_ %2;
    push @args, $self->_format(@_);
    $self->rpcClient->executeQuery(@args);
}


sub numberOfResults($) { $_[0]->rpcClient->getHits(int => $_[1]) }


#T
# what does "docid" mean?
sub describeResultSet($)
{   my ($self, $set) = @_;

    my ($rc, $details,$trace) = $self->rpcClient->querySummary(int => $set);
    $rc==0 or return ($rc, $details, $trace);
    my $results = struct_to_hash $details;

    if(my $docs = delete $results->{documents})
    {   my @docs;
        foreach my $result (rpcarray_values $docs)
        {   my ($name, $id, $hits) = rpcarray_values $result;
            push @docs, +{ name => $name, docid => $id, hits => $hits };
        }
        $results->{documents} = \@docs;
    }
    if(my $types = delete $results->{doctypes})
    {   my @types;
        foreach my $result (rpcarray_values $types)
        {   my ($class, $hits) = rpcarray_values $result;
            push @types, +{ class => $class, hits => $hits };
        }
        $results->{doctypes} = \@types;
    }
    ($rc, $results, $trace);
}


#### what kind of params from %args?
#### releaseQueryResult(int $resultid, int $hash)   INT?
sub releaseResultSet($@)
{   my ($self, $results, %args) = @_;
    $self->rpcClient->releaseQueryResult(int => $results, int => 0);
}


sub retrieveResult($$@)
{   my ($self, $set, $pos) = (shift, shift, shift);
    my @format = $self->_format(@_);

    my ($rc, $bytes, $trace)
       = $self->rpcClient->retrieve(int => $set, int => $pos, @format);
    $rc==0 or return ($rc, $bytes, $trace);

    (0, $self->decodeXML($bytes), $trace);
}


# hitCount where describeResultSet() uses 'hits'
#T
sub retrieveResults($@)
{   my ($self, $set) = (shift, shift);
    my @format = $self->_format(@_);

    my ($rc, $bytes, $trace) = $self->rpcClient->retrieveAll(int => $set, @format);
    $rc==0 or return ($rc, $bytes, $trace);

    (0, $self->decodeXML($bytes), $trace);
}

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

#T
# Vector query() is given as alternative but does not exist.
sub query($$$@)
{   my ($self, $query, $limit) = (shift, shift, shift);
    my $first  = @_ % 2 ? shift : 1;
    my @format = $self->_format(@_);

    my ($rc, $bytes, $trace) = $self->rpcClient
      ->query(string => $query, int => $limit, int => $first, @format);
    $rc==0 or return ($rc, $bytes, $trace);

    (0, $self->decodeXML($bytes), $trace);
}


sub queryXPath($;$$@)
{   my ($self, $xpath, $doc, $node) = splice @_, 0, 4;
    my @args = (base64 => $xpath);
    push @args, string => $doc, string => $node // ''
        if defined $doc;
    push @args, $self->_format(@_);

    my ($rc, $data, $trace) = $self->rpcClient->queryP(@args);
    $rc==0 or return ($rc, $data, $trace);

    my $h = struct_to_hash $data;
    my @r;
    foreach my $v (rpcarray_values $h->{results})
    {   if(ref $v eq 'HASH')
        {   #XXX is this correct?
            my ($doc, $loc) = rpcarray_values $v;
            push @r, +{document => $doc, node_id => $loc};
        }
        push @r, $v;
    }
    $h->{results} = \@r;

    (0, $h, $trace);
}

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

sub retrieveDocumentNode($$@)
{   my $self = shift;
    my ($rc, $chunk, $trace) = $self->rpcClient->retrieveFirstChunk(@_);

    my @data = \$chunk->{data};
    while($rc==0 && $chunk->{offset})
    {   ($rc, $chunk) = $chunk->{'supports-long-offset'}
        ? $self->getNextExtendedChunk($chunk->{handle}, $chunk->{offset})
        : $self->getNextChunk($chunk->{handle}, $chunk->{offset});
        $rc or push @data, \$chunk->{data};
    }
    $rc==0 or return ($rc, $chunk, $trace);

    (0, $self->decodeXML(join '', map $$_, @data), $trace);
}

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

### What does the returned int mean?
sub updateResource($$;$)
{   my ($self, $resource, $xupdate, $encoding) = @_;
    $self->rpcClient->xupdateResource(string => $resource, string => $xupdate
      , ($encoding ? (string => $encoding) : ()));
}

### What does the returned int mean?
### Does this update the collection configuration?

sub updateCollection($$)
{   $_[0]->rpcClient->xupdate(string => $_[1], string => $_[2]);
}

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

sub scanIndexTerms($$$;$)
{   my $self = shift;
     my ($rc, $details, $trace);
    if(@_==4)
    {   my ($coll, $begin, $end, $recurse) = @_;
        ($rc, $details, $trace) = $self->rpcClient->scanIndexTerms(string => $coll
          , string => $begin, string => $end, boolean => _bool $recurse);
    }
    else
    {   my ($xpath, $begin, $end) = @_;
        ($rc, $details, $trace) = $self->rpcClient->scanIndexTerms(string => $xpath
          , string => $begin, string => $end);
    }

    $rc==0 or return ($rc, $details, $trace);

    # XXX this has not been tested.  Probably we need to unpack each @occ
    #     via struct_to_hash
    my @occ = rpcarray_values $details;
    ($rc, \@occ, $trace);
}


sub indexedElements($$)
{   my ($self, $coll, $recurse) = @_;
    my ($rc, $details, $trace)
      = $self->rpcClient->getIndexedElements(string => $coll
         , boolean => _bool $recurse);
    $rc==0 or return ($rc, $details, $trace);

### cleanup Vector $details. Per element:
#  1. name of the element
#  2. optional namespace URI
#  3. optional namespace prefix
#  4. number of occurrences of this element as an integer value

    (0, [rpcarray_values $details], $trace);
}


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

sub trace() { shift->rpcClient->trace }

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

#T
sub getCollectionDesc(;$)
{   my ($self, $coll) = @_;
    $coll ||= $self->{repository};
    $self->describeCollection($coll, documents => 1);
}

#---------

sub getDocument($$;$$)
{   my ($self, $resource) = (shift, shift);
    my @args;
    if(@_==3)
    {   my ($enc, $prettyprint, $style) = @_;
        push @args, string => $enc, int => ($prettyprint ? 1 : 0);
        push @args, string => $style if defined $style;
    }
    else
    {   @args = @_;
    }
    $self->rpcClient->getDocument(string => $resource, @args);
}


sub getDocumentAsString($$;$$)
{   my ($self, $resource) = (shift, shift);
    my @args;
    if(@_==3)
    {   my ($enc, $prettyprint, $style) = @_;
        push @args, string => $enc, int => ($prettyprint ? 1 : 0);
        push @args, string => $style if defined $style;
    }
    else
    {   @args = @_;
    }
    $self->rpcClient->getDocumentAsString(string => $resource, @args);
}


sub getDocumentData($@)
{   my ($self, $resource) = (shift, shift);
    my @format = $self->_format(@_);

    my ($rc, $d, $trace)
       = $self->rpcClient->getDocumentData(string => $resource, @format);

    ($rc, ($rc==0 ? struct_to_hash $d : $d), $trace);
}


sub getNextChunk($$)
{   my ($self, $handle, $offset) = @_;
    my ($rc, $d, $trace)
      = $self->rpcClient->getNextChunk(string => $handle, int => $offset);
    ($rc, ($rc==0 ? struct_to_hash $d : $d), $trace);
}


sub getNextExtendedChunk($$)
{   my ($self, $handle, $offset) = @_;
    my ($rc, $d, $trace)
      = $self->rpcClient->getNextChunk(string => $handle, string => $offset);
    ($rc, ($rc==0 ? struct_to_hash $d : $d), $trace);
}

#---------

sub parse($$;$$$)
{   my ($self, $data, $resource, $replace, $created, $modified) = @_;

    $self->rpcClient->parse
      ( base64 => $self->_document($data)
      , string => $resource, int => ($replace ? 1 : 0)
      , _date_options($created, $modified)
      );
}


sub parseLocal($$$$;$$)
{   my ($self, $fn, $resource, $replace, $mime, $created, $modified) = @_;

    $self->rpcClient->parseLocal
      ( string => $fn, string => $resource, boolean => _bool $replace
      , string => $mime, _date_options($created, $modified)
      );
}


sub parseLocalExt($$$$;$$)
{   my ($self, $fn, $res, $replace, $mime, $is_xml, $created, $modified) = @_;

    $self->rpcClient->parseLocal
      ( string => $fn, string => $res, boolean => _bool $replace
      , string => $mime, boolean => _bool $is_xml
      , _date_options($created, $modified)
      );
};


sub upload($;$)
{   my $self = shift;
    my $tmp  = @_ == 2 ? shift : undef;
    $self->rpcClient->upload(string => (defined $tmp ? $tmp : '')
       , base64 => $_[0], int => length($_[0]));
}


sub uploadCompressed($;$)
{   my $self = shift;
    my $tmp  = @_ == 3 ? shift : undef;

### Not sure whether each chunk is compressed separately or the
### data is compressed as a whole.
    $self->rpcClient->uploadCompressed
       ( (defined $tmp ? (string => $tmp) : ())
       , base64 => $_[0], int => length($_[1]));
}


sub storeBinary($$$$;$$) { $_[0]->uploadBinary( @_[2, 1, 3, 4, 5, 6] ) }

#-------

sub retrieveFirstChunk($$@)
{   my $self = shift;
    my @args;
    if($_[0] =~ m/\D/)
    {   my ($docname, $id) = (shift, shift);
        @args = (string => $docname, string => $id);
    }
    else
    {   my ($resultset, $pos) = (shift, shift);
        @args = (int => $resultset, int => $pos);
    }
    my @format = $self->_format(@_);
    my ($rc, $d, $trace) = $self->rpcClient->retrieveFirstChunk(@args, @format);
    ($rc, ($rc==0 ? $d : struct_to_hash $d), $trace);
}

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

sub retrieve($$@)
{   my $self = shift;
    my @args = $_[0] =~ m/\D/
             ? (string => shift, string => shift)
             : (int => shift, int => shift);
    push @args, $self->_format(@_);

    my ($rc, $bytes, $trace) = $self->rpcClient->retrieve(@args);
    ($rc, ($rc==0 ? $self->decodeXML($bytes) : $bytes), $trace);
}


sub retrieveAll($$@)
{   my ($self, $set) = (shift, shift);
    my @format = $self->_format(@_);

    my ($rc, $bytes, $trace)
      = $self->rpcClient->retrieveAll(int => $set, @format);
    ($rc, ($rc==0 ? $self->decodeXML($bytes) : $bytes), $trace);
}


sub retrieveAllFirstChunk($$@)
{   my ($self, $result) = (shift, shift);
    my @format = $self->_format(@_);

    my ($rc, $d, $trace)
      = $self->rpcClient->retrieveAllFirstChunk(int => $result, @format);

    ($rc, ($rc==0 ? struct_to_hash($d) : $d), $trace);
}


sub isValidDocument($)
{   my ($self, $doc) = (shift, shift);
    $self->rpcClient->isValid(string => $doc);
}


sub initiateBackup($)
{   my ($self, $s) = (shift, shift);
    $self->rpcClient->dataBackup($s);
}


sub getDocumentChunked($@)
{   my ($self, $doc) = (shift, shift);
    my ($rc, $data, $trace) = $self->rpcClient->getDocumentChunk(string=> $doc);
    $rc==0 or return ($rc, $data, $trace);

    my ($h, $l) = rpcarray_values $data;
    (0, $h, $l, $trace);
}


sub getDocumentNextChunk($$$)
{   my ($self, $handle, $start, $len) = @_;
    $self->rpcClient->getDocumentChunck(string => $handle
      , int => $start, int => $len);
}


sub retrieveAsString($$@)
{   my ($self, $doc, $node) = (shift, shift, shift);
    $self->rpcClient->retrieveAsString(string => $doc, string => $node
      , $self->_format(@_));
}

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

*createResourceId = \&uniqueResourceName;
*dataBackup = \&initiateBackup;
*getBinaryResource = \&downloadBinary;
*getCreationDate = \&collectionCreationDate;
*getDocumentListing = \&listResources;
*getIndexedElements = \&indexedElements;
*getGroups = \&listGroups;
*getHits = \&numberOfResults;
*getPermissions = \&describeResourcePermissions;
*getResourceCount = \&countResources;
*getTimestamps = \&listResourceTimestamps;
*getUser    = \&describeAccount;
*getAccount = \&describeAccount;
*getUsers   = \&listUsers;
*hasUserLock = \&whoLockedResource;
*isValid = \&isValidDocument;
*listCollectionPermissions = \&describeCollectionPermissions;
*printDiagnostics = \&describeCompile;
*querySummary = \&describeResultSet;
*queryP = \&queryXPath;
*releaseQueryResult = \&releaseResultSet;
*remove = \&removeResource;
*xupdate = \&xupdateCollection;
*xupdateResource = \&xupdateResource;

1;