[libcatmandu-perl] 13/30: new Store default_options

Jonas Smedegaard dr at jones.dk
Tue Dec 19 11:10:13 UTC 2017


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

js pushed a commit to annotated tag debian/1.0700-1
in repository libcatmandu-perl.

commit d9859b52b3cc3d82bc453387a40e613cc9505f00
Author: Nicolas Steenlant <nicolas.steenlant at ugent.be>
Date:   Thu Oct 19 14:56:33 2017 +0200

    new Store default_options
---
 lib/Catmandu/Store.pm |  7 ++++---
 t/Catmandu-Store.t    | 16 ++++++++++++++++
 2 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/lib/Catmandu/Store.pm b/lib/Catmandu/Store.pm
index 6abc312..4221476 100644
--- a/lib/Catmandu/Store.pm
+++ b/lib/Catmandu/Store.pm
@@ -16,6 +16,7 @@ has bag_class => (is => 'ro', default => sub {ref($_[0]) . '::Bag'},);
 
 has default_bag => (is => 'lazy');
 has default_plugins => (is => 'ro', default => sub {[]},);
+has default_options => (is => 'ro', default => sub {{}},);
 has bag_options => (is => 'ro', init_arg => 'bags', default => sub {+{}},);
 has key_prefix => (is => 'lazy', default => sub {'_'},);
 has id_key => (is => 'lazy', alias => 'id_field');
@@ -37,9 +38,9 @@ sub new_bag {
     $opts ||= {};
     $opts->{store} = $self;
     $opts->{name} = $name // $self->default_bag;
-    if (my $default = $self->bag_options->{$name}) {
-        $opts = {%$default, %$opts};
-    }
+    my $default_opts = $self->default_options;
+    my $bag_opts = $self->bag_options->{$opts->{name}} //= {};
+    $opts = {%$default_opts, %$bag_opts, %$opts};
 
     my $pkg = require_package(delete($opts->{class}) // $self->bag_class);
     my $default_plugins = $self->default_plugins;
diff --git a/t/Catmandu-Store.t b/t/Catmandu-Store.t
index fa18a2e..b66a7c7 100644
--- a/t/Catmandu-Store.t
+++ b/t/Catmandu-Store.t
@@ -63,6 +63,22 @@ is $s->bag('foo')->prop,    'val',  "options are passed to bag";
 isnt $s->bag('foo')->store, 'junk', "store can't be overriden";
 isnt $s->bag('foo')->name,  'junk', "name can't be overriden";
 
+# default options
+
+$s = T::Store->new(
+    bag_class => 'T::CustomBagClass',
+    default_options => {prop => 'bar'},
+    bags      => {foo => {store => 'junk', name => 'junk'}}
+);
+is $s->bag('foo')->prop, 'bar';
+
+$s = T::Store->new(
+    bag_class => 'T::CustomBagClass',
+    default_options => {prop => 'bar'},
+    bags      => {foo => {prop => 'baz', store => 'junk', name => 'junk'}}
+);
+is $s->bag('foo')->prop, 'baz';
+
 # custom key_prefix
 
 is(T::Store->new->key_prefix, '_');

-- 
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