[libcatmandu-perl] 41/101: Bag.pm requires drop method, see GH #11
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 8a5809a17f8c4eb41a48ae2ce8fa5ae0a310b960
Author: Vitali Peil <vitali.peil at uni-bielefeld.de>
Date: Tue Jan 5 14:49:04 2016 +0100
Bag.pm requires drop method, see GH #11
---
lib/Catmandu/Bag.pm | 7 ++++---
lib/Catmandu/Store.pm | 10 +++++-----
lib/Catmandu/Store/Hash/Bag.pm | 5 +++++
lib/Catmandu/Store/Multi/Bag.pm | 5 +++++
t/Catmandu-Bag.t | 22 +++++++++++++++++++++-
5 files changed, 40 insertions(+), 9 deletions(-)
diff --git a/lib/Catmandu/Bag.pm b/lib/Catmandu/Bag.pm
index c1c6837..344a377 100644
--- a/lib/Catmandu/Bag.pm
+++ b/lib/Catmandu/Bag.pm
@@ -17,6 +17,7 @@ with 'Catmandu::Addable';
requires 'get';
requires 'delete';
requires 'delete_all';
+requires 'drop';
has store => (is => 'ro'); # TODO
has name => (is => 'ro'); # TODO
@@ -88,12 +89,12 @@ Catmandu::Bag - A Catmandu::Store compartment to persist data
my $store = Catmandu::Store::DBI->new(
data_source => 'DBI:mysql:database=test',
- bags => { journals => {
+ bags => { journals => {
fixes => [ ... ] ,
autocommit => 1 ,
plugins => [ ... ] ,
id_generator => Catmandu::IdGenerator::UUID->new ,
- }
+ }
},
bag_class => Catmandu::Bag->with_plugins('Datestamps')
);
@@ -132,7 +133,7 @@ An array of Catmandu::Pluggable to apply to the bag items.
=head2 autocommit
-When set to a true value an commit automatically gets executed when the bag
+When set to a true value an commit automatically gets executed when the bag
goes out of scope.
=head2 id_generator
diff --git a/lib/Catmandu/Store.pm b/lib/Catmandu/Store.pm
index 346ddc4..565a1b0 100644
--- a/lib/Catmandu/Store.pm
+++ b/lib/Catmandu/Store.pm
@@ -57,7 +57,7 @@ has bags => (
# Catmandu::Addable methods
qw(add add_many commit),
# Catmandu::Bag methods
- qw(get delete delete_all get_or_add to_hash),
+ qw(get delete delete_all get_or_add to_hash drop),
);
for my $sub (@delegate) {
@@ -110,19 +110,19 @@ Some stores can be searched using L<Catmandu::Searchable> methods.
=head2 new(%store_args, bag_class => $class, default_bag => $name, bags => { $bagname => \%bag_args })
Create a new Catmandu::Store. Optionally provide the class name of a sub-class of
-L<Catmandu::Bag>, and the name of the default bag ('data'). Startup parameters can be
+L<Catmandu::Bag>, and the name of the default bag ('data'). Startup parameters can be
provided for each $bagname using the 'bags' parameter. E.g.
my $store = Catmandu::Store::Hash->new(
bags => {myBag => {plugins => ['Datestamps']}});
# $store->bag('myBag') will now contain Datestamps
-
+
my $bag_class = "Catmandu::Store::Hash::Bag"
my $store = Catmandu::Store::Hash->new(
bag_class => $bag_class->with_plugins('Datestamps')
);
-
+
# All $store->bag(...)'s will now contain Datestamps
=head2 bag($name)
@@ -134,7 +134,7 @@ Create or retieve a bag with name $name. Returns a L<Catmandu::Bag>.
Return the current logger. Can be used when creating your own Stores.
E.g.
-
+
package Catmandu::Store::Hash;
...
diff --git a/lib/Catmandu/Store/Hash/Bag.pm b/lib/Catmandu/Store/Hash/Bag.pm
index 892918d..725b598 100644
--- a/lib/Catmandu/Store/Hash/Bag.pm
+++ b/lib/Catmandu/Store/Hash/Bag.pm
@@ -80,6 +80,11 @@ sub delete_all {
$self->_hash($self->store->_hashes->{$self->name} = {});
}
+sub drop {
+ my $self = $_[0];
+ $self->delete_all;
+}
+
1;
__END__
diff --git a/lib/Catmandu/Store/Multi/Bag.pm b/lib/Catmandu/Store/Multi/Bag.pm
index c8470d5..37d83b1 100644
--- a/lib/Catmandu/Store/Multi/Bag.pm
+++ b/lib/Catmandu/Store/Multi/Bag.pm
@@ -41,6 +41,11 @@ sub delete_all {
}
}
+sub drop {
+ my ($self) = @_;
+ $self->delete_all;
+}
+
sub commit {
my ($self) = @_;
for my $store (@{$self->store->stores}) {
diff --git a/t/Catmandu-Bag.t b/t/Catmandu-Bag.t
index 37c35a2..86f7517 100644
--- a/t/Catmandu-Bag.t
+++ b/t/Catmandu-Bag.t
@@ -21,18 +21,28 @@ require_ok $pkg;
sub add {}
sub delete {}
sub delete_all {}
+ sub drop {}
package T::BagWithoutDelete;
use Moo;
sub generator {}
sub add {}
sub get {}
sub delete_all {}
+ sub drop {}
package T::BagWithoutDeleteAll;
use Moo;
sub generator {}
sub add {}
sub get {}
sub delete {}
+ sub drop {}
+ package T::BagWithoutDrop;
+ use Moo;
+ sub generator {}
+ sub add {}
+ sub get {}
+ sub delete {}
+ sub delete_all {}
package T::Bag; #mock array based bag
use Moo;
@@ -91,6 +101,12 @@ require_ok $pkg;
splice @$bag;
}
+ sub drop {
+ my ($self) = @_;
+ my $bag = $self->bag;
+ splice @$bag;
+ }
+
package T::BagData;
use Moo;
}
@@ -98,6 +114,7 @@ require_ok $pkg;
throws_ok { Role::Tiny->apply_role_to_package('T::BagWithoutGet', $pkg) } qr/missing get/;
throws_ok { Role::Tiny->apply_role_to_package('T::BagWithoutDelete', $pkg) } qr/missing delete/;
throws_ok { Role::Tiny->apply_role_to_package('T::BagWithoutDeleteAll', $pkg) } qr/missing delete_all/;
+throws_ok { Role::Tiny->apply_role_to_package('T::BagWithoutDrop', $pkg) } qr/missing drop/;
my $b = T::Bag->new;
ok $b->does('Catmandu::Iterable');
@@ -106,6 +123,7 @@ can_ok $b, 'generate_id';
can_ok $b, 'commit';
can_ok $b, 'get_or_add';
can_ok $b, 'to_hash';
+can_ok $b, 'drop';
ok Catmandu::Util::is_value($b->generate_id);
@@ -139,5 +157,7 @@ is_deeply $b->get_or_add($data->{_id}, {a=>{pony=>'wails'}}), $data;
is_deeply $b->to_hash, {$data->{_id}=>$data};
-done_testing 26;
+$b->drop;
+is $b->count, 0;
+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