The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package App::Services::ObjStore::Service;
{
  $App::Services::ObjStore::Service::VERSION = '0.002';
}

use Moose;

use common::sense;

with 'App::Services::Logger::Role';

use KiokuDB;

has kdb => ( is => 'rw' );

has kdb_dsn => (
	is      => 'rw',
	default => sub { "dbi:SQLite:dbname=" . $_[0]->obj_store_file },
	lazy    => 1,
);

has obj_store_file => (
	is       => 'rw',
	required => 1,
);

has label => (
	is      => 'rw',
	default => sub { $$ },
);

sub init_object_store {
	my $s = shift or die;

	$s->kdb( KiokuDB->connect( $s->kdb_dsn, create => 1 ) );

	$s->kdb or $s->log->logconfess();

}

sub delete {
	my $s = shift or die;

	$s->kdb->delete(@_);

}

sub delete_object_store {
	my $s = shift or die;

	unlink $s->obj_store_file if -f $s->obj_store_file;

	$s->log->warn("Couldn' t delete object store ") if -d $s->obj_store_file;

	$s->kdb(undef);

	return $s->kdb;

}

sub add_object {

	my $s   = shift or die;
	my $obj = shift or $s->log->fatal( $s->label . " : No object passed " );
	my $id  = shift;

	my $kdb = $s->kdb;
	my $log = $s->log;

	$log->debug( $s->label . " Entering add_object " );

	unless ($kdb) {
		$s->log->logconfess(
			$s->label . " : Must call 'init_object_store' first " );
	}

	my $new_id;

	my $rc;

	do {
		$log->debug( $s->label . " : Inserting obj " );

		eval {
			($new_id) = $kdb->txn_do(
				scope => 1,
				body  => sub {
					if ($id) {
						$kdb->insert( $id => $obj );

					}
					else {
						$kdb->insert($obj);

					}
				}
			);
		};

		if ($@) {
			$s->log->warn(
				    $s->label
				  . " : failed to commit to("
				  . $s->kdb
				  . ") : [$@],
		  sleeping
		  for random interval
		  and retrying "
			);
			my $i = rand(0.1);
			sleep $i;

		}
		else {
			$log->debug( $s->label . " : successfully comitted " );
			$rc = 1;
		}

	} until ($rc);

	return $new_id;

}

sub get_object {
	my $s  = shift or die;
	my $id = shift or $s->log->fatal( $s->label . " : No object id passed " );

	my $kdb = $s->kdb;

	unless ($kdb) {
		$s->log->logconfess(
			$s->label . " : Must call 'init_object_store' first " );
	}

	my $obj;

	$kdb->txn_do(
		scope => 1,
		body  => sub {
			$obj = $kdb->lookup($id);
		}
	);

	return $obj;
}

sub all_objects {
	my $s = shift or die;

	my $kdb = $s->kdb;

	unless ($kdb) {
		$s->log->logconfess(
			$s->label . " : Must call 'init_object_store' first " );
	}

	return $kdb->all_objects->items;

}

no Moose;

1;

__END__

=pod

=head1 NAME

App::Services::ObjStore::Service

=head1 VERSION

version 0.002

=head1 AUTHOR

Sean Blanton <sean@blanton.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Sean Blanton.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut