Cache-KyotoTycoon
view release on metacpan or search on metacpan
0.13
- fixed testing issue with recent Test-TCP
https://github.com/tokuhirom/test-tcp/issues/3
(reported by ktat++)
- And modernized package
0.12
- $cursor->get() returns $xt.(tokuhirom)
- doc enhancements(tokuhirom)
0.11
- display better error message.
0.10
- $kt->get() returns $xt on list context.
cpanfile
lib/Cache/KyotoTycoon.pm
lib/Cache/KyotoTycoon/Cursor.pm
lib/TSVRPC/Client.pm
lib/TSVRPC/Parser.pm
lib/TSVRPC/Util.pm
t/00_compile.t
t/Util.pm
t/live/001_basic.t
t/live/002_misc.t
t/live/003_cursor.t
t/live/004_script.t
t/live/005_err.t
t/myecho.lua
t/tsvrpc/001_simple.t
xt/02_perlcritic.t
META.yml
MANIFEST
DB name or id.
_Default_: 0
# METHODS
- `$kt->db()`
Getter/Setter of DB name/id.
- `my $cursor: Cache::KyotoTycoon::Cursor = $kt->make_cursor($cursor_number: Int);`
Create new cursor object. This method returns instance of [Cache::KyotoTycoon::Cursor](https://metacpan.org/pod/Cache::KyotoTycoon::Cursor).
- `my $res = $kt->echo($args)`
The server returns $args. This method is useful for testing server.
$args is hashref.
_Return_: the copy of $args.
- `$kt->report()`
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 {
lib/Cache/KyotoTycoon.pm view on Meta::CPAN
=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() >>
lib/Cache/KyotoTycoon/Cursor.pm view on Meta::CPAN
package Cache::KyotoTycoon::Cursor;
use strict;
use warnings;
# Do not call this method manually.
sub new {
my ($class, $cursor_id, $db, $client) = @_;
bless { db => $db, client => $client, cursor => $cursor_id }, $class;
}
sub jump {
my ($self, $key) = @_;
my %args = (DB => $self->{db}, CUR => $self->{cursor});
$args{key} = $key if defined $key;
my ($code, $body, $msg) = $self->{client}->call('cur_jump', \%args);
return 1 if $code eq 200;
return 0 if $code eq 450;
die Cache::KyotoTycoon::_errmsg($code, $msg);
}
sub jump_back {
my ($self, $key) = @_;
my %args = (DB => $self->{db}, CUR => $self->{cursor});
$args{key} = $key if defined $key;
my ($code, $body, $msg) = $self->{client}->call('cur_jump_back', \%args);
return 1 if $code eq 200;
return 0 if $code eq 450;
die Cache::KyotoTycoon::_errmsg($code, $msg);
}
sub step {
my ($self, ) = @_;
my %args = (CUR => $self->{cursor});
my ($code, $body, $msg) = $self->{client}->call('cur_step', \%args);
return 1 if $code eq '200';
return 0 if $code eq '450';
die Cache::KyotoTycoon::_errmsg($code, $msg);
}
sub step_back {
my ($self, ) = @_;
my %args = (CUR => $self->{cursor});
my ($code, $body, $msg) = $self->{client}->call('cur_step_back', \%args);
return 1 if $code eq '200';
return 0 if $code eq '450';
die Cache::KyotoTycoon::_errmsg($code, $msg);
}
sub set_value {
my ($self, $value, $xt, $step) = @_;
my %args = (CUR => $self->{cursor}, value => $value);
$args{xt} = $xt if defined $xt;
$args{step} = '' if defined $step;
my ($code, $body, $msg) = $self->{client}->call('cur_set_value', \%args);
return 1 if $code eq '200';
return 0 if $code eq '450';
die Cache::KyotoTycoon::_errmsg($code, $msg);
}
sub remove {
my ($self,) = @_;
my %args = (CUR => $self->{cursor});
my ($code, $body, $msg) = $self->{client}->call('cur_remove', \%args);
return 1 if $code eq '200';
return 0 if $code eq '450';
die Cache::KyotoTycoon::_errmsg($code, $msg);
}
sub get_key {
my ($self, $step) = @_;
my %args = (CUR => $self->{cursor});
$args{step} = '' if defined $step;
my ($code, $body, $msg) = $self->{client}->call('cur_get_key', \%args);
return $body->{key} if $code eq '200';
return if $code eq '450';
die Cache::KyotoTycoon::_errmsg($code, $msg);
}
sub get_value {
my ($self, $step) = @_;
my %args = (CUR => $self->{cursor});
$args{step} = '' if defined $step;
my ($code, $body, $msg) = $self->{client}->call('cur_get_value', \%args);
return $body->{value} if $code eq '200';
return if $code eq '450';
die Cache::KyotoTycoon::_errmsg($code, $msg);
}
sub get {
my ($self, $step) = @_;
my %args = (CUR => $self->{cursor});
$args{step} = '' if defined $step;
my ($code, $body, $msg) = $self->{client}->call('cur_get', \%args);
return ($body->{key}, $body->{value}, $body->{xt}) if $code eq '200';
return if $code eq '450';
die Cache::KyotoTycoon::_errmsg($code, $msg);
}
sub delete {
my ($self, ) = @_;
my %args = (CUR => $self->{cursor});
my ($code, $body, $msg) = $self->{client}->call('cur_delete', \%args);
return if $code eq '200';
die Cache::KyotoTycoon::_errmsg($code, $msg);
}
1;
__END__
=for stopwords TreeDB
=head1 NAME
Cache::KyotoTycoon::Cursor - Cursor class for KyotoTycoon
=head1 SYNOPSIS
use Cache::KyotoTycoon;
my $kt = Cache::KyotoTycoon->new(...);
my $cursor = $kt->make_cursor(1);
$cursor->jump();
while (my ($k, $v) = $cursor->get(1)) {
print "$k: $v";
}
$cursor->delete;
=head1 METHODS
=over 4
=item C<< $cursor->jump([$key]); >>
Jump the cursor.
I<$key>: destination record of the jump. The first key if missing.
I<Return>: not useful
=item C<< $cursor->jump_back([$key]); >>
Jump back the cursor. This method is only available on TreeDB.
I<$key>: destination record of the jump. The first key if missing.
I<Return>: 1 if succeeded, 0 if the record is not exists.
I<Exception>: die if /rpc/jump_back is not implemented.
=item C<< $cursor->step(); >>
Move cursor to next record.
I<Return>: 1 if succeeded, 0 if the next record is not exists.
=item C<< $cursor->step_back() >>
Step the cursor to the previous record.
I<Return>: 1 on success, or 0 on failure.
=item C<< $cursor->set_value($xt, $step); >>
Set the value of the current record.
I<$value> the value.
I<$xt> the expiration time from now in seconds. If it is negative, the absolute value is treated as the epoch time.
I<$step> true to move the cursor to the next record, or false for no move.
I<Return>: 1 on success, or 0 on failure.
=item C<< $cursor->remove(); >>
Remove the current record.
I<Return>: 1 on success, or 0 on failure.
=item C<< my $key = $cursor->get_key([$step]) >>
Get the key of the current record.
I<$step>: true to move the cursor to the next record, or false for no move.
I<Return>: key on success, or undef on failure.
=item C<< my $value = $cursor->get_value([$step]); >>
Get the value of the current record.
I<$step>: true to move the cursor to the next record, or false for no move.
I<Return>: value on success, or undef on failure.
=item C<< my ($key, $value, $xt) = $cursor->get([$step]); >>
Get a pair of the key and the value of the current record.
I<$step>: true to move the cursor to the next record, or false for no move.
I<Return>: pair of key, value and expiration time on success, or empty list on failure.
=item C<< $cursor->delete(); >>
Delete the cursor immediately.
I<Return>: not useful.
=back
t/live/003_cursor.t view on Meta::CPAN
use warnings;
use Test::More;
use Cache::KyotoTycoon;
use t::Util;
use Data::Dumper;
test_kt(
sub {
my $port = shift;
my $kt = Cache::KyotoTycoon->new(port => $port);
my $cursor = $kt->make_cursor(1);
is $cursor->jump(), 0;
$kt->set_bulk({a => 1, b => 2, c => 3});
$kt->set(d => 4, 24*60*60);
is $cursor->jump('b'), 1;
{
is $cursor->get_key(), 'b';
is $cursor->get_value(), '2';
$cursor->set_value("OK");
is $cursor->get_value(), 'OK';
my ($k, $v, $xt) = $cursor->get(1);
is $k, 'b';
is $v, 'OK';
is $xt, undef;
}
{
my ($k, $v) = $cursor->get();
isnt $k, 'b';
}
my $k = $cursor->get_key();
ok $kt->get($k);
is $cursor->remove(), 1;
is $kt->get($k), undef;
subtest 'xt' => sub {
ok $cursor->jump('d');
my ($key, $val, $xt) = $cursor->get();
is $key, 'd';
is $val, 4;
cmp_ok abs($xt-(24*60*60+time())), '<', 10, 'xt';
};
$cursor->delete;
done_testing;
},
);
( run in 0.356 second using v1.01-cache-2.11-cpan-4d50c553e7e )