perl bindings

master
Vitaliy Filippov 2015-03-20 17:56:04 +03:00
commit 95cba3e7c7
4 changed files with 917 additions and 0 deletions

50
Makefile.PL Executable file
View File

@ -0,0 +1,50 @@
use strict;
use utf8;
use File::Fetch;
use Archive::Extract;
use FindBin;
use ExtUtils::MakeMaker;
my $sophia = $FindBin::Bin ."/Sophia-src";
my $sophia_src = "$sophia/db";
my $rc = eval
{
require 5.010;
Term::ReadKey->import();
1;
};
if($rc && !-e "sophia-master")
{
eval {
my $ff = File::Fetch->new(uri => "http://github.com/pmwkaa/sophia/archive/master.zip");
if(my $file = $ff->fetch())
{
my $ae = Archive::Extract->new( archive => $file );
$ae->extract( to => '.' );
}
};
}
$sophia = $FindBin::Bin ."/sophia-master";
$sophia_src = -e "$sophia/db" ? "$sophia/db" : $sophia;
`make -C $sophia_src libsophia.a`;
WriteMakefile(
AUTHOR => 'Alexander Borisov <lex.borisov@gmail.com>',
ABSTRACT_FROM => 'Sophia.pm',
VERSION_FROM => 'Sophia.pm',
NAME => 'Database::Sophia',
LICENSE => 'perl',
LINKTYPE => 'dynamic',
LIBS => ["-L$sophia_src -lsophia -lpthread"],
INC => '-I'. $sophia_src
);

404
Sophia.pm Executable file
View File

