File Coverage

lib/Module/Provision/TraitFor/CreatingDistributions.pm
Criterion Covered Total %
statement 24 120 20.0
branch 0 52 0.0
condition 0 12 0.0
subroutine 8 21 38.1
pod 13 13 100.0
total 45 218 20.6


line stmt bran cond sub pod time code
1             package Module::Provision::TraitFor::CreatingDistributions;
2              
3 1     1   434 use namespace::autoclean;
  1         1  
  1         5  
4              
5 1     1   51 use Class::Usul::Constants qw( FAILED FALSE OK SPC TRUE );
  1         2  
  1         5  
6 1     1   483 use Class::Usul::Functions qw( emit emit_to io trim );
  1         1  
  1         5  
7 1     1   747 use Class::Usul::Types qw( ArrayRef NonEmptySimpleStr );
  1         1  
  1         5  
8 1     1   708 use English qw( -no_match_vars );
  1         1  
  1         6  
9 1     1   294 use IO::Handle;
  1         1  
  1         27  
10 1     1   3 use Moo::Role;
  1         1  
  1         4  
11 1     1   229 use Class::Usul::Options;
  1         1  
  1         5  
12              
13             requires qw( appbase appldir branch builder chdir config exec_perms
14             homedir incdir method output next_argv project_file
15             quiet render_templates run_cmd stash testdir vcs );
16              
17             # Object attributes (public)
18             option 'editor' => is => 'lazy', isa => NonEmptySimpleStr,
19             documentation => 'Which text editor to use',
20             default => sub { $_[ 0 ]->config->editor }, format => 's';
21              
22             # Private functions
23             my $_set_env_false = sub {
24             $ENV{ $_ } = FALSE for (@_); return;
25             };
26              
27             my $_set_env_true = sub {
28             $ENV{ $_ } = TRUE for (@_); return;
29             };
30              
31             # Private methods
32             my $_create_mask = sub {
33             return oct '0777' ^ $_[ 0 ]->exec_perms;
34             };
35              
36             my $_get_cover_command = sub {
37             my $self = shift;
38              
39             ($self->builder eq 'DZ' or $self->builder eq 'MB')
40             and return 'perl Build.PL && ./Build testcover';
41              
42             return;
43             };
44              
45             my $_get_cover_build_command = sub {
46             my $self = shift;
47              
48             $self->builder eq 'DZ' and return 'dzil build';
49              
50             return;
51             };
52              
53             my $_get_test_command = sub {
54             return $_[ 1 ] ? 'prove -lv '.$_[ 1 ]
55             : $_[ 0 ]->builder eq 'DZ' ? 'dzil test'
56             : 'prove t';
57             };
58              
59             my $_project_file_path = sub {
60             return $_[ 0 ]->appldir->catfile( $_[ 0 ]->project_file );
61             };
62              
63             # Construction
64             around '_build_appbase' => sub {
65             my ($orig, $self, @args) = @_; my $appbase = $orig->( $self, @args );
66              
67             return $self->method eq 'dist'
68             ? $self->base->absolute( $self->initial_wd )->catdir( $self->distname )
69             : $appbase;
70             };
71              
72             around '_build_appldir' => sub {
73             my ($next, $self, @args) = @_; my $appldir = $self->$next( @args );
74              
75             return !$appldir && $self->method eq 'dist'
76             ? $self->appbase->catdir( $self->branch ) : $appldir ;
77             };
78              
79             around '_build_builder' => sub {
80             my ($next, $self, @args) = @_; my $builder = $self->$next( @args );
81              
82             return !$builder && $self->method eq 'dist'
83             ? $self->config->builder : $builder;
84             };
85              
86             around '_build_project' => sub {
87             my ($next, $self, @args) = @_; my $project;
88              
89             $self->method eq 'dist' and $project = $self->next_argv and return $project;
90              
91             return $self->$next( @args );
92             };
93              
94             around '_build_vcs' => sub {
95             my ($next, $self, @args) = @_; my $vcs = $self->$next( @args );
96              
97             return $vcs eq 'none' && $self->method eq 'dist' ? $self->config->vcs : $vcs;
98             };
99              
100             # Public Methods
101             sub build_distribution : method {
102 0     0 1   my ($self, $verbose) = @_;
103              
104 0 0         if ($self->builder eq 'DZ') {
    0          
105 0 0         $self->run_cmd( 'dzil build', $verbose ? { out => 'stdout' } : {} );
106             }
107             elsif ($self->builder eq 'MB') {
108 0           $self->run_cmd( 'perl Build.PL' );
109 0 0         $self->run_cmd( './Build dist', $verbose ? { out => 'stdout' } : {} );
110             }
111              
112 0           return OK;
113             }
114              
115             sub clean_distribution : method {
116 0     0 1   my ($self, $verbose) = @_;
117              
118 0 0         if ($self->builder eq 'DZ') { $self->run_cmd( 'dzil clean' ) }
  0 0          
119 0           elsif ($self->builder eq 'MB') { $self->run_cmd( './Build distclean' ) }
120              
121 0           return OK;
122             }
123              
124             sub cover : method {
125 0     0 1   my $self = shift; $self->chdir( $self->appldir );
  0            
126              
127 0 0         $self->quiet or
128             $self->output( 'Testing coverage [_1]', { args => [ $self->appldir ] } );
129              
130 0           my $cmd = $self->$_get_cover_build_command;
131              
132 0 0         $cmd and $self->run_cmd( $cmd, $self->quiet ? {} : { out => 'stdout' } );
    0          
133 0           $_set_env_true->( @{ $self->config->test_env_vars } );
  0            
134 0           $ENV{DEVEL_COVER_OPTIONS} = '-ignore,MyModuleBuilder.pm,/home';
135 0 0         $self->builder eq 'DZ'
136             and $self->chdir( $self->distname.'-'.$self->dist_version );
137 0           $cmd = $self->$_get_cover_command;
138 0 0         $cmd and $self->run_cmd( $cmd, $self->quiet ? {} : { out => 'stdout' } );
    0          
139 0           $self->chdir( $self->appldir );
140 0           $_set_env_false->( @{ $self->config->test_env_vars } );
  0            
141 0           delete $ENV{DEVEL_COVER_OPTIONS};
142 0           return OK;
143             }
144              
145             sub create_directories {
146 0     0 1   my $self = shift; my $perms = $self->exec_perms;
  0            
147              
148 0 0         $self->quiet or $self->output( 'Creating directories' );
149 0 0         $self->appldir->exists or $self->appldir->mkpath( $perms );
150 0 0 0       $self->builder eq 'MB'
151             and ($self->incdir->exists or $self->incdir->mkpath( $perms ));
152 0 0         $self->testdir->exists or $self->testdir->mkpath( $perms );
153 0 0         $self->homedir->parent->exists or $self->homedir->parent->mkpath( $perms );
154 0           return;
155             }
156              
157             sub dist : method {
158 0     0 1   my $self = shift;
159              
160 0           $self->dist_pre_hook;
161 0           $self->create_directories;
162 0           $self->render_templates;
163 0           $self->dist_post_hook;
164 0           return OK;
165             }
166              
167             sub dist_post_hook {
168 0     0 1   my $self = shift;
169              
170 0           $self->generate_metadata( TRUE ); $self->prove;
  0            
171              
172 0           return;
173             }
174              
175             sub dist_pre_hook {
176 0     0 1   my $self = shift; umask $self->$_create_mask;
  0            
177              
178 0 0         $self->appbase->exists or $self->appbase->mkpath( $self->exec_perms );
179 0   0       $self->stash->{abstract} = $self->next_argv || $self->stash->{abstract};
180 0           $self->chdir( $self->appbase );
181 0           return;
182             }
183              
184             sub edit_project : method {
185 0     0 1   my $self = shift; my $path = $self->$_project_file_path;
  0            
186              
187 0           $self->run_cmd( $self->editor.SPC.$path, { async => TRUE } );
188 0           return OK;
189             }
190              
191             sub generate_metadata {
192 0     0 1   my ($self, $create) = @_; $self->chdir( $self->appldir );
  0            
193              
194 0 0         my $verbose = $create ? FALSE : TRUE; my $mdf = 'README.md';
  0            
195              
196 0 0         if ($self->builder eq 'DZ') { $self->build_distribution( $verbose ) }
  0 0          
197             elsif ($self->builder eq 'MB') {
198 0           $self->run_cmd( 'perl '.$self->project_file );
199 0 0         $self->run_cmd( './Build manifest', $verbose ? { out => 'stdout' } : {} );
200 0 0         $self->run_cmd( './Build distmeta', $verbose ? { out => 'stdout' } : {} );
201             }
202              
203 0           $self->clean_distribution( $verbose );
204 0 0         return $create ? $mdf : undef;
205             }
206              
207             sub metadata : method {
208 0     0 1   my $self = shift; $self->generate_metadata( FALSE ); return OK;
  0            
  0            
209             }
210              
211             sub prove : method {
212 0     0 1   my $self = shift; $self->chdir( $self->appldir );
  0            
213              
214 0           my $cmd = $self->$_get_test_command( $self->next_argv );
215              
216 0           $_set_env_true->( @{ $self->config->test_env_vars } );
  0            
217              
218 0           $self->output ( 'Testing [_1]', { args => [ $self->appldir ] } );
219 0 0         $self->run_cmd( $cmd, $self->quiet ? {} : { out => 'stdout' } );
220              
221 0           $_set_env_false->( @{ $self->config->test_env_vars } );
  0            
222 0           return OK;
223             }
224              
225             sub select_project : method {
226 0     0 1   my $self = shift;
227 0           my @projects = $self->base->all_dirs;
228 0           my @options = map { $_->basename } @projects;
  0            
229 0           my $prompt = 'Select a project from the following list';
230 0           my $index = $self->get_option( $prompt, undef, TRUE, undef, \@options );
231              
232 0 0         $index < 0 and return FAILED;
233              
234 0           my $name = $projects[ $index ]->basename;
235 0           my $project = Module::Provision->new
236             ( noask => TRUE, project => $name, quiet => TRUE );
237              
238 0           $self->chdir( my $dir = $project->appldir );
239              
240 0           io()->fdopen( 3, 'w' )->print( $dir )->close;
241              
242 0           return Module::Provision->new
243             ( method => 'edit_project', noask => TRUE, quiet => TRUE )->run;
244             }
245              
246             sub show_tab_title : method {
247 0     0 1   my $self = shift;
248 0   0       my $file = $self->next_argv || $self->$_project_file_path;
249 0   0       my $text = (grep { m{ tab-title: }msx } io( $file )->getlines)[ -1 ]
250             || ':'.$self->distname;
251              
252 0           emit trim( (split m{ : }msx, $text, 2)[ 1 ] ).SPC.$self->appbase;
253 0           return OK;
254             }
255              
256             1;
257              
258             __END__
259              
260             =pod
261              
262             =encoding utf-8
263              
264             =head1 Name
265              
266             Module::Provision::TraitFor::CreatingDistributions - Create distributions
267              
268             =head1 Synopsis
269              
270             use Moose;
271              
272             extends 'Module::Provision::Base';
273             with 'Module::Provision::TraitFor::CreatingDistributions';
274              
275             =head1 Description
276              
277             Create distributions using either Git or SVN for the VCS
278              
279             =head1 Configuration and Environment
280              
281             Requires these attributes to be defined in the consuming class;
282             C<appbase>, C<appldir>, C<builder>, C<exec_perms>, C<homedir>,
283             C<incdir>, C<project_file>, C<render_templates>, C<stash>, C<testdir>,
284             and C<vcs>
285              
286             Defines the following attributes;
287              
288             =over 3
289              
290             =item <editor>
291              
292             Which text editor to use. It is a read only, lazily evaluated, simple
293             string that cannot be null. It defaults to the C<editor> configuration
294             variable
295              
296             =back
297              
298             =head1 Subroutines/Methods
299              
300             =head2 build_distribution - Build a CPAN distribution tarball
301              
302             $self->build_distribution( $verbose );
303              
304             Builds a CPAN distribution tarball
305              
306             =head2 clean_distribution - Cleans up after a distribution build
307              
308             $self->clean_distribution( $verbose );
309              
310             Cleans up after a distribution build
311              
312             =head2 cover - Create test coverage statistics
313              
314             $exit_code = $self->cover;
315              
316             Returns the exit code. Runs the distributions coverage tests
317              
318             =head2 create_directories
319              
320             $self->create_directories;
321              
322             Creates the required directories for the new distribution. If subclassed this
323             method can be modified to include additional directories
324              
325             =head2 dist - Create a new distribution
326              
327             $exit_code = $self->dist;
328              
329             The distributions main module name is specified on the command line
330              
331             =head2 dist_post_hook
332              
333             $self->dist_post_hook;
334              
335             Runs after the new distribution has been created. If subclassed this method
336             can be modified to perform additional actions after the templates have been
337             rendered
338              
339             =head2 dist_pre_hook
340              
341             $self->dist_pre_hook;
342              
343             Runs before the new distribution is created. If subclassed this method
344             can be modified to perform additional actions before the project directories
345             are created
346              
347             =head2 edit_project - Edit the project file
348              
349             $exit_code = $self->edit_project;
350              
351             The project file is one of; F<dist.ini>, F<Build.PL>, or
352             F<Makefile.PL> in the current directory
353              
354             =head2 generate_metadata
355              
356             $markdown_file = $self->generate_metadata( $create_flag );
357              
358             Generates the distribution metadata files. If the create_flag is C<TRUE>
359             returns the name of the F<README.md> file
360              
361             =head2 metadata - Generate the distribution metadata files
362              
363             $exit_code = $self->metadata;
364              
365             Calls L</generate_metadata> with the create flag set to C<FALSE>
366              
367             =head2 prove - Runs the tests for the distribution
368              
369             $exit_code = $self->prove;
370              
371             Returns the exit code. Runs the distributions tests. If a specific test file
372             is given on the command line, run only that that test
373              
374             =head2 select_project - List available projects and select one to edit
375              
376             $exit_code = $self->select_project
377              
378             Use from the shell like this:
379              
380             cd $(module_provision -q select_project 2>&1 1>/dev/tty)
381              
382             Display a list of projects, select one and edit it's project file
383              
384             =head2 show_tab_title - Display the tab title for the current distribution
385              
386             $exit_code = $self->show_tab_title;
387              
388             Print the tab title for the current project to C<STDOUT>
389              
390             =head1 Diagnostics
391              
392             None
393              
394             =head1 Dependencies
395              
396             =over 3
397              
398             =item L<Class::Usul>
399              
400             =item L<Moose::Role>
401              
402             =back
403              
404             =head1 Incompatibilities
405              
406             There are no known incompatibilities in this module
407              
408             =head1 Bugs and Limitations
409              
410             There are no known bugs in this module.
411             Please report problems to the address below.
412             Patches are welcome
413              
414             =head1 Acknowledgements
415              
416             Larry Wall - For the Perl programming language
417              
418             =head1 Author
419              
420             Peter Flanigan, C<< <pjfl@cpan.org> >>
421              
422             =head1 License and Copyright
423              
424             Copyright (c) 2016 Peter Flanigan. All rights reserved
425              
426             This program is free software; you can redistribute it and/or modify it
427             under the same terms as Perl itself. See L<perlartistic>
428              
429             This program is distributed in the hope that it will be useful,
430             but WITHOUT WARRANTY; without even the implied warranty of
431             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
432              
433             =cut
434              
435             # Local Variables:
436             # mode: perl
437             # tab-width: 3
438             # End: