[libdist-zilla-util-configdumper-perl] 03/03: Add callback and attribute support
Florian Schlichting
fsfs at moszumanska.debian.org
Sat Nov 11 15:43:51 UTC 2017
This is an automated email from the git hooks/post-receive script.
fsfs pushed a commit to annotated tag 0.002000-source
in repository libdist-zilla-util-configdumper-perl.
commit e06b044cd130c19a8957afb0b41a79994f0b48bc
Author: Kent Fredric <kentfredric at gmail.com>
Date: Sat Aug 23 05:51:35 2014 +1200
Add callback and attribute support
---
Changes | 8 ++
README.mkdn | 52 +++++++++++-
lib/Dist/Zilla/Util/ConfigDumper.pm | 156 ++++++++++++++++++++++++++++--------
maint/perlcritic.rc.gen.pl | 3 +-
misc/Changes.deps | 4 +-
misc/Changes.deps.all | 4 +-
misc/Changes.deps.dev | 2 +-
misc/Changes.deps.opt | 2 +-
perlcritic.rc | 2 +-
t/attr_lazy.t | 82 +++++++++++++++++++
t/callback.t | 45 +++++++++++
11 files changed, 321 insertions(+), 39 deletions(-)
diff --git a/Changes b/Changes
index d03b14e..4ebbbdf 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,14 @@
Release history for Dist-Zilla-Util-ConfigDumper
{{$NEXT}}
+ [00 Major]
+ - now supports coderefs
+ - now supports hashrefs depicting true attributes
+ - Moose plumbing internals for attributes.
+
+ [Dependencies::Stats]
+ - Dependencies changed since 0.001000, see misc/*.deps* for details
+ - runtime: +1
0.001000 2014-08-22T14:16:22Z
- First version.
diff --git a/README.mkdn b/README.mkdn
index 9b6f523..c2c259d 100644
--- a/README.mkdn
+++ b/README.mkdn
@@ -4,7 +4,7 @@ Dist::Zilla::Util::ConfigDumper - Easy implementation of 'dumpconfig'
# VERSION
-version 0.001001
+version 0.002000
# SYNOPSIS
@@ -55,6 +55,56 @@ Either way:
Except with some extra "things dun goofed" handling.
+# ADVANCED USE
+
+## CALLBACKS
+
+Internally
+
+ config_dumper( $pkg, qw( method list ) );
+
+Maps to a bunch of subs, so its more like:
+
+ config_dumper( $pkg, sub {
+ my ( $instance, $payload ) = @_;
+ $payload->{'method'} = $instance->method;
+ }, sub {
+ $_[1]->{'list'} = $_[0]->list;
+ });
+
+So if you want to use that because its more convenient for some problem, be my guest.
+
+ around dump_config => config_dumper( __PACKAGE__, sub {
+ $_[1]->{'x'} = 'y'
+ });
+
+is much less ugly than
+
+ around dump_config => sub {
+ my ( $orig, $self, @args ) = @_;
+ my $conf = $self->$orig(@args);
+ $config->{+__PACKAGE__} = { # if you forget the +, things break
+ 'x' => 'y'
+ };
+ return $config;
+ };
+
+## DETAILED CONFIGURATION
+
+There's an additional feature for advanced people:
+
+ config_dumper( $pkg, \%config );
+
+### `attrs`
+
+ config_dumper( $pkg, { attrs => [qw( foo bar baz )] });
+
+This is for cases where you want to deal with `Moose` attributes,
+but want added safety of **NOT** loading attributes that have no value yet.
+
+For each item in `attrs`, we'll call `Moose` attribute internals to determine
+if the attribute named has a value, and only then will we fetch it.
+
# AUTHOR
Kent Fredric <kentfredric at gmail.com>
diff --git a/lib/Dist/Zilla/Util/ConfigDumper.pm b/lib/Dist/Zilla/Util/ConfigDumper.pm
index 6ca7e94..e9530e9 100644
--- a/lib/Dist/Zilla/Util/ConfigDumper.pm
+++ b/lib/Dist/Zilla/Util/ConfigDumper.pm
@@ -5,15 +5,88 @@ use utf8;
package Dist::Zilla::Util::ConfigDumper;
-our $VERSION = '0.001001';
+our $VERSION = '0.002000';
# ABSTRACT: Easy implementation of 'dumpconfig'
# AUTHORITY
+use Carp qw( croak );
use Try::Tiny qw( try catch );
use Sub::Exporter::Progressive -setup => { exports => [qw( config_dumper )], };
+sub config_dumper {
+ my ( $package, @methodnames ) = @_;
+ my (@tests) = map { _mk_test( $package, $_ ) } @methodnames;
+ my $CFG_PACKAGE = __PACKAGE__;
+ return sub {
+ my ( $orig, $self, @rest ) = @_;
+ my $cnf = $self->$orig(@rest);
+ my $payload = {};
+ my @fails;
+ for my $test (@tests) {
+ $test->( $self, $payload, \@fails );
+ }
+ $cnf->{$package} = $payload;
+ if (@fails) {
+ $cnf->{$CFG_PACKAGE} = {} unless exists $cnf->{$CFG_PACKAGE};
+ $cnf->{$CFG_PACKAGE}->{$package} = {} unless exists $cnf->{$CFG_PACKAGE};
+ $cnf->{$CFG_PACKAGE}->{$package}->{failed} = \@fails;
+ }
+ return $cnf;
+ };
+}
+
+sub _mk_method_test {
+ my ( undef, $methodname ) = @_;
+ return sub {
+ my ( $instance, $payload, $fails ) = @_;
+ try {
+ my $value = $instance->$methodname();
+ $payload->{$methodname} = $value;
+ }
+ catch {
+ push @{$fails}, $methodname;
+ };
+ };
+}
+
+sub _mk_attribute_test {
+ my ( $package, $attrname ) = @_;
+ my $metaclass = $package->meta;
+ my $attribute_metaclass = $metaclass->get_attribute($attrname);
+ return sub {
+ my ( $instance, $payload, $fails ) = @_;
+ try {
+ if ( $attribute_metaclass->has_value($instance) ) {
+ $payload->{$attrname} = $attribute_metaclass->get_value($instance);
+ }
+ }
+ catch {
+ push @{$fails}, $attrname;
+ };
+ };
+}
+
+sub _mk_hash_test {
+ my ( $package, $hash ) = @_;
+ my @out;
+ if ( exists $hash->{attrs} and 'ARRAY' eq ref $hash->{attrs} ) {
+ push @out, map { _mk_attribute_test( $package, $_ ) } @{ $hash->{attrs} };
+ }
+ return @out;
+}
+
+sub _mk_test {
+ my ( $package, $methodname ) = @_;
+ return _mk_method_test( $package, $methodname ) if not ref $methodname;
+ return $methodname if 'CODE' eq ref $methodname;
+ return _mk_hash_test( $package, $methodname ) if 'HASH' eq ref $methodname;
+ croak "Don't know what to do with $methodname";
+}
+
+1;
+
=function C<config_dumper>
config_dumper( __PACKAGE__, qw( method list ) );
@@ -52,37 +125,6 @@ Either way:
Except with some extra "things dun goofed" handling.
-=cut
-
-sub config_dumper {
- my ( $package, @methodnames ) = @_;
- my $CFG_PACKAGE = __PACKAGE__;
- return sub {
- my ( $orig, $self, @rest ) = @_;
- my $cnf = $self->$orig(@rest);
- my $payload = {};
- my @fails;
- for my $method (@methodnames) {
- try {
- my $value = $self->$method();
- $payload->{$method} = $value;
- }
- catch {
- push @fails, $method;
- };
- }
- $cnf->{$package} = $payload;
- if (@fails) {
- $cnf->{$CFG_PACKAGE} = {} unless exists $cnf->{$CFG_PACKAGE};
- $cnf->{$CFG_PACKAGE}->{$package} = {} unless exists $cnf->{$CFG_PACKAGE};
- $cnf->{$CFG_PACKAGE}->{$package}->{failed} = \@fails;
- }
- return $cnf;
- };
-}
-
-1;
-
=head1 SYNOPSIS
...
@@ -92,4 +134,54 @@ sub config_dumper {
around dump_config => config_dumper( __PACKAGE__, qw( foo bar baz ) );
+=head1 ADVANCED USE
+
+=head2 CALLBACKS
+
+Internally
+
+ config_dumper( $pkg, qw( method list ) );
+
+Maps to a bunch of subs, so its more like:
+
+ config_dumper( $pkg, sub {
+ my ( $instance, $payload ) = @_;
+ $payload->{'method'} = $instance->method;
+ }, sub {
+ $_[1]->{'list'} = $_[0]->list;
+ });
+
+So if you want to use that because its more convenient for some problem, be my guest.
+
+ around dump_config => config_dumper( __PACKAGE__, sub {
+ $_[1]->{'x'} = 'y'
+ });
+
+is much less ugly than
+
+ around dump_config => sub {
+ my ( $orig, $self, @args ) = @_;
+ my $conf = $self->$orig(@args);
+ $config->{+__PACKAGE__} = { # if you forget the +, things break
+ 'x' => 'y'
+ };
+ return $config;
+ };
+
+=head2 DETAILED CONFIGURATION
+
+There's an additional feature for advanced people:
+
+ config_dumper( $pkg, \%config );
+
+=head3 C<attrs>
+
+ config_dumper( $pkg, { attrs => [qw( foo bar baz )] });
+
+This is for cases where you want to deal with C<Moose> attributes,
+but want added safety of B<NOT> loading attributes that have no value yet.
+
+For each item in C<attrs>, we'll call C<Moose> attribute internals to determine
+if the attribute named has a value, and only then will we fetch it.
+
=cut
diff --git a/maint/perlcritic.rc.gen.pl b/maint/perlcritic.rc.gen.pl
index 9524ed0..6d8d186 100644
--- a/maint/perlcritic.rc.gen.pl
+++ b/maint/perlcritic.rc.gen.pl
@@ -26,7 +26,8 @@ for my $wordlist (@stopwords) {
#$bundle->add_or_append_policy_field(
# 'Subroutines::ProhibitCallsToUndeclaredSubs' => ( 'exempt_subs' => 'String::Formatter::str_rf' ), );
-#$bundle->remove_policy('ErrorHandling::RequireUseOfExceptions');
+$bundle->remove_policy('ErrorHandling::RequireUseOfExceptions');
+
#$bundle->remove_policy('CodeLayout::RequireUseUTF8');
#$bundle->remove_policy('ErrorHandling::RequireCarping');
#$bundle->remove_policy('NamingConventions::Capitalization');
diff --git a/misc/Changes.deps b/misc/Changes.deps
index f740ccc..ad3b7f7 100644
--- a/misc/Changes.deps
+++ b/misc/Changes.deps
@@ -1,4 +1,6 @@
This file contains changes in REQUIRED dependencies for standard CPAN phases (configure/build/runtime/test)
-0.001001
+0.002000
+ [Added / runtime requires]
+ - Carp
diff --git a/misc/Changes.deps.all b/misc/Changes.deps.all
index 3d7604d..23ea7f5 100644
--- a/misc/Changes.deps.all
+++ b/misc/Changes.deps.all
@@ -1,4 +1,6 @@
This file contains ALL changes in dependencies in both REQUIRED / OPTIONAL dependencies for all phases (configure/build/runtime/test/develop)
-0.001001
+0.002000
+ [Added / runtime requires]
+ - Carp
diff --git a/misc/Changes.deps.dev b/misc/Changes.deps.dev
index af5bbbe..da06072 100644
--- a/misc/Changes.deps.dev
+++ b/misc/Changes.deps.dev
@@ -1,4 +1,4 @@
This file contains changes to DEVELOPMENT dependencies only ( both REQUIRED and OPTIONAL )
-0.001001
+0.002000
diff --git a/misc/Changes.deps.opt b/misc/Changes.deps.opt
index 62480b5..b4b0c91 100644
--- a/misc/Changes.deps.opt
+++ b/misc/Changes.deps.opt
@@ -1,4 +1,4 @@
This file contains changes in OPTIONAL dependencies for standard CPAN phases (configure/build/runtime/test)
-0.001001
+0.002000
diff --git a/perlcritic.rc b/perlcritic.rc
index e404396..c7651eb 100644
--- a/perlcritic.rc
+++ b/perlcritic.rc
@@ -166,7 +166,7 @@ stop_words = dumpconfig
[ErrorHandling::RequireCheckingReturnValueOfEval]
-[ErrorHandling::RequireUseOfExceptions]
+[-ErrorHandling::RequireUseOfExceptions]
[InputOutput::ProhibitBacktickOperators]
diff --git a/t/attr_lazy.t b/t/attr_lazy.t
new file mode 100644
index 0000000..8038904
--- /dev/null
+++ b/t/attr_lazy.t
@@ -0,0 +1,82 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::DZil qw( simple_ini );
+use Dist::Zilla::Util::Test::KENTNL 1.001 qw( dztest );
+
+# ABSTRACT: Make sure plugins do what they say they'll do
+
+require Moose;
+require Dist::Zilla::Role::Plugin;
+require Dist::Zilla::Plugin::Bootstrap::lib;
+require Dist::Zilla::Plugin::GatherDir;
+require Dist::Zilla::Plugin::MetaConfig;
+
+subtest 'unspecificied lazy' => sub {
+ my $t = dztest();
+ my $pn = 'TestPlugin';
+ my $fpn = 'Dist::Zilla::Plugin::' . $pn;
+
+ $t->add_file( 'dist.ini', simple_ini( ['Bootstrap::lib'], ['GatherDir'], ['MetaConfig'], [$pn], ) );
+ $t->add_file( 'lib/Dist/Zilla/Plugin/' . $pn . '.pm', <<"EOF");
+package $fpn;
+
+use Moose qw( has around with );
+use Dist::Zilla::Util::ConfigDumper qw( config_dumper );
+with 'Dist::Zilla::Role::Plugin';
+
+has 'attr' => ( is => 'ro', 'lazy' => 1, default => sub { 'I have value, my life has meaning' } );
+has 'nlattr' => ( is => 'ro', default => sub { 'nonlazy' } );
+
+around dump_config => config_dumper(__PACKAGE__, { attrs => [qw( attr nlattr )] });
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
+EOF
+
+ $t->build_ok;
+ $t->meta_path_deeply(
+ '/x_Dist_Zilla/plugins/*/*[ key eq \'class\' and value eq \'Dist::Zilla::Plugin::TestPlugin\' ]/../*[ key eq \'config\']',
+ [ { 'Dist::Zilla::Plugin::TestPlugin' => { nlattr => 'nonlazy' } } ],
+ "Plugin list expected"
+ );
+
+};
+
+subtest 'specificied lazy' => sub {
+ my $t = dztest();
+ my $pn = 'TestPlugin';
+ my $fpn = 'Dist::Zilla::Plugin::' . $pn;
+
+ $t->add_file( 'dist.ini', simple_ini( ['Bootstrap::lib'], ['GatherDir'], ['MetaConfig'], [ $pn, { attr => 'user' } ], ) );
+ $t->add_file( 'lib/Dist/Zilla/Plugin/' . $pn . '.pm', <<"EOF");
+package $fpn;
+
+use Moose qw( has around with );
+use Dist::Zilla::Util::ConfigDumper qw( config_dumper );
+with 'Dist::Zilla::Role::Plugin';
+
+has 'attr' => ( is => 'ro', 'lazy' => 1, default => sub { 'I have value, my life has meaning' } );
+has 'nlattr' => ( is => 'ro', default => sub { 'nonlazy' } );
+
+around dump_config => config_dumper(__PACKAGE__, { attrs => [qw( attr nlattr )] });
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
+EOF
+
+ $t->build_ok;
+ $t->meta_path_deeply(
+ '/x_Dist_Zilla/plugins/*/*[ key eq \'class\' and value eq \'Dist::Zilla::Plugin::TestPlugin\' ]/../*[ key eq \'config\']',
+ [ { 'Dist::Zilla::Plugin::TestPlugin' => { attr => 'user', nlattr => 'nonlazy' } } ],
+ "Plugin list expected"
+ );
+
+};
+done_testing;
+
diff --git a/t/callback.t b/t/callback.t
new file mode 100644
index 0000000..44a0f48
--- /dev/null
+++ b/t/callback.t
@@ -0,0 +1,45 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::DZil qw( simple_ini );
+use Dist::Zilla::Util::Test::KENTNL 1.001 qw( dztest );
+
+# ABSTRACT: Make sure plugins do what they say they'll do
+
+require Moose;
+require Dist::Zilla::Role::Plugin;
+require Dist::Zilla::Plugin::Bootstrap::lib;
+require Dist::Zilla::Plugin::GatherDir;
+require Dist::Zilla::Plugin::MetaConfig;
+
+my $t = dztest();
+my $pn = 'TestPlugin';
+my $fpn = 'Dist::Zilla::Plugin::' . $pn;
+
+$t->add_file( 'dist.ini', simple_ini( ['Bootstrap::lib'], ['GatherDir'], ['MetaConfig'], [$pn], ) );
+$t->add_file( 'lib/Dist/Zilla/Plugin/' . $pn . '.pm', <<"EOF");
+package $fpn;
+
+use Moose qw( has around with );
+use Dist::Zilla::Util::ConfigDumper qw( config_dumper );
+with 'Dist::Zilla::Role::Plugin';
+
+has 'attr' => ( is => 'ro', 'lazy' => 1, default => sub { 'I have value, my life has meaning' } );
+
+around dump_config => config_dumper(__PACKAGE__, sub { \$_[1]->{'foo'} = 'bar' });
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
+EOF
+
+$t->build_ok;
+$t->meta_path_deeply(
+ '/x_Dist_Zilla/plugins/*/*[ key eq \'class\' and value eq \'Dist::Zilla::Plugin::TestPlugin\' ]/../*[ key eq \'config\']',
+ [ { 'Dist::Zilla::Plugin::TestPlugin' => { 'foo' => 'bar' } } ],
+ "Plugin list expected"
+);
+done_testing;
+
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libdist-zilla-util-configdumper-perl.git
More information about the Pkg-perl-cvs-commits
mailing list