@ -0,0 +1,404 @@
package Database::Sophia;
use utf8;
use strict;
use vars qw($AUTOLOAD $VERSION $ABSTRACT @ISA @EXPORT);
BEGIN {
$VERSION = 0.8;
$ABSTRACT = "Sophia is a modern embeddable key-value database designed for a high load environment (XS for Sophia)";
@ISA = qw(Exporter DynaLoader);
@EXPORT = qw(
SPDIR SPALLOC SPCMP SPPAGE SPGC SPGCF
SPGROW SPMERGE SPMERGEWM SPMERGEFORCE SPVERSION
SPO_RDONLY SPO_RDWR SPO_CREAT SPO_SYNC
SPGT SPGTE SPLT SPLTE
);
};
bootstrap Database::Sophia $VERSION;
use DynaLoader ();
use Exporter ();
1;
__END__
=head1 NAME
Database::Sophia - Sophia is a modern embeddable key-value database designed for a high load environment (XS for Sophia)
=head1 SYNOPSIS
use Database::Sophia;
my $env = Database::Sophia->sp_env();
my $err = $env->sp_ctl(SPDIR, SPO_CREAT|SPO_RDWR, "./db");
die $env->sp_error() if $err == -1;
my $db = $env->sp_open();
die $env->sp_error() unless $db;
$err = $db->sp_set("login", "lastmac");
print $db->sp_error(), "\n" if $err == -1;
my $value = $db->sp_get("login", $err);
if($err == -1) {
print $db->sp_error(), "\n";
}
elsif($err == 0) {
print "Key not found", "\n";
}
elsif($err == 1) {
print "Key found", "\n";
print "login: ", $value, "\n";
}
$db->sp_destroy();
$env->sp_destroy();
=head1 DESCRIPTION
It has unique architecture that was created as a result of research and rethinking of primary algorithmic constraints, associated with a getting popular Log-file based data structures, such as LSM-tree.
See http://sphia.org/
=head1 METHODS
=head2 sp_env
create a new environment handle
my $env = Database::Sophia->sp_env();
=head2 sp_ctl
configurate a database
=head3 SPDIR
Sets database directory path and it's open flags to use by sp_open().
$env->sp_ctl(SPDIR, SPO_CREAT|SPO_RDWR, "./db");
=item Possible flags are:
SPO_RDWR - open repository in read-write mode (default)
SPO_RDONLY - open repository in read-only mode
SPO_CREAT - create repository if it is not exists.
=back
=head3 SPCMP
Sets database comparator function to use by database for a key order determination.
my $sub_cmp = sub {
my ($key_a, $key_b, $arg) = @_;
}
$env->sp_ctl(SPCMP, $sub_cmp, "arg to callback");
=head3 SPPAGE
Sets database max key count in a single page. This option can be tweaked for performance.
$env->sp_ctl(SPPAGE, 1024);
=head3 SPGC
Sets flag that garbage collector should be turn on.
$env->sp_ctl(SPGC, 1);
=head3 SPGCF
Sets database garbage collector factor value, which is used to determine whether it is time to start gc.
$env->sp_ctl(SPGCF, 0.5);
=head3 SPGROW
Sets new database files initial new size and resize factor. This values are used while database extend during merge.
$env->sp_ctl(SPGROW, 16 * 1024 * 1024, 2.0);
=head3 SPMERGE
Sets flag that merger thread must be created during sp_open().
$env->sp_ctl(SPMERGE, 1);
=head3 SPMERGEWM
Sets database merge watermark value.
$env->sp_ctl(SPMERGEWM, 200000);
=head2 sp_open
Open or create a database
my $db = $env->sp_open();
On success, return database object; On error, it returns undef.
=head2 sp_error
Get a string error description
$env->sp_error();
=head2 sp_destroy
Free any handle
$ptr->sp_destroy();
=head2 sp_begin
Begin a transaction
$db->sp_begin();
=head2 sp_commit
Apply a transaction
$db->sp_commit();
=head2 sp_rollback
Discard a transaction changes
$db->sp_rollback();
=head2 sp_set
Insert or replace a key-value pair
$db->sp_set("key", "value");
=head2 sp_get
Find a key in a database
my $error;
$db->sp_get("key", $error);
=head2 sp_delete
Delete key from a database
$db->sp_delete("key");
=head2 sp_cursor
create a database cursor
my $cur = $db->sp_cursor(SPGT, "key");
=item Possible order are:
SPGT - increasing order (skipping the key, if it is equal)
SPGTE - increasing order (with key)
SPLT - decreasing order (skippng the key, if is is equal)
SPLTE - decreasing order
=back
After a use, cursor handle should be freed by $cur->sp_destroy() function.
=head2 sp_fetch
Iterate a cursor
$cur->sp_fetch();
=head2 sp_key
Get current key
$cur->sp_key()
=head2 sp_keysize
$cur->sp_keysize()
=head2 sp_value
$cur->sp_value()
=head2 sp_valuesize
$cur->sp_valuesize()
=head1 Example
=head2 sp_open
use Database::Sophia;
my $env = Database::Sophia->sp_env();
my $err = $env->sp_ctl(SPDIR, SPO_CREAT|SPO_RDWR, "./db");
die $env->sp_error() if $err == -1;
my $db = $env->sp_open();
die $env->sp_error() unless $db;
=head2 sp_error
my $db = $env->sp_open();
die $env->sp_error() unless $db;
=head2 sp_destroy
$db->sp_destroy();
$cur->sp_destroy();
$env->sp_destroy();
=head2 sp_begin
my $rc = $db->sp_begin();
print $env->sp_error(), "\n" if $rc == -1;
$rc = $db->sp_set("key", "value");
print $env->sp_error(), "\n" if $rc == -1;
$rc = $db->sp_commit();
print $env->sp_error(), "\n" if $rc == -1;
=head2 sp_commit
See sp_begin
=head2 sp_rollback
my $rc = $db->sp_begin();
print $env->sp_error(), "\n" if $rc == -1;
$rc = $db->sp_set("key", "value");
print $env->sp_error(), "\n" if $rc == -1;
$rc = $db->sp_rollback();
print $env->sp_error(), "\n" if $rc == -1;
=head2 sp_set
$rc = $db->sp_set("key", "value");
print $env->sp_error(), "\n" if $rc == -1;
=head2 sp_get
my $error;
my $value = $db->sp_get("key", $error);
if($error == -1) {
print $db->sp_error(), "\n";
}
elsif($error == 0) {
print "Key not found", "\n";
}
elsif($error == 1) {
print "Key found", "\n";
print "key: ", $value, "\n";
}
=head2 sp_fetch
my $cur = $db->sp_cursor(SPGT, "key");
while($cur->sp_fetch()) {
print $cur->sp_key(), ": ", $cur->sp_value();
print $cur->sp_keysize(), ": ", $cur->sp_valuesize();
}
$cur->sp_destroy();
=head2 sp_key
See sp_fetch
=head2 sp_keysize
See sp_fetch
=head2 sp_value
See sp_fetch
=head2 sp_valuesize
See sp_fetch
=head1 DESTROY
undef $obj;
Free mem and destroy object.
=head1 AUTHOR
Alexander Borisov <lex.borisov@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2014 by Alexander Borisov.
This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.
See libsophia license and COPYRIGHT
http://sphia.org/
=cut

