[libcatmandu-perl] 45/101: store and bag drop
Jonas Smedegaard
dr at jones.dk
Tue Feb 23 13:43:52 UTC 2016
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.steenlant at 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
More information about the Pkg-perl-cvs-commits
mailing list