File Coverage

blib/lib/Geo/SpatialDB/Storage/LMDB_Storable.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Geo::SpatialDB::Storage::LMDB_Storable;
$Geo::SpatialDB::Storage::LMDB_Storable::VERSION = '0.000_001'; # TRIAL

$Geo::SpatialDB::Storage::LMDB_Storable::VERSION = '0.000001';use Moo 2;
use LMDB_File ':flags', ':cursor_op', ':error';
use Storable 'freeze', 'thaw';
sub _croak { require Carp; goto &Carp::croak }
use namespace::clean;

extends 'Geo::SpatialDB::Storage';

# ABSTRACT: Key/value storage on LMDB, encoding Perl objects with 'Storable'


has path      => ( is => 'ro', required => 1 );
has readonly  => ( is => 'ro', default => sub { 0 } );
has mapsize   => ( is => 'ro', default => sub { 0xC00000000 } );
has run_with_scissors => ( is => 'ro', default => sub { 0 } );

sub BUILD {
	my $self= shift;
	# Immediately try to access the DB so that errors get reported
	# as soon as user creates the object
	$self->get(0);
}

sub DESTROY {
	my $self= shift;
	warn "Destroying LMDB_Storable instance with uncommitted data!"
		if $self->_txn && $self->_written;
}

has _env => ( is => 'lazy' );
sub _build__env {
	my $self= shift;
	my $path= $self->path;
	LMDB::Env->new("$path", {
		mapsize => $self->mapsize,
		flags   =>
			(-d $path? 0 : MDB_NOSUBDIR)
			| ($self->readonly? MDB_RDONLY : 0)
			| ($self->run_with_scissors? MDB_WRITEMAP|MDB_NOMETASYNC : 0)
		}
	);
}

has _txn => ( is => 'lazy', clearer => 1 );
has _written => ( is => 'rw' );
sub _build__txn {
	shift->_env->BeginTxn;
}

has _db => ( is => 'lazy', clearer => 1 );
sub _build__db {
	shift->_txn->OpenDB();
}

my $storable_magic= substr(freeze({}), 0, 1);
sub die_invalid_assumption {
	die "Author has made invalid assumptions for your version of Storable and needs to fix his code";
}
$storable_magic =~ /[\0-\x19]/ or die_invalid_assumption();


sub get {
	my $v= shift->_db->get(shift);
	$v= thaw($v) if defined $v and substr($v, 0, 1) eq $storable_magic;
	return $v;
}


sub put {
	my ($self, $k, $v)= @_;
	$self->{_written}= 1;
	if (!defined $v) {
		local $LMDB_File::die_on_err= 0;
		my ($ret, $err);
		{
			local $@;
			$ret= $self->_db->del($k);
			$err= $@;
		}
		croak $err if $ret && $ret != MDB_NOTFOUND;
		return;
	}
	elsif (ref $v) {
		$v= freeze($v);
		substr($v, 0, 1) eq $storable_magic
			or die_invalid_assumption();
	} else {
		ord(substr($v, 0, 1)) > 0x1F or _croak("scalars must not start with control characters");
	}
	$self->_db->put($k, $v);
}


sub commit {
	my $self= shift;
	if ($self->_txn) {
		$self->_txn->commit;
		$self->_clear_db;
		$self->_clear_txn;
	}
	$self->{_written}= 0;
}

sub rollback {
	my $self= shift;
	if ($self->_txn) {
		$self->_txn->abort;
		$self->_clear_db;
		$self->_clear_txn;
	}
	$self->{_written}= 0;
}


sub iterator {
	my ($self, $key)= @_;
	my $op= defined $key? MDB_SET_RANGE : MDB_FIRST;
	my $cursor= $self->_db->Cursor;
	my $data;
	return sub {
		local $LMDB_File::die_on_err= 0;
		my $ret= $cursor->get($key, $data, $op);
		$op= MDB_NEXT;
		if ($ret) {
			return if $ret == MDB_NOTFOUND;
			die $LMDB_File::last_err
		}
		return $key unless wantarray;
		$data= thaw($data) if substr($data, 0, 1) eq $storable_magic;
		return ($key, $data);
	}
}

1;

__END__