File Coverage

blib/lib/App/git/ship/perl.pm
Criterion Covered Total %
statement 71 261 27.2
branch 15 116 12.9
condition 5 31 16.1
subroutine 17 36 47.2
pod 7 7 100.0
total 115 451 25.5


line stmt bran cond sub pod time code
1             package App::git::ship::perl;
2 5     5   296079 use Mojo::Base 'App::git::ship';
  5         790605  
  5         31  
3              
4 5     5   2385 use Module::CPANfile;
  5         66777  
  5         150  
5 5     5   30 use Mojo::File qw(path tempfile);
  5         12  
  5         231  
6 5     5   26 use Mojo::Util 'decode';
  5         11  
  5         174  
7 5     5   27 use POSIX qw(setlocale strftime LC_TIME);
  5         15  
  5         38  
8 5     5   2726 use Pod::Markdown;
  5         67475  
  5         199  
9              
10 5   50 5   32 use constant DEBUG => $ENV{GIT_SHIP_DEBUG} || 0;
  5         10  
  5         17755  
11              
12             my $CONTRIB_END_RE = qr{^=head1};
13             my $CONTRIB_NAME_EMAIL_RE = qr{^(\w[\w\s]*\w) - C<(.+)>$};
14             my $CONTRIB_NAME_RE = qr{^(\w[\w\s]*\w)$};
15             my $CONTRIB_START_RE = qr{^=head1 AUTHOR};
16             my $VERSION_RE = qr{\W*\b(\d+\.[\d_]+)\b};
17              
18             sub build {
19 0     0 1 0 my $self = shift;
20              
21 0         0 $self->clean(0);
22 0 0       0 $self->system(prove => split /\s/, $self->config('build_test_options'))
23             if $self->config('build_test_options');
24 0         0 $self->clean(0);
25 0         0 $self->run_hook('before_build');
26 0 0       0 $self->_render_makefile_pl if -e 'cpanfile';
27 0         0 $self->_timestamp_to_changes;
28 0         0 $self->_update_version_info;
29 0         0 $self->_render_readme;
30 0         0 $self->_make('manifest');
31 0         0 $self->_make('dist', '-e');
32 0         0 $self->run_hook('after_build');
33 0         0 $self;
34             }
35              
36             sub can_handle_project {
37 1     1 1 10 my ($class, $file) = @_;
38 1 0       3 return $file =~ /\.pm$/ ? 1 : 0 if $file;
    50          
39 1     2   5 return path('lib')->list_tree->grep(sub {/\.pm$/})->size;
  2         656  
40             }
41              
42             sub clean {
43 0     0 1 0 my $self = shift;
44 0   0     0 my $all = shift // 1;
45 0         0 my @files = qw(Makefile Makefile.old MANIFEST MYMETA.json MYMETA.yml);
46              
47 0 0 0     0 unlink 'Makefile' and $self->_make('clean') if -e 'Makefile';
48              
49 0 0       0 push @files, qw(Changes.bak META.json META.yml) if $all;
50 0         0 push @files, $self->_dist_files->each;
51              
52 0         0 for my $file (@files) {
53 0 0       0 next unless -e $file;
54 0 0 0     0 unlink $file or warn "!! rm $file: $!" and next;
55 0 0       0 say "\$ rm $file" unless $self->SILENT;
56             }
57              
58 0         0 return $self;
59             }
60              
61             sub ship {
62 0     0 1 0 my $self = shift;
63 0         0 my $dist_file = $self->_dist_files->[0];
64 0         0 my $changelog = $self->config('changelog_filename');
65 0         0 my $uploader;
66              
67 0         0 require CPAN::Uploader;
68 0         0 $uploader = CPAN::Uploader->new(CPAN::Uploader->read_config_file);
69              
70 0 0       0 unless ($dist_file) {
71 0         0 $self->build;
72 0         0 $self->abort(
73             "Project built. Run 'git ship' again to post dist to CPAN and remote repostitory.");
74             }
75 0 0       0 unless ($self->config('next_version')) {
76 0         0 close ARGV;
77 0         0 local @ARGV = $changelog;
78 0         0 while (<>) {
79 0 0       0 /^$VERSION_RE\s*/ or next;
80 0         0 $self->config(next_version => $1);
81 0         0 last;
82             }
83             }
84              
85 0         0 $self->run_hook('before_ship');
86 0         0 $self->system(qw(git add Makefile.PL), $changelog);
87 0 0       0 $self->system(qw(git add README.md)) if -e 'README.md';
88 0         0 $self->system(qw(git commit -a -m), $self->_changes_to_commit_message);
89 0         0 $self->SUPER::ship(@_); # after all the changes
90 0         0 $uploader->upload_file($dist_file);
91 0         0 $self->run_hook('after_ship');
92             }
93              
94             sub start {
95 0     0 1 0 my $self = shift;
96 0         0 my $changelog = $self->config('changelog_filename');
97              
98 0 0       0 if (my $file = $_[0]) {
99 0 0       0 $file = $file =~ m!^.?lib! ? path($file) : path(lib => $file);
100 0         0 $self->config(main_module_path => $file);
101 0 0       0 unless (-e $file) {
102 0         0 my $work_dir = lc($self->config('project_name')) =~ s!::!-!gr;
103 0         0 mkdir $work_dir;
104 0 0       0 chdir $work_dir or $self->abort("Could not chdir to $work_dir");
105 0         0 $self->config('main_module_path')->dirname->make_path;
106 0 0       0 open my $MAINMODULE, '>>', $self->config('main_module_path')
107             or $self->abort("Could not create %s", $self->config('main_module_path'));
108             }
109             }
110              
111 0         0 $self->SUPER::start(@_);
112 0         0 $self->render_template('.travis.yml');
113 0         0 $self->render_template('.perltidyrc', {template_from_home => 1});
114 0         0 $self->render_template('cpanfile');
115 0 0       0 $self->render_template('Changes') if $changelog eq 'Changes';
116 0         0 $self->render_template('MANIFEST.SKIP');
117 0         0 $self->render_template('t/00-basic.t');
118 0         0 $self->system(qw(git add .perltidyrc .travis.yml cpanfile MANIFEST.SKIP t), $changelog);
119 0 0       0 $self->system(qw(git commit --amend -C HEAD --allow-empty)) if @_;
120 0         0 $self;
121             }
122              
123             sub test_coverage {
124 0     0 1 0 my $self = shift;
125              
126 0 0       0 unless (eval 'require Devel::Cover; 1') {
127 0         0 $self->abort(
128             'Devel::Cover is not installed. Install it with curl -L http://cpanmin.us | perl - Devel::Cover'
129             );
130             }
131              
132 0   0     0 local $ENV{DEVEL_COVER_OPTIONS} = $ENV{DEVEL_COVER_OPTIONS} || '+ignore,^t\b';
133 0         0 local $ENV{HARNESS_PERL_SWITCHES} = '-MDevel::Cover';
134 0         0 $self->system(qw(cover -delete));
135 0         0 $self->system(qw(prove -l));
136 0         0 $self->system(qw(cover));
137             }
138              
139             sub update {
140 0     0 1 0 my $self = shift;
141              
142 0 0       0 $self->_render_makefile_pl if -e 'cpanfile';
143 0 0       0 $self->_update_changes if $self->config('changelog_filename') eq 'Changes';
144 0         0 $self->_render_readme;
145 0         0 $self->render_template('t/00-basic.t', {force => 1});
146 0         0 $self;
147             }
148              
149             sub _build_config_param_changelog_filename {
150 1 50   1   3 (grep {-w} qw(CHANGELOG.md Changes))[0] || 'Changes';
  2         31  
151             }
152              
153             sub _build_config_param_contributors {
154 0     0   0 my $self = shift;
155 0 0       0 return decode 'UTF-8', $ENV{GIT_SHIP_CONTRIBUTORS} if $ENV{GIT_SHIP_CONTRIBUTORS};
156              
157 0         0 my @contributors;
158 0         0 my $module = decode 'UTF-8', path($self->config('main_module_path'))->slurp;
159 0         0 my $contrib_block;
160 0         0 for my $line (split /\n/, $module) {
161 0 0       0 if ($line =~ $CONTRIB_START_RE) {
162 0         0 $contrib_block = 1;
163 0         0 next;
164             }
165 0 0       0 $contrib_block = 0 if $line =~ $CONTRIB_END_RE;
166 0 0       0 next unless $contrib_block;
167              
168 0 0       0 if ($line =~ $CONTRIB_NAME_EMAIL_RE) {
    0          
169 0         0 push @contributors, "$1 <$2>";
170             }
171             elsif ($line =~ $CONTRIB_NAME_RE) {
172 0         0 push @contributors, $1;
173             }
174             }
175              
176 0         0 return join ',', @contributors;
177             }
178              
179             sub _build_config_param_new_version_format {
180 0   0 0   0 return $ENV{GIT_SHIP_NEW_VERSION_FORMAT} || '%v %Y-%m-%dT%H:%M:%S%z';
181             }
182              
183             sub _build_config_param_main_module_path {
184 3     3   6 my $self = shift;
185 3 50       6 return path($ENV{GIT_SHIP_MAIN_MODULE_PATH}) if $ENV{GIT_SHIP_MAIN_MODULE_PATH};
186              
187 3         10 my @project_name = split /-/, path->basename;
188 3         184 my $path = path 'lib';
189              
190             PATH_PART:
191 3         32 for my $p (@project_name) {
192 9 50       43 opendir my $DH, $path or $self->abort("Cannot find project name from $path: $!");
193              
194 9         324 for (sort { length $b <=> length $a } readdir $DH) {
  30         53  
195 9         16 my $f = "$_";
196 9         26 s!\.pm$!!;
197 9 50       24 next unless lc eq lc $p;
198 9         22 $path = path $path, $f;
199 9 100       186 last PATH_PART unless -d $path;
200 6         146 next PATH_PART;
201             }
202             }
203              
204 3         81 return $path;
205             }
206              
207             sub _build_config_param_project_name {
208 3     3   5 my $self = shift;
209 3         5 my @name = @{path($self->config('main_module_path'))};
  3         8  
210 3 50       86 shift @name if $name[0] eq 'lib';
211 3         13 $name[-1] =~ s!\.pm$!!;
212 3         17 return join '::', @name;
213             }
214              
215             sub _changes_to_commit_message {
216 1     1   604 my $self = shift;
217 1         3 my $changelog = $self->config('changelog_filename');
218 1         3 my ($version, @message);
219              
220 1         2 close ARGV; # reset <> iterator
221 1         2 local @ARGV = $changelog;
222 1         48 while (<>) {
223 9 100 100     72 last if @message and /^$VERSION_RE\s+/;
224 8 100       17 push @message, $_ if @message;
225 8 100 33     98 push @message, $_ and $version = $1 if /^$VERSION_RE\s+/;
226             }
227              
228 1 50       3 $self->abort("Could not find any changes in $changelog") unless @message;
229 1         8 $message[0] =~ s!.*?\n!Released version $version\n\n!s;
230 1         2 local $" = '';
231 1         10 return "@message";
232             }
233              
234             sub _c_objects {
235 0     0   0 my $self = shift;
236 0         0 my @files;
237              
238 0         0 for my $d (qw(.)) {
239             push @files,
240 0     0   0 path($d)->list->grep(sub {/\.c|\.xs/})->map(sub { $_->basename('.c', '.xs') . '.o' })->each;
  0         0  
  0         0  
241             }
242              
243 0         0 return @files;
244             }
245              
246             sub _dist_files {
247 2     2   361 my $self = shift;
248 2         7 my $name = $self->config('project_name') =~ s!::!-!gr;
249              
250 2     25   5 return path->list->grep(sub {m!\b$name.*\.tar!i});
  25         1127  
251             }
252              
253             sub _exe_files {
254 1     1   3 my $self = shift;
255 1         2 my @files;
256              
257 1         2 for my $d (qw(bin script)) {
258 2     1   60 push @files, path($d)->list->grep(sub {-x})->each;
  1         137  
259             }
260              
261 1         31 return @files;
262             }
263              
264             sub _include_mskip_file {
265 0     0     my ($self, $file) = @_;
266 0           my @lines;
267              
268 0   0       $file ||= do { require ExtUtils::Manifest; $ExtUtils::Manifest::DEFAULT_MSKIP; };
  0            
  0            
269              
270 0 0         unless (-r $file) {
271 0           warn "MANIFEST.SKIP included file '$file' not found - skipping\n";
272 0           return '';
273             }
274              
275 0           @lines = ("#!start included $file\n");
276 0           local @ARGV = ($file);
277 0           push @lines, $_ while <>;
278 0           return join "", @lines, "#!end included $file\n";
279             }
280              
281             sub _make {
282 0     0     my ($self, @args) = @_;
283              
284 0 0         $self->_render_makefile_pl unless -e 'Makefile.PL';
285 0 0         $self->system(perl => 'Makefile.PL') unless -e 'Makefile';
286 0           $self->system(make => @args);
287             }
288              
289             sub _render_makefile_pl {
290 0     0     my $self = shift;
291 0           my $prereqs = Module::CPANfile->load->prereqs;
292 0           my $args = {force => 1};
293 0           my $r;
294              
295 0           $args->{PREREQ_PM} = $prereqs->requirements_for(qw(runtime requires))->as_string_hash;
296 0           $r = $prereqs->requirements_for(qw(build requires))->as_string_hash;
297 0           $args->{BUILD_REQUIRES} = $r;
298 0           $r = $prereqs->requirements_for(qw(test requires))->as_string_hash;
299 0           $args->{TEST_REQUIRES} = $r;
300 0           $args->{CONTRIBUTORS} = [split /,\s*/, $self->config('contributors')];
301              
302 0           $self->render_template('Makefile.PL', $args);
303 0           $self->system(qw(perl -c Makefile.PL)); # test Makefile.PL
304             }
305              
306             sub _render_readme {
307 0     0     my $self = shift;
308 0           my $skip;
309              
310 0 0         if (-e 'README.md') {
    0          
311 0           my $re = "# NAME[\\n\\r\\s]+@{[$self->config('project_name')]}\\s-\\s";
  0            
312 0 0         $skip = path('README.md')->slurp =~ m!$re! ? undef : 'Custom README.md is in place';
313             }
314 0     0     elsif (my @alternative = path->list->grep(sub {/^README/i})->each) {
315 0           $skip = "@alternative exists.";
316             }
317              
318 0 0         if ($skip) {
319 0 0         say "# Will not generate README.md: $skip" unless $self->SILENT;
320 0           return;
321             }
322              
323 0 0         open my $README, '>:encoding(UTF-8)', 'README.md' or die "Write README.md: $!";
324 0           my $parser = Pod::Markdown->new;
325 0           $parser->output_fh($README);
326 0           $parser->parse_string_document(path($self->config('main_module_path'))->slurp);
327 0 0         say '# Generated README.md' unless $self->SILENT;
328             }
329              
330             sub _timestamp_to_changes {
331 0     0     my $self = shift;
332 0           my $changelog = $self->config('changelog_filename');
333 0           my $loc = setlocale(LC_TIME);
334 0           my $release_line;
335              
336             $release_line = sub {
337 0     0     my $v = shift;
338 0           my $str = $self->config('new_version_format');
339 0           $str =~ s!(%-?\d*)v!{ sprintf "${1}s", $v }!e;
  0            
  0            
340 0           setlocale LC_TIME, 'C';
341 0           $str = strftime $str, localtime;
342 0           setlocale LC_TIME, $loc;
343 0           return $str;
344 0           };
345              
346 0           local @ARGV = $changelog;
347 0           local $^I = '';
348 0           while (<>) {
349 0 0         $self->config(next_version => $1)
350 0           if s/^$VERSION_RE\x20*(?:Not Released)?\x20*([\r\n]+)/{ $release_line->($1) . $2 }/e;
  0            
351 0           print; # print back to same file
352             }
353              
354 0 0         say '# Building version ', $self->config('next_version') unless $self->SILENT;
355 0 0         $self->abort('Unable to add timestamp to ./%s', $changelog) unless $self->config('next_version');
356             }
357              
358             sub _update_changes {
359 0     0     my $self = shift;
360              
361 0 0         unless (eval "require CPAN::Changes; 1") {
362 0 0         say "# Cannot update './Changes' without CPAN::Changes. Install using 'cpanm CPAN::Changes'."
363             unless $self->SILENT;
364 0           return;
365             }
366              
367 0           my $changes = CPAN::Changes->load('Changes');
368 0           $changes->preamble(
369             'Revision history for perl distribution ' . ($self->config('project_name') =~ s!::!-!gr));
370 0           path('Changes')->spurt($changes->serialize);
371 0 0         say "# Generated Changes" unless $self->SILENT;
372             }
373              
374             sub _update_version_info {
375 0     0     my $self = shift;
376 0 0         my $version = $self->config('next_version')
377             or $self->abort('Internal error: Are you sure Changes has a timestamp?');
378              
379 0           local @ARGV = ($self->config('main_module_path'));
380 0           local $^I = '';
381 0           my %r;
382 0           while (<>) {
383 0 0 0       $r{pod} ||= s/$VERSION_RE/$version/ if /^=head1 VERSION/ .. $r{pod} && /^=(cut|head1)/ || eof;
      0        
384 0   0       $r{var} ||= s/((?:our)?\s*\$VERSION)\s*=.*/$1 = '$version';/;
385 0           print; # print back to same file
386             }
387              
388 0 0         $self->abort('Could not update VERSION in %s', $self->config('main_module_path')) unless $r{var};
389             }
390              
391             1;
392              
393             =encoding utf8
394              
395             =head1 NAME
396              
397             App::git::ship::perl - Ship your Perl module
398              
399             =head1 SYNOPSIS
400              
401             # Set up basic files for a Perl repo
402             # (Not needed if you already have an existing repo)
403             $ git ship start lib/My/Project.pm
404             $ git ship start
405              
406             # Make changes
407             $ $EDITOR lib/My/Project.pm
408              
409             # Build first if you want to investigate the changes
410             $ git ship build
411              
412             # Ship the project to git (and CPAN)
413             $ git ship ship
414              
415             =head1 DESCRIPTION
416              
417             L is a module that can ship your Perl module. This tool
418             differs from other tools like dzil by *NOT* requiring any configuration, except
419             for a file containing the credentials for uploading to CPAN.
420              
421             See also L.
422              
423             Example structure and how L works on your files:
424              
425             =over 4
426              
427             =item * my-app/cpanfile and my-app/Makefile.PL
428              
429             The C is used to build the "PREREQ_PM" and "BUILD_REQUIRES"
430             structures in the L based C build file.
431             The reason for this is that C is a more powerful format that can
432             be used by L and other tools, so generating C from
433             Makefile.PL would simply not be possible. Other data used to generate
434             Makefile.PL are:
435              
436             Note that the C is optional and C will be kept untouched
437             unless C exists.
438              
439             "NAME" and "LICENSE" will have values from L and
440             L. "AUTHOR" will have the name and email from
441             L or the last git committer. "ABSTRACT_FROM" and
442             "VERSION_FROM" are fetched from the L.
443             "EXE_FILES" will be the files in C and C