File Coverage

lib/Module/Provision/TraitFor/AddingFiles.pm
Criterion Covered Total %
statement 18 55 32.7
branch 0 14 0.0
condition n/a
subroutine 6 10 60.0
pod 4 4 100.0
total 28 83 33.7


line stmt bran cond sub pod time code
1             package Module::Provision::TraitFor::AddingFiles;
2              
3 1     1   402 use namespace::autoclean;
  1         1  
  1         5  
4              
5 1     1   49 use Class::Usul::Constants qw( EXCEPTION_CLASS OK TRUE );
  1         1  
  1         5  
6 1     1   409 use Class::Usul::Functions qw( classfile throw );
  1         1  
  1         5  
7 1     1   683 use Scalar::Util qw( blessed );
  1         1  
  1         37  
8 1     1   4 use Unexpected::Functions qw( Unspecified );
  1         1  
  1         5  
9 1     1   180 use Moo::Role;
  1         1  
  1         5  
10              
11             requires qw( add_to_vcs appldir binsdir cmd_line_flags exec_perms expand_tuple
12             libdir loc method module_abstract next_argv output project
13             release render_template stash template_dir template_list testdir );
14              
15             # Construction
16             around 'generate_metadata' => sub {
17             my ($orig, $self, @args) = @_; my $mdf = $orig->( $self, @args );
18              
19             $mdf and $self->appldir->catfile( $mdf )->exists
20             and $self->add_to_vcs( $mdf );
21              
22             return $mdf;
23             };
24              
25             # Private methods
26             my $_program_abstract = sub {
27             return $_[ 0 ]->loc( 'One-line description of the programs purpose' );
28             };
29              
30             my $_get_target = sub {
31             my ($self, $dir, $f) = @_;
32              
33             my $car = $self->next_argv or throw Unspecified, [ 'Target' ];
34             my $abstract = $self->next_argv
35             || ($self->method eq 'program' ? $self->$_program_abstract
36             : $self->module_abstract );
37              
38             $self->project; # Force evaluation of lazy attribute
39              
40             my $target = $self->$dir->catfile( $f ? $f->( $car ) : $car );
41              
42             $target->perms( $self->perms )->assert_filepath;
43              
44             if ($self->method eq 'module') { $self->stash->{module } = $car }
45             elsif ($self->method eq 'program') { $self->stash->{program_name} = $car }
46              
47             $self->method ne 'test' and $self->stash->{abstract} = $abstract;
48              
49             return $target;
50             };
51              
52             my $_add_test_script = sub {
53             my $self = shift; my $target = $self->$_get_target( 'testdir' );
54              
55             $self->quiet or $self->output( 'Adding new test' );
56             $target = $self->render_template( '10test_script.t', $target );
57             $self->add_to_vcs( $target, 'test' );
58             return OK;
59             };
60              
61             # Public methods
62             sub module : method {
63 0     0 1   my $self = shift; my $target = $self->$_get_target( 'libdir', \&classfile );
  0            
64              
65 0 0         $self->quiet or $self->output( 'Adding new module' );
66 0           $target = $self->render_template( 'perl_module.pm', $target );
67 0           $self->add_to_vcs( $target, 'module' );
68 0           return OK;
69             }
70              
71             sub program : method {
72 0     0 1   my $self = shift; my $target = $self->$_get_target( 'binsdir' );
  0            
73              
74 0 0         $self->quiet or $self->output( 'Adding new program' );
75 0           $target = $self->render_template( 'perl_program.pl', $target );
76 0           chmod $self->exec_perms, $target->pathname;
77 0           $self->add_to_vcs( $target, 'program' );
78 0           return OK;
79             }
80              
81             sub test : method {
82 0     0 1   my $self = shift; my $flags = $self->cmd_line_flags; $flags->{test} = TRUE;
  0            
  0            
83              
84 0 0         return $flags->{release} ? $self->release : $self->$_add_test_script;
85             }
86              
87             sub update_file : method {
88 0     0 1   my $self = shift;
89 0 0         my $target = $self->next_argv or throw Unspecified, [ 'target' ];
90 0           my $index = {};
91              
92 0           for my $t (map { my $k = $_->[ 0 ]; my $v = $_->[ 1 ];
  0            
  0            
93 0           $_->[ 1 ] = $v->relative( $self->appldir ); $_ }
  0            
94 0           map { my $k = $_->[ 0 ]; my $v = $_->[ 1 ];
  0            
95 0 0         $v->is_dir and $_->[ 1 ] = $v->catfile( $k ); $_ }
  0            
96 0           map { $self->expand_tuple( $_ ) } @{ $self->template_list } ) {
  0            
97 0           $index->{ $t->[ 1 ]->pathname } = $t->[ 0 ];
98             }
99              
100 0 0         exists $index->{ $target }
101             or throw 'File [_1] not in template map', [ $target ];
102              
103 0           my $source = $self->template_dir->catfile( $index->{ $target } );
104              
105 0 0         $source->exists or throw 'File [_1] not found', [ $source ];
106 0           $source->copy( $target );
107 0           return OK;
108             }
109              
110             1;
111              
112             __END__
113              
114             =pod
115              
116             =encoding utf8
117              
118             =head1 Name
119              
120             Module::Provision::TraitFor::AddingFiles - Adds additional files to the project
121              
122             =head1 Synopsis
123              
124             use Moose;
125              
126             extends 'Module::Provision::Base';
127             with 'Module::Provision::TraitFor::AddingFiles';
128              
129             =head1 Description
130              
131             Adds additional modules, programs, and tests to the project
132              
133             =head1 Configuration and Environment
134              
135             Requires the following attributes to be defined in the consuming
136             class; C<add_to_vcs>, C<appldir>, C<binsdir>, C<exec_perms>, C<libdir>,
137             C<module_abstract>, C<render_template>, C<stash>, and C<testdir>
138              
139             Modifies the C<generate_metadata> method. If C<generate_metadata> returns
140             a pathname and the file exists it is added to the VCS
141              
142             Defines no attributes
143              
144             =head1 Subroutines/Methods
145              
146             =head2 module - Create a new Perl module file
147              
148             $exit_code = $self->module;
149              
150             Creates a new module specified by the class name on the command line
151              
152             =head2 program - Create a new Perl program file
153              
154             $exit_code = $self->program;
155              
156             Creates a new program specified by the program name on the command line
157              
158             =head2 test - Create a new Perl test script
159              
160             $exit_code = $self->test;
161              
162             Creates a new test specified by the test file name on the command line
163              
164             =head2 update_file - Updates a project file with one from the template directory
165              
166             $exit_code = $self->update;
167              
168             After changes have been made to template files the command can be used to
169             update individual project files
170              
171             =head1 Diagnostics
172              
173             None
174              
175             =head1 Dependencies
176              
177             =over 3
178              
179             =item L<Class::Usul>
180              
181             =item L<Moose::Role>
182              
183             =back
184              
185             =head1 Incompatibilities
186              
187             There are no known incompatibilities in this module
188              
189             =head1 Bugs and Limitations
190              
191             There are no known bugs in this module.
192             Please report problems to the address below.
193             Patches are welcome
194              
195             =head1 Acknowledgements
196              
197             Larry Wall - For the Perl programming language
198              
199             =head1 Author
200              
201             Peter Flanigan, C<< <pjfl@cpan.org> >>
202              
203             =head1 License and Copyright
204              
205             Copyright (c) 2016 Peter Flanigan. All rights reserved
206              
207             This program is free software; you can redistribute it and/or modify it
208             under the same terms as Perl itself. See L<perlartistic>
209              
210             This program is distributed in the hope that it will be useful,
211             but WITHOUT WARRANTY; without even the implied warranty of
212             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
213              
214             =cut
215              
216             # Local Variables:
217             # mode: perl
218             # tab-width: 3
219             # End: