This is an automated email from the git hooks/post-receive script.

js pushed a commit to branch master
in repository libcatmandu-perl.

commit 538428acd1147f6f8d5630d6133d9ecd02f051a0
Author: Nicolas Steenlant <nicolas.steenl...@ugent.be>
Date:   Wed Jan 6 15:21:36 2016 +0100

    store and bag drop
---
 lib/Catmandu/Addable.pm         |  5 +++--
 lib/Catmandu/Bag.pm             | 26 ++++++++++++++++++--------
 lib/Catmandu/Store.pm           | 23 ++++++++++++++++++++---
 lib/Catmandu/Store/Hash.pm      |  9 +++++++--
 lib/Catmandu/Store/Hash/Bag.pm  |  5 ++---
 lib/Catmandu/Store/Multi.pm     |  7 +++++++
 lib/Catmandu/Store/Multi/Bag.pm |  4 +++-
 t/Catmandu-Store-Multi.t        |  4 ++++
 t/Catmandu-Store.t              |  8 +++++++-
 9 files changed, 71 insertions(+), 20 deletions(-)

diff --git a/lib/Catmandu/Addable.pm b/lib/Catmandu/Addable.pm
index 0fd3436..104b892 100644
--- a/lib/Catmandu/Addable.pm
+++ b/lib/Catmandu/Addable.pm
@@ -136,8 +136,9 @@ This method is usually called at the end of many add or 
add_many operations.
 
 =head1 INHERIT
 
-If you provide an 'add' method, then automatically your package gets a 
add_many method, plus
-a fix attribute which transforms all Perl hashes provided to the add method.
+If you provide an 'add' method, then automatically your package gets a add_many
+method, plus a fix attribute which transforms all Perl hashes provided to the
+add method.
 
 =head1 SEE ALSO
 
diff --git a/lib/Catmandu/Bag.pm b/lib/Catmandu/Bag.pm
index 344a377..cad06b8 100644
--- a/lib/Catmandu/Bag.pm
+++ b/lib/Catmandu/Bag.pm
@@ -10,7 +10,7 @@ use Moo::Role;
 use namespace::clean;
 
 with 'Catmandu::Logger';
-with 'Catmandu::Pluggable'; # TODO
+with 'Catmandu::Pluggable';
 with 'Catmandu::Iterable';
 with 'Catmandu::Addable';
 
@@ -19,8 +19,8 @@ requires 'delete';
 requires 'delete_all';
 requires 'drop';
 
-has store => (is => 'ro'); # TODO
-has name  => (is => 'ro'); # TODO
+has store => (is => 'ro');
+has name  => (is => 'ro');
 has id_generator => (
     is => 'lazy',
     coerce => sub {
@@ -50,6 +50,12 @@ before delete => sub {
     check_value($_[1]);
 };
 
+around delete_all => sub {
+    my ($orig, $self) = @_;
+    $orig->($self);
+    return;
+};
+
 sub generate_id {
     $_[0]->id_generator->generate;
 }
@@ -148,18 +154,18 @@ Create a new Bag.
 
 =head2 add($hash)
 
-Add one hash to the store or updates an existing hash by using its '_id' key. 
Returns
+Add a hash to the bag or updates an existing hash by using its '_id' key. 
Returns
 the stored hash on success or undef on failure.
 
 =head2 add_many($array)
 
 =head2 add_many($iterator)
 
-Add or update one or more items to the store.
+Add or update one or more items to the bag.
 
 =head2 get($id)
 
-Retrieves the item with identifier $id from the store.
+Retrieves the item with identifier $id from the bag.
 
 =head2 get_or_add($id, $hash)
 
@@ -168,16 +174,20 @@ C<$id> if it's not found.
 
 =head2 delete($id)
 
-Deletes the item with identifier $id from the store.
+Deletes the item with C<$id> from the bag.
 
 =head2 delete_all
 
-Deletes all items from the store.
+Clear the bag.
 
 =head2 commit
 
 Commit changes.
 
+=head2 drop
+
+Delete the bag.
+
 =head2 log
 
 Return the current logger.
diff --git a/lib/Catmandu/Store.pm b/lib/Catmandu/Store.pm
index 565a1b0..f21adf9 100644
--- a/lib/Catmandu/Store.pm
+++ b/lib/Catmandu/Store.pm
@@ -9,6 +9,8 @@ use Sub::Quote qw(quote_sub);
 use Moo::Role;
 use namespace::clean;
 
+requires 'drop';
+
 with 'Catmandu::Logger';
 
 has bag_class => (
@@ -52,12 +54,13 @@ has bags => (
     my $pkg = __PACKAGE__;
     my @delegate = (
         # Catmandu::Iterable methods
-        qw(to_array count slice each tap any many all map reduce first rest 
take
-           pluck invoke contains includes group interleave max min benchmark),
+        qw(to_array count slice each tap any many all map reduce first rest
+            take pluck invoke contains includes group interleave max min
+            benchmark),
         # Catmandu::Addable methods
         qw(add add_many commit),
         # Catmandu::Bag methods
-        qw(get delete delete_all get_or_add to_hash drop),
+        qw(get delete delete_all get_or_add to_hash),
     );
 
     for my $sub (@delegate) {
@@ -66,6 +69,12 @@ has bags => (
     }
 }
 
+sub drop_bags {
+    my ($self) = @_;
+    $_->drop for values %{$self->bags};
+    return;
+}
+
 1;
 
 __END__
@@ -129,6 +138,14 @@ provided for each $bagname using the 'bags' parameter. E.g.
 
 Create or retieve a bag with name $name. Returns a L<Catmandu::Bag>.
 
+=head2 drop
+
+Delete the store and all it's bags.
+
+=head2 drop_bags
+
+Delete all bags, but not the store.
+
 =head2 log
 
 Return the current logger. Can be used when creating your own Stores.
diff --git a/lib/Catmandu/Store/Hash.pm b/lib/Catmandu/Store/Hash.pm
index 440e0fe..378f566 100644
--- a/lib/Catmandu/Store/Hash.pm
+++ b/lib/Catmandu/Store/Hash.pm
@@ -4,9 +4,9 @@ use Catmandu::Sane;
 
 our $VERSION = '0.9505';
 
+use Moo;
 use Catmandu::Util qw(:is);
 use Catmandu::Store::Hash::Bag;
-use Moo;
 use namespace::clean;
 
 with 'Catmandu::Store';
@@ -21,6 +21,10 @@ sub BUILD {
     }
 }
 
+sub drop {
+    $_[0]->drop_bags;
+}
+
 1;
 
 __END__
@@ -63,7 +67,8 @@ for fast retrieval combined with a doubly linked list for 
fast traversal.
 
 =head2 new([init_data => [...] ])
 
-Create a new Catmandu::Store::Hash. Optionally provide as init_data an array 
ref of data:
+Create a new Catmandu::Store::Hash. Optionally provide as init_data an array
+ref of data:
 
     my $store = Catmandu->store('Hash', init_data => [ 
            { _id => 1, data => foo } ,
diff --git a/lib/Catmandu/Store/Hash/Bag.pm b/lib/Catmandu/Store/Hash/Bag.pm
index 725b598..f096224 100644
--- a/lib/Catmandu/Store/Hash/Bag.pm
+++ b/lib/Catmandu/Store/Hash/Bag.pm
@@ -4,8 +4,8 @@ use Catmandu::Sane;
 
 our $VERSION = '0.9505';
 
-use Catmandu::Hits;
 use Moo;
+use Catmandu::Hits;
 use Clone qw(clone);
 use namespace::clean;
 
@@ -81,8 +81,7 @@ sub delete_all {
 }
 
 sub drop {
-    my $self = $_[0];
-    $self->delete_all;
+    $_[0]->delete_all;
 }
 
 1;
diff --git a/lib/Catmandu/Store/Multi.pm b/lib/Catmandu/Store/Multi.pm
index 0000710..fa2c478 100644
--- a/lib/Catmandu/Store/Multi.pm
+++ b/lib/Catmandu/Store/Multi.pm
@@ -26,6 +26,13 @@ has stores => (
     },
 );
 
+sub drop {
+    my ($self) = @_;
+    for my $store (@{$self->store->stores}) {
+        $store->drop;
+    }
+}
+
 1;
 
 __END__
diff --git a/lib/Catmandu/Store/Multi/Bag.pm b/lib/Catmandu/Store/Multi/Bag.pm
index 37d83b1..5030c98 100644
--- a/lib/Catmandu/Store/Multi/Bag.pm
+++ b/lib/Catmandu/Store/Multi/Bag.pm
@@ -43,7 +43,9 @@ sub delete_all {
 
 sub drop {
     my ($self) = @_;
-    $self->delete_all;
+    for my $store (@{$self->store->stores}) {
+        $store->bag($self->name)->drop;
+    }
 }
 
 sub commit {
diff --git a/t/Catmandu-Store-Multi.t b/t/Catmandu-Store-Multi.t
index 4025bac..1647d6a 100644
--- a/t/Catmandu-Store-Multi.t
+++ b/t/Catmandu-Store-Multi.t
@@ -44,5 +44,9 @@ is $bag->count, 0;
 is $stores->[0]->bag->count, 0;
 is $stores->[1]->bag->count, 0;
 
+$bag->add_many($data);
+$bag->drop;
+is $bag->count, 0;
+
 done_testing;
 
diff --git a/t/Catmandu-Store.t b/t/Catmandu-Store.t
index 458ed3e..828bfa6 100644
--- a/t/Catmandu-Store.t
+++ b/t/Catmandu-Store.t
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 use Test::More;
 use Test::Exception;
+use Role::Tiny;
 
 my $pkg;
 BEGIN {
@@ -13,9 +14,12 @@ BEGIN {
 require_ok $pkg;
 
 {
+    package T::StoreWithoutDrop;
+    use Moo;
     package T::Store;
     use Moo;
     with $pkg;
+    sub drop {}
     package T::Store::Bag;
     use Moo;
     package T::CustomBagClass;
@@ -25,6 +29,8 @@ require_ok $pkg;
     has prop  => (is => 'ro');
 }
 
+throws_ok { Role::Tiny->apply_role_to_package('T::StoreWithoutDrop', $pkg) } 
qr/missing drop/;
+
 my $s = T::Store->new;
 can_ok $s, 'bag_class';
 can_ok $s, 'default_bag';
@@ -51,5 +57,5 @@ isnt $s->bag('foo')->prop, 'another val';
 is $s->bag('bar')->prop, 'val';
 isnt $s->bag('bar')->name, 'baz';
 
-done_testing 17;
+done_testing;
 

-- 
Alioth's /usr/local/bin/git-commit-notice on 
/srv/git.debian.org/git/pkg-perl/packages/libcatmandu-perl.git

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to