tie interface

This commit is contained in:
Kenichi Ishigaki 2013-07-04 13:20:58 +09:00
parent cc65858f58
commit 008d6ea2f3
2 changed files with 107 additions and 0 deletions

View file

@ -2,6 +2,7 @@ package UnQLite;
use 5.008005;
use strict;
use warnings;
use Carp ();
our $VERSION = "0.01";
our $rc = 0;
@ -9,6 +10,12 @@ our $rc = 0;
use XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);
sub TIEHASH {
my $class = shift;
my $self = $class->open(@_) or croak $class->errstr;
$self->cursor_init;
}
sub rc { $UnQLite::rc }
sub errstr {
@ -96,6 +103,60 @@ sub DESTROY {
_release($self->[0], $self->[1]);
}
# tie interface
sub FETCH {
my ($self, $key) = @_;
$self->[1]->kv_fetch($key);
}
sub STORE {
my ($self, $key, $value) = @_;
$self->[1]->kv_store($key, $value) or croak $self->[1]->errstr;
$value;
}
sub DELETE {
my ($self, $key) = @_;
my $prev = $self->kv_fetch($key);
$self->[1]->kv_delete($key) or croak $self->[1]->errstr;
$prev;
}
sub FIRSTKEY {
my $self = shift;
$self->first_entry or return;
$self->key;
}
sub NEXTKEY {
my $self = shift;
$self->next_entry or return;
$self->key;
}
sub EXISTS {
my ($self, $key) = @_;
$self->[1]->kv_fetch($key);
my $errstr = $self->[1]->errstr;
return $errstr eq 'UNQLITE_NOTFOUND' ? 1 : 0;
}
sub CLEAR {
my $self = shift;
$self->first_entry or return;
$self->delete_entry while $self->valid_entry;
return;
}
sub SCALAR {
my $self = shift;
$self->first_entry or return;
my $ct = 1;
$ct++ while $self->next_entry && $self->valid_entry;
return $ct;
}
1;
__END__
@ -117,6 +178,11 @@ UnQLite - Perl bindings for UnQLite
$db->kv_delete('foo');
undef $db; # close database
# tie interface
tie my %hash, 'UnQLite', 'foo.db';
$hash{foo} = 'bar';
say $hash{foo}; # => bar
=head1 DESCRIPTION
UnQLite is a in-process software library which implements a self-contained, serverless, zero-configuration, transactional NoSQL database engine. UnQLite is a document store database similar to MongoDB, Redis, CouchDB etc. as well a standard Key/Value store similar to BerkeleyDB, LevelDB, etc.

41
t/03_tie.t Normal file
View file

@ -0,0 +1,41 @@
use strict;
use Test::More;
use File::Temp qw(tempdir);
use UnQLite;
my $tmp = tempdir( CLEANUP => 1 );
{
my $db = UnQLite->open("$tmp/foo.db");
isa_ok($db, 'UnQLite');
ok($db->kv_store("foo", "bar"));
is($db->kv_fetch('foo'), 'bar');
ok($db->kv_delete('foo'));
is($db->kv_fetch('foo'), undef);
$db->kv_store('yay', 'yap');
$db->kv_append('yay', 'po');
is($db->kv_fetch('yay'), 'yappo');
is($db->rc,0);
}
{
ok -e "$tmp/foo.db", "foo.db exists";
tie my %hash, 'UnQLite', "$tmp/foo.db";
# stored data can be retrieved again?
is($hash{yay}, 'yappo');
$hash{foo} = 'baz';
is($hash{foo}, 'baz');
is(join(" ", sort keys %hash), "foo yay");
is(join(" ", sort values %hash), "baz yappo");
is(scalar %hash, 2);
%hash = ();
is(join(" ", sort keys %hash), "");
is(join(" ", sort values %hash), "");
is(scalar %hash, undef);
}
done_testing;