view release on metacpan or  search on metacpan

lib/Cache/KyotoTycoon.pm  view on Meta::CPAN

    }, $class;
    return $self;
}

sub db {
    my $self = shift;
    $self->{db} = shift if @_;
    $self->{db};
}

sub make_cursor {
    my ($self, $cursor_id) = @_;
    return Cache::KyotoTycoon::Cursor->new($cursor_id, $self->{db}, $self->{client});
}

sub echo {
    my ($self, $args) = @_;
    my ($code, $body, $msg) = $self->{client}->call('echo', $args);
    Carp::croak _errmsg($code, $msg) if $code ne 200;
    return $body;
}

sub report {
    my ($self, ) = @_;
    my ($code, $body, $msg) = $self->{client}->call('report');
    Carp::croak _errmsg($code, $msg) if $code ne 200;
    return $body;
}

sub play_script {
    my ($self, $name, $input) = @_;
    my %args = (name => $name);
    while (my ($k, $v) = each %$input) {
        $args{"_$k"} = $v;
    }
    my ($code, $body, $msg) = $self->{client}->call('play_script', \%args);
    Carp::croak _errmsg($code, $msg) if $code ne 200;
    my %res;
    while (my ($k, $v) = each %$body) {
        $k =~ s!^_!!;
        $res{$k} = $v;
    }
    return \%res;
}

sub status {
    my ($self, ) = @_;
    my ($code, $body, $msg) = $self->{client}->call('status', {DB => $self->db});
    Carp::croak _errmsg($code, $msg) unless $code eq 200;
    return $body;
}

sub clear {
    my ($self, ) = @_;
    my %args = (DB => $self->db);
    my ($code, $body, $msg) = $self->{client}->call('clear', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq 200;
    return;
}

sub synchronize {
    my ($self, $hard, $command) = @_;
    my %args = (DB => $self->db);
    $args{hard} = $hard if $hard;
    $args{command} = $command if defined $command;
    my ($code, $body, $msg) = $self->{client}->call('synchronize', \%args);
    return 1 if $code eq 200;
    return 0 if $code eq 450;
    Carp::croak _errmsg($code, $msg);
}

sub set {
    my ($self, $key, $value, $xt) = @_;
    my %args = (DB => $self->db, key => $key, value => $value);
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('set', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq 200;
    return;
}

sub add {
    my ($self, $key, $value, $xt) = @_;
    my %args = (DB => $self->db, key => $key, value => $value);
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('add', \%args);
    return 1 if $code eq '200';
    return 0 if $code eq '450';
    Carp::croak _errmsg($code, $msg);
}

sub replace {
    my ($self, $key, $value, $xt) = @_;
    my %args = (DB => $self->db, key => $key, value => $value);
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('replace', \%args);
    return 1 if $code eq '200';
    return 0 if $code eq '450';
    Carp::croak _errmsg($code, $msg);
}

sub append {
    my ($self, $key, $value, $xt) = @_;
    my %args = (DB => $self->db, key => $key, value => $value);
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('append', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    return;
}

sub increment {
    my ($self, $key, $num, $xt) = @_;
    my %args = (DB => $self->db, key => $key, num => $num);
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('increment', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    return $body->{num};
}

sub increment_double {
    my ($self, $key, $num, $xt) = @_;
    my %args = (DB => $self->db, key => $key, num => $num);
    $args{xt} = $xt if defined $xt;
    my ($code, $body, $msg) = $self->{client}->call('increment_double', \%args);
    Carp::croak _errmsg($code, $msg) unless $code eq '200';
    return $body->{num};
}

lib/Cache/KyotoTycoon.pm  view on Meta::CPAN

Port number of server process. 

I<Default>: 1978 

=item C<< db >>

DB name or id.

I<Default>: 0

=back

=head1 METHODS

=over 4

=item C<< $kt->db() >>

Getter/Setter of DB name/id.

=item C<< my $cursor: Cache::KyotoTycoon::Cursor = $kt->make_cursor($cursor_number: Int); >>

Create new cursor object. This method returns instance of L<Cache::KyotoTycoon::Cursor>.

=item C<< my $res = $kt->echo($args) >>

The server returns $args. This method is useful for testing server.

$args is hashref.

I<Return>: the copy of $args.

=item C<< $kt->report() >>

Get server report.

I<Return>: server status information in hashref.

=item C<< my $output = $kt->play_script($name[, \%input]); >>

Call a procedure of the script language extension.

I<$name>: the name of the procedure to call.
I<\%input>: (optional): arbitrary records.

I<Return>: response of the script in hashref.

=item C<< my $info = $kt->status() >>

Get database status information.

I<Return>: database status information in hashref.

=item C<< $kt->clear() >>

Remove all elements for the storage.

I<Return>: Not a useful value.

=item C<< $kt->synchronize($hard:Bool, $command); >>

Synchronize database with file system.

I<$hard>: call fsync() or not.

I<$command>: call $command in synchronization state.

I<Return>: 1 if succeeded, 0 if $command returns false.

=item C<< $kt->set($key, $value, $xt); >>

Store I<$value> to I<$key>.

I<$xt>: expiration time. If $xt>0, expiration time in seconds from now. If $xt<0, the epoch time. It is never remove if missing $xt.

I<Return>: not a useful value.

=item C<< my $ret = $kt->add($key, $value, $xt); >>

Store record. This method is not store if the I<$key> is already in the database.

I<$xt>: expiration time. If $xt>0, expiration time in seconds from now. If $xt<0, the epoch time. It is never remove if missing $xt.

I<Return>: 1 if succeeded. 0 if $key is already in the db.

=item C<< my $ret = $kt->replace($key, $value, $xt); >>

Store the record, ignore if the record is not exists in the database.

I<$xt>: expiration time. If $xt>0, expiration time in seconds from now. If $xt<0, the epoch time. It is never remove if missing $xt.

I<Return>: 1 if succeeded. 0 if $key is not exists in the database.

=item C<< my $ret = $kt->append($key, $value, $xt); >>

Store the record, append the $value to existent record if already exists entry.

I<$xt>: expiration time. If $xt>0, expiration time in seconds from now. If $xt<0, the epoch time. It is never remove if missing $xt.

I<Return>: not useful value. 

=item C<< my $ret = $kt->increment($key, $num, $xt); >>

I<$num>: incremental

I<Return>: value after increment. 

=item C<< my $ret = $kt->increment_double($key, $num, $xt); >>

I<$num>: incremental

I<Return>: value after increment. 

=item C<< my $ret = $kt->cas($key, $oval, $nval, $xt); >>

compare and swap.

I<$oval>: old value
I<$nval>: new value

I<Return>: 1 if succeeded, 0 if failed.

=item C<< $kt->remove($key); >>

Remove I<$key> from database.