File Coverage

blib/lib/Dist/Zilla/Util/Test/KENTNL.pm
Criterion Covered Total %
statement 37 54 68.5
branch 6 14 42.8
condition 2 4 50.0
subroutine 8 11 72.7
pod 2 2 100.0
total 55 85 64.7


line stmt bran cond sub pod time code
1 4     4   196453 use 5.006;
  4         10  
2 4     4   16 use strict;
  4         6  
  4         78  
3 4     4   15 use warnings;
  4         4  
  4         267  
4              
5             package Dist::Zilla::Util::Test::KENTNL;
6              
7             our $VERSION = '1.005014';
8              
9             #ABSTRACT: KENTNL's DZil plugin testing tool
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13 4     4   1728 use Try::Tiny qw( try catch );
  4         7213  
  4         246  
14 4         29 use Sub::Exporter -setup => {
15             exports => [ 'test_config', 'dztest' ],
16             groups => [ default => [qw( -all )] ],
17 4     4   948 };
  4         15553  
18              
19              
20              
21              
22              
23              
24              
25              
26              
27             sub dztest {
28 2     2 1 1106 my (@args) = @_;
29 2         1123 require Dist::Zilla::Util::Test::KENTNL::dztest;
30 2         9 return Dist::Zilla::Util::Test::KENTNL::dztest->new(@args);
31             }
32              
33              
34              
35              
36              
37              
38              
39              
40              
41              
42              
43              
44              
45              
46              
47              
48              
49              
50              
51              
52              
53              
54              
55              
56              
57              
58              
59              
60              
61              
62              
63              
64              
65              
66              
67              
68              
69              
70              
71              
72              
73              
74              
75              
76              
77              
78              
79              
80              
81              
82              
83              
84              
85              
86              
87              
88              
89              
90              
91              
92              
93              
94              
95              
96              
97              
98              
99              
100              
101              
102              
103              
104              
105              
106              
107              
108              
109              
110              
111              
112              
113              
114              
115              
116              
117              
118              
119              
120              
121              
122              
123              
124             sub test_config {
125 1     1 1 1118 my ($conf) = shift;
126 1         2 my $args = [];
127 1 50       4 if ( $conf->{dist_root} ) {
128 1         4 $args->[0] = { dist_root => $conf->{dist_root} };
129             }
130 1 50       3 if ( $conf->{ini} ) {
131 1   50     8 $args->[1] ||= {};
132 1   50     5 $args->[1]->{add_files} ||= {};
133 1         576 require Test::DZil;
134             ## no critic (Subroutines::ProhibitCallsToUnexportedSubs)
135             ## no critic (Subroutines::ProtectPrivateSubs)
136 1         17208 $args->[1]->{add_files}->{'source/dist.ini'} = Test::DZil::_simple_ini()->( @{ $conf->{ini} } );
  1         6  
137             }
138 1         67 my $build_error = undef;
139 1         2 my $instance;
140             try {
141 1     1   504 require Dist::Zilla::Tester;
142 1         1612181 $instance = Dist::Zilla::Tester->builder()->from_config( @{$args} );
  1         12  
143              
144 1 50       634738 if ( $conf->{build} ) {
145 0         0 $instance->build();
146             }
147             }
148             catch {
149 0     0   0 $build_error = $_;
150 1         9 };
151              
152             # post_build_callback can be used like an error handler of sorts.
153             # ( Sort of a deferred but pre-defined catch clause )
154             # if its defined its called, and no native build errors should occur
155              
156             # without this defined, if an error occurs, we rethrow it with die
157              
158 1 50       21 if ( $conf->{post_build_callback} ) {
    50          
159 0         0 $conf->{post_build_callback}->(
160             {
161             error => $build_error,
162             instance => $instance,
163             }
164             );
165             }
166             elsif ( defined $build_error ) {
167 0         0 require Carp;
168 0         0 Carp::croak $build_error;
169             }
170              
171 1 50       3 if ( $conf->{find_plugin} ) {
172 0         0 my $plugin = $instance->plugin_named( $conf->{find_plugin} );
173 0 0       0 if ( $conf->{callback} ) {
174 0         0 my $error = undef;
175 0         0 my $method = $conf->{callback}->{method};
176 0         0 my $callargs = $conf->{callback}->{args};
177 0         0 my $call = $conf->{callback}->{code};
178 0         0 my $response;
179             try {
180 0     0   0 $response = $instance->$method( $callargs->flatten );
181             }
182             catch {
183 0     0   0 $error = $_;
184 0         0 };
185 0         0 return $call->(
186             {
187             plugin => $plugin,
188             error => $error,
189             response => $response,
190             instance => $instance,
191             }
192             );
193             }
194 0         0 return $plugin;
195             }
196              
197 1         7 return $instance;
198             }
199              
200             1;
201              
202             __END__
203              
204             =pod
205              
206             =encoding UTF-8
207              
208             =head1 NAME
209              
210             Dist::Zilla::Util::Test::KENTNL - KENTNL's DZil plugin testing tool
211              
212             =head1 VERSION
213              
214             version 1.005014
215              
216             =head1 DESCRIPTION
217              
218             This module is KENTNL's kit for testing Dist::Zilla.
219              
220             Most of his modules should be moving to using the `dztest` model
221             instead which is more flexible source side.
222              
223             =head1 METHODS
224              
225             =head2 C<dztest>
226              
227             Creates a L<< C<Dist::Zilla::Util::Test::KENTNL>|Dist::Zilla::Util::Test::KENTNL::dztest >> object.
228              
229             This is a much more sane approach to testing than C<test_config>
230              
231             =head2 test_config
232              
233             This is pretty much why this module exists. Its a little perverse, but makes testing WAY easier.
234              
235             my $plugin = test_config({
236             dist_root => 'corpus/dist/DZT',
237             ini => [
238             'GatherDir',
239             [ 'Prereqs' => { 'Test::Simple' => '0.88' } ],
240             ],
241             post_build_callback => sub {
242             my $config = shift;
243             # Handy place to put post-construction test code.
244             die $config->{error} if $config->{error};
245             },
246             find_plugin => 'SomePluginName'
247             });
248              
249             Additionally, you can add this section
250              
251             callback => {
252             method => 'metadata',
253             args => [],
254             code => sub {
255             my $data = shift;
256             print "Errors ( if any ) $data->{error} ";
257             dump $data->{response}; # response from ->metadata
258             $data->{instance}->doMorestuffbyhand();
259             # ok( .... 'good place for a test!' )
260             },
261             }
262              
263             Generally, I find it easier to do 1-off function wrappers, i.e.:
264              
265             sub make_plugin {
266             my @args = @_;
267             return test_config({
268             dist_root => 'corpus/dist/DZT',
269             ini => [
270             'GatherDir',
271             [ 'Prereqs' => {'Test::Simple' => '0.88' } ],
272             [ 'FakePlugin' => {@args } ],
273             ],
274             post_build_callback => sub {
275             my $config = shift;
276             die $config->{error} if $config->{error};
277             },
278             find_plugin => 'FakePlugin',
279             });
280             }
281              
282             Which lets us do
283              
284             ok( make_plugin( inherit_version => 1 )->inherit_version , 'inherit_verion = 1 propagates' );
285              
286             =head4 parameters
287              
288             my $foo = test_config({
289             dist_root => 'Some/path' # optional, strongly recommended.
290             ini => [ # optional, strongly recommended.
291             'BasicPlugin',
292             [ 'AdvancedPlugin' => { %pluginargs }],
293             ],
294             build => 0/1 # works fine as 0, 1 tells it to call the ->build() method.
295             post_build_callback => sub {
296             my ( $conf ) = shift;
297             $conf->{error} # any errors that occured during construction/build
298             $conf->{instance} # the constructed instance
299             # this is called immediately after construction, do what you will with this.
300             # mostly for convenience
301             },
302             find_plugin => 'Some::Plugin::Name', # makes test_config find and return the plugin that matched that name instead of
303             # the config instance
304              
305             callback => { # overrides the return value of find_plugin if it is called
306             method => 'method_to_call',
307             args => [qw( hello world )],
308             code => sub {
309             my ($conf) = shift;
310             $conf->{plugin} # the constructed plugin instance
311             $conf->{error} # any errors discovered when calling ->method( args )
312             $conf->{instance} # the zilla instance
313             $conf->{response} # the return value of ->method( args )
314             # mostly just another convenience of declarative nature.
315             return someValueHere # this value will be returned by test_config
316             }
317             },
318             });
319              
320             =head1 AUTHOR
321              
322             Kent Fredric <kentnl@cpan.org>
323              
324             =head1 COPYRIGHT AND LICENSE
325              
326             This software is copyright (c) 2017 by Kent Fredric <kentnl@cpan.org>.
327              
328             This is free software; you can redistribute it and/or modify it under
329             the same terms as the Perl 5 programming language system itself.
330              
331             =cut