make updates "just work"; add a delete method

lib/MooseX/Storage/Directory.pm

@@ -47,9 +47,14 @@ sub BUILD {
     MooseX::Storage::IO::File->meta->apply($meta);
 }
 
+sub _record_path {
+    my ($self, $id) = @_;
+    return $self->directory->file("$id.json")->stringify;
+}
+
 sub lookup {
-    my ($self, $query) = @_;
-    return $self->class->name->load($self->directory->file("$query.json")->stringify);
+    my ($self, $id) = @_;
+    return $self->class->name->load($self->_record_path($id));
 }
 
 sub search {
@@ -69,6 +74,12 @@ sub store {
     return $object->get_id;
 }
 
+sub delete {
+    my ($self, $object) = @_;
+    $self->index->delete_object($object);
+    unlink $self->_record_path($object->get_id);
+}
+
 1;
 
 __END__

lib/MooseX/Storage/Directory/Index.pm

@@ -14,7 +14,7 @@ has 'directory' => (
     coerce   => 1,
 );
 
-has 'database' => (
+has 'forward_index' => (
     is      => 'ro',
     isa     => 'BerkeleyDB::Btree',
     lazy    => 1,
@@ -23,6 +23,23 @@ has 'database' => (
         my $db = $self->directory->file('.index');
         return BerkeleyDB::Btree->new(
             -Filename => $db->stringify,
+            -Subname  => 'forward_index',
+            -Property => DB_DUP,
+            -Flags    => DB_CREATE,
+        );
+    },
+);
+
+has 'reverse_index' => (
+    is      => 'ro',
+    isa     => 'BerkeleyDB::Btree',
+    lazy    => 1,
+    default => sub {
+        my $self = shift;
+        my $db = $self->directory->file('.index');
+        return BerkeleyDB::Btree->new(
+            -Filename => $db->stringify,
+            -Subname  => 'reverse_index',
             -Property => DB_DUP,
             -Flags    => DB_CREATE,
         );
@@ -31,8 +48,12 @@ has 'database' => (
 
 sub add_object {
     my ($self, $object) = @_;
+    $self->delete_object($object);
     my @flat = $self->_flatten($object);
-    $self->_add($_ => $object->get_id) foreach @flat;
+    $self->_add_forward($_ => $object->get_id) foreach @flat;
+    $self->_add_reverse($object->get_id, @flat);
+    $self->forward_index->db_sync;
+    $self->reverse_index->db_sync;
 }
 
 sub query_with_prototype {
@@ -48,22 +69,42 @@ sub query_with_prototype {
     return grep { $results{$_} == @flat } keys %results;
 }
 
+sub delete_object {
+    my ($self, $object) = @_;
+    my $id = $object->get_id;
+    my @keys = _get_all_dups($self->reverse_index, $id);
+    foreach my $key (@keys){
+        my $cursor = $self->forward_index->db_cursor or die $BerkeleyDB::Error;
+        my $current_id;
+        $cursor->c_get($key, $current_id, DB_SET) and die $BerkeleyDB::Error;
+        $cursor->c_del if $current_id eq $id;
+        while($cursor->c_get($key, $current_id, DB_NEXT_DUP) == 0){
+            $cursor->c_del if $current_id eq $id;
+        }
+    }
+    $self->reverse_index->db_del($id);
+}
+
 # helpers
 
-sub _add {
+sub _add_forward {
     my ($self, $key, $id) = @_;
-    $self->database->db_put($key => $id)
-      and die "Failed to insert '$key => $id' into database";
+    $self->forward_index->db_put($key => $id)
+      and die "Failed to insert '$key => $id' into forward_index";
     return;
 }
 
-sub _query {
-    my ($self, $key) = @_;
+sub _add_reverse {
+    my ($self, $id, @keys) = @_;
+    $self->reverse_index->db_put($id, $_) for @keys;
+}
 
-    my $cursor = $self->database->db_cursor
-      or die "Failed to get cursor: $BerkeleyDB::Error";
+sub _get_all_dups {
+    my ($db, $key) = @_;
 
-    # get the first matching object
+    my $cursor = $db->db_cursor
+      or die "Failed to get cursor: $BerkeleyDB::Error";
+
     my (@result, $result);
     $cursor->c_get($key, $result, DB_SET) and return; # true means failure
     push @result, $result;
@@ -72,7 +113,12 @@ sub _query {
     while($cursor->c_get($key, $result, DB_NEXT_DUP) == 0){
         push @result, $result;
     }
-    return @result;
+    return @result;    
+}
+
+sub _query {
+    my ($self, $key) = @_;
+    return _get_all_dups($self->forward_index, $key);
 }
 
 sub _flatten {

t/updates.t

@@ -0,0 +1,46 @@
+use strict;
+use warnings;
+use Test::More tests => 7;
+
+use Directory::Scratch;
+use MooseX::Storage::Directory;
+
+{
+    package Test;
+    use Moose;
+    use MooseX::Storage;
+    with 'MooseX::Storage::Directory::Id';
+
+    has 'id'  => ( is => 'ro', isa => 'Int', required => 1 );
+    has 'foo' => ( is => 'ro', isa => 'Str', required => 1 );
+
+    sub get_id { return shift->id }
+}
+
+my $tmp = Directory::Scratch->new;
+
+my $dir = MooseX::Storage::Directory->new(
+    directory => qq{$tmp},
+    class     => Test->meta,
+);
+
+ok $dir, 'created directory';
+
+
+my $foo = Test->new( id => 1, foo => 'Hello' );
+$dir->store($foo);
+
+is [$dir->search({ foo => 'Hello' })]->[0]->id, 1; 
+
+$foo = Test->new( id => 1, foo => 'Not hello' );
+$dir->store($foo);
+
+ok !eval { [$dir->search({ foo => 'Hello' })]->[0]->id }, 'didnt get old object';
+is [$dir->search({ foo => 'Not hello' })]->[0]->id, 1, 'did get new object';
+
+ok $tmp->exists('1.json');
+$dir->delete($foo);
+ok !$tmp->exists('1.json');
+
+my @id = $dir->index->query_with_prototype({ foo => 'Not hello'});
+is scalar @id, 0, 'no matching records';