File Coverage

blib/lib/Couchbase/Client.pm

Criterion	Covered	Total	%
statement	39	105	37.1
branch	0	34	0.0
condition	0	20	0.0
subroutine	13	19	68.4
pod	1	1	100.0
total	53	179	29.6

package Couchbase::Client;

BEGIN {
    require XSLoader;
    our $VERSION = '2.0.0_1';
    XSLoader::load(__PACKAGE__, $VERSION);
}

use strict;
use warnings;

use Couchbase::Client::Errors;
use Couchbase::Client::IDXConst;
use Couchbase::Client::Return;
use Couchbase::Client::Iterator;

my $have_storable = eval "use Storable; 1;";
my $have_zlib = eval "use Compress::Zlib; 1;";

use Array::Assign;

{
    no warnings 'once';
    *gets = \&get;
    *gets_multi = \&get_multi;
    *gets_multi_A = \&get_multi_A;

    *delete_multi = \&remove_multi;
    *delete_multi_A = \&remove_multi_A;
}

# Get the CouchDB (2.0) API
use Couchbase::Couch::Base;
use base qw(Couchbase::Couch::Base);

#this function converts hash options for compression and serialization
#to something suitable for construct()

sub _make_conversion_settings {
    my ($arglist,$options) = @_;
    my $flags = 0;


    $arglist->[CTORIDX_MYFLAGS] ||= 0;

    if($options->{dereference_scalar_ref}) {
        $arglist->[CTORIDX_MYFLAGS] |= fDEREF_RVPV;
    }

    if(exists $options->{deconversion}) {
        if(! delete $options->{deconversion}) {
            return;
        }
    } else {
        $flags |= fDECONVERT;
    }

    if(exists $options->{compress_threshold}) {
        my $compress_threshold = delete $options->{compress_threshold};
        $compress_threshold =
            (!$compress_threshold || $compress_threshold < 0)
            ? 0 : $compress_threshold;
        $arglist->[CTORIDX_COMP_THRESHOLD] = $compress_threshold;
        if($compress_threshold) {
            $flags |= fUSE_COMPRESSION;
        }
    }

    my $meth_comp;
    if(exists $options->{compress_methods}) {
        $meth_comp = delete $options->{compress_methods};
    } elsif($have_zlib) {
        $meth_comp = [ sub { ${$_[1]} = Compress::Zlib::memGzip(${$_[0]}) },
                      sub { ${$_[1]} = Compress::Zlib::memGunzip(${$_[0]}) }]
    }

    if(defined $meth_comp) {
        $arglist->[CTORIDX_COMP_METHODS] = $meth_comp;
    }

    my $meth_serialize = 0;
    if(exists $options->{serialize_methods}) {
        $meth_serialize = delete $options->{serialize_methods};
    }

    if($meth_serialize == 0 && $have_storable) {
        $meth_serialize = [ \&Storable::freeze, \&Storable::thaw ];
    }

    if($meth_serialize) {
        $flags |= fUSE_STORABLE;
        $arglist->[CTORIDX_SERIALIZE_METHODS] = $meth_serialize;
    }

    $arglist->[CTORIDX_MYFLAGS] |= $flags;
}

sub _MkCtorIDX {
    my $opts = shift;

    my @arglist;
    my $server = delete $opts->{server} or die "Must have server";
    arry_assign_i(@arglist,
        CTORIDX_SERVERS, $server,
        CTORIDX_USERNAME, delete $opts->{username},
        CTORIDX_PASSWORD, delete $opts->{password},
        CTORIDX_BUCKET, delete $opts->{bucket});

    _make_conversion_settings(\@arglist, $opts);

    my $tmp = delete $opts->{io_timeout} ||
            delete $opts->{select_timeout} ||
            delete $opts->{connect_timeout} ||
            delete $opts->{timeout};

    $tmp ||= 2.5;
    $arglist[CTORIDX_TIMEOUT] = $tmp if defined $tmp;
    $arglist[CTORIDX_NO_CONNECT] = delete $opts->{no_init_connect};


    if(keys %$opts) {
        warn sprintf("Unused keys (%s) in constructor",
                     join(", ", keys %$opts));
    }
    __PACKAGE__->_CouchCtorInit(\@arglist);
    return \@arglist;
}

sub new {
    my ($pkg,$opts) = @_;
    my $server_str;
    my $server_spec = $opts->{servers} || $opts->{server};

    if (ref $server_spec eq 'ARRAY') {
        $server_str = join(";", @$server_spec);
    } else {
        $server_str = $server_spec;
    }

    if (!$server_str) {
        die("Must have 'servers' or 'server'");
    }

    my $privopts = { %$opts };

    $privopts->{server} = $server_str;
    delete $privopts->{servers};
    my $arglist = _MkCtorIDX($privopts);
    my $self = $pkg->construct($arglist);
    return $self;
}

#This is called from within C to record our stats:
sub _stats_helper {
    my ($hash,$server,$key,$data) = @_;
    #printf("Got server %s, key%s\n", $server, $key);
    $key ||= "__default__";
    ($hash->{$server}->{$key} ||= "") .= $data;
}

1;

__END__