450
Sophia.xs Executable file
View File

@ -0,0 +1,450 @@
// (c) Vitaliy Filippov 2015+
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <stdarg.h>
#include <sophia.h>
typedef struct
{
void *ptr;
}
sophia_env_t;
typedef struct
{
void *ptr;
}
sophia_ctl_t;
typedef struct
{
void *ptr;
}
sophia_db_t;
typedef struct
{
void *ptr;
}
sophia_txn_t;
typedef struct
{
void *ptr;
}
sophia_snapshot_t;
typedef struct
{
void *ptr;
}
sophia_cursor_t;
typedef sophia_env_t * Database__Sophia;
typedef sophia_ctl_t * Database__Sophia__Ctl;
typedef sophia_db_t * Database__Sophia__DB;
typedef sophia_txn_t * Database__Sophia__Txn;
typedef sophia_snapshot_t * Database__Sophia__Snapshot;
typedef sophia_cursor_t * Database__Sophia__Cursor;
/*static inline int sp_cmp(char *a_key, size_t asz, char *b_key, size_t bsz, void *arg)
{
dSP;
ENTER;
SAVETMPS;
sophia_t *ent = (sophia_t *)arg;
PUSHMARK(sp);
XPUSHs( sv_2mortal( newSVpv(a_key, asz) ) );
XPUSHs( sv_2mortal( newSVpv(b_key, bsz) ) );
if(ent->arg)
{
XPUSHs(ent->arg);
}
PUTBACK;
long res = 0;
int count = call_sv((SV *)ent->cmp, G_SCALAR);
SPAGAIN;
if (count > 0)
res = POPi;
PUTBACK;
FREETMPS;
LEAVE;
return (int)res;
}*/
MODULE = Database::Sophia PACKAGE = Database::Sophia
PROTOTYPES: DISABLE
Database::Sophia
env()
CODE:
sophia_env_t *env = malloc(sizeof(sophia_env_t));
env->ptr = sp_env();
env->cmp = NULL;
env->arg = NULL;
RETVAL = env;
OUTPUT:
RETVAL
SV*
open(env)
Database::Sophia env;
CODE:
RETVAL = newSViv(sp_open(env->ptr));
OUTPUT:
RETVAL
Database::Sophia::Ctl
ctl(env)
Database::Sophia env;
CODE:
sophia_ctl_t *ctl = malloc(sizeof(sophia_ctl_t));
ctl->ptr = sp_ctl(env->ptr);
RETVAL = ctl;
OUTPUT:
RETVAL
Database::Sophia::Txn
begin(env)
Database::Sophia env;
CODE:
sophia_txn_t *txn = malloc(sizeof(sophia_txn_t));
txn->ptr = sp_begin(env->ptr);
RETVAL = txn;
OUTPUT:
RETVAL
MODULE = Database::Sophia PACKAGE = Database::Sophia::Ctl
PROTOTYPES: DISABLE
SV*
set(ctl, key, value)
Database::Sophia::Ctl ctl;
SV *key;
SV *value;
CODE:
STRLEN len_k = 0, len_v = 0;
char *key_c = SvPV( key, len_k );
char *value_c = SvPV( value, len_v );
RETVAL = newSViv( sp_set(ctl->ptr, (void *)key_c, (void *)value_c ) );
OUTPUT:
RETVAL
SV*
get(ctl, key)
Database::Sophia::Ctl ctl;
SV *key;
CODE:
STRLEN len_k = 0;
char *key_c = SvPV( key, len_k );
void *obj = sp_get(ctl->ptr, (void*)key_c);
if (!obj)
{
RETVAL = &PL_sv_undef;
}
else
{
char *t = sp_type(obj);
if (!t)
{
croak("Object of empty type returned from ctl sp_get");
}
elseif (!strcmp(t, "database"))
{
sophia_db_t *db = malloc(sizeof(sophia_db_t));
db->ptr = obj;
sv_setref_pv(RETVAL, "Database::Sophia::DB", (void *)db);
}
else if (!strcmp(t, "snapshot"))
{
sophia_snapshot_t *snapshot = malloc(sizeof(sophia_snapshot_t));
snapshot->ptr = obj;
sv_setref_pv(RETVAL, "Database::Sophia::Snapshot", (void *)snapshot);
}
else if (!strcmp(t, "object"))
{
uint32_t l;
char *r = (char*)sp_get(obj, "value", &l);
RETVAL = newSVpv(r, l);
sp_destroy(obj);
}
else
{
croak("Unknown object type returned from ctl sp_get: %s", t);
}
}
OUTPUT:
RETVAL
Database::Sophia::Cursor
cursor(ctl)
Database::Sophia::Ctl ctl;
CODE:
sophia_cursor_t *cur = malloc(sizeof(sophia_cursor_t));
cur->ptr = sp_cursor(ctl->ptr);
RETVAL = cur;
OUTPUT:
RETVAL
MODULE = Database::Sophia PACKAGE = Database::Sophia::DB
SV*
open(db)
Database::Sophia::DB db;
CODE:
RETVAL = newSViv(sp_open(db->ptr));
OUTPUT:
RETVAL
SV*
get(db, key)
Database::Sophia::DB db;
SV *key;
CODE:
int err;
STRLEN len_k = 0;
char *key_c = SvPV(key, len_k);
void *value;
size_t size;
RETVAL = &PL_sv_undef;
void *obj = sp_object(db->ptr);
void *ret;
if (obj)
{
sp_set(obj, "key", key_c, len_k);
ret = sp_get(db->ptr, obj);
if (!err)
{
value = sp_get(ret, "value", &size);
RETVAL = newSVpv(value, size);
sp_destroy(ret);
}
sp_destroy(obj);
}
OUTPUT:
RETVAL
SV*
delete(db, key)
Database::Sophia::DB db;
SV *key;
CODE:
int err;
STRLEN len_k = 0;
char *key_c = SvPV(key, len_k);
RETVAL = &PL_sv_undef;
void *obj = sp_object(db->ptr);
void *ret;
if (obj)
{
sp_set(obj, "key", key_c, len_k);
err = sp_delete(db->ptr, obj);
sp_destroy(obj);
}
RETVAL = newSViv(err);
OUTPUT:
RETVAL
SV*
set(db, key, value)
Database::Sophia::DB db;
SV *key;
SV *value;
CODE:
int err;
STRLEN len_k = 0;
char *key_c = SvPV(key, len_k);
STRLEN len_v = 0;
char *value_c = SvPV(value, len_v);
RETVAL = &PL_sv_undef;
void *obj = sp_object(db->ptr);
void *ret;
if (obj)
{
sp_set(obj, "key", key_c, len_k);
sp_set(obj, "value", value_c, len_v);
err = sp_set(db->ptr, obj);
sp_destroy(obj);
}
RETVAL = newSViv(err);
OUTPUT:
RETVAL
Database::Sophia::Cursor
cursor(db, key, order)
Database::Sophia::DB db;
SV *key;
SV *order;
CODE:
void *c;
STRLEN len_k = 0;
char *key_c = SvPV(key, len_k);
STRLEN len_o = 0;
char *order_c = SvPV(order, len_v);
void *obj = sp_object(db->ptr);
RETVAL = &PL_sv_undef;
if (obj)
{
sp_set(obj, "key", key_c, len_k);
sp_set(obj, "order", order_c, len_o);
c = sp_cursor(db->ptr, obj);
sp_destroy(obj);
if (c)
{
sophia_cursor_t *cur = malloc(sizeof(sophia_cursor_t));
cur->ptr = c;
RETVAL = cur;
}
}
OUTPUT:
RETVAL
MODULE = Database::Sophia PACKAGE = Database::Sophia::Txn
PROTOTYPES: DISABLE
SV*
commit(txn)
Database::Sophia::Txn txn;
CODE:
RETVAL = newSViv( sp_commit(txn->ptr) );
OUTPUT:
RETVAL
SV*
get(txn, key)
Database::Sophia::Txn txn;
SV *key;
SV*
delete(txn, key)
Database::Sophia::Txn txn;
SV *key;
SV*
set(txn, key, value)
Database::Sophia::Txn txn;
SV *key;
SV *value;
MODULE = Database::Sophia PACKAGE = Database::Sophia::Snapshot
PROTOTYPES: DISABLE
SV*
drop(snapshot)
Database::Sophia::Snapshot snapshot;
CODE:
RETVAL = newSViv( sp_drop(snapshot->ptr) );
// FIXME destroy
OUTPUT:
RETVAL
SV*
get(txn, key)
Database::Sophia::Snapshot snapshot;
SV *key;
Database::Sophia::Cursor
cursor(db, key, order)
Database::Sophia::Snapshot snapshot;
SV *key;
SV *order;
MODULE = Database::Sophia PACKAGE = Database::Sophia::Cursor
PROTOTYPES: DISABLE
SV*
get(cursor, key)
Database::Sophia::Cursor cursor;
SV *key;
SV*
cur_key(cursor)
Database::Sophia::Cursor cursor;
CODE:
void *obj = sp_object(cursor->ptr);
uint32_t size;
char *value;
if (obj)
{
value = sp_get(obj, "key", &size);
RETVAL = newSVpv(value, size);
}
else
{
RETVAL = &PL_sv_undef;
}
OUTPUT:
RETVAL
SV*
cur_value(cursor)
Database::Sophia::Cursor cursor;
CODE:
void *obj = sp_object(cursor->ptr);
uint32_t size;
char *value;
if (obj)
{
value = sp_get(obj, "value", &size);
RETVAL = newSVpv(value, size);
}
else
{
RETVAL = &PL_sv_undef;
}
OUTPUT:
RETVAL
void
DESTROY(ptr)
Database::Sophia ptr;
CODE:
if(ptr->ptr)
sp_destroy(ptr);
if(ptr)
free(ptr);

13
typemap Executable file
View File

@ -0,0 +1,13 @@
TYPEMAP
sophia_env_t * T_PTROBJ
Database::Sophia T_PTROBJ
sophia_ctl_t * T_PTROBJ
Database::Sophia::Ctl T_PTROBJ
sophia_txn_t * T_PTROBJ
Database::Sophia::Txn T_PTROBJ
sophia_db_t * T_PTROBJ
Database::Sophia::DB T_PTROBJ
sophia_snapshot_t * T_PTROBJ
Database::Sophia::Snapshot T_PTROBJ
sophia_cursor_t * T_PTROBJ
Database::Sophia::Cursor T_PTROBJ