File Coverage

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


line stmt bran cond sub pod time code
1             package App::git::ship::perl;
2 5     5   308047 use Mojo::Base 'App::git::ship';
  5         862139  
  5         35  
3              
4 5     5   2560 use Module::CPANfile;
  5         71935  
  5         164  
5 5     5   34 use Mojo::File qw(path tempfile);
  5         9  
  5         259  
6 5     5   26 use Mojo::Util 'decode';
  5         12  
  5         187  
7 5     5   27 use POSIX qw(setlocale strftime LC_TIME);
  5         10  
  5         40  
8 5     5   3103 use Pod::Markdown;
  5         72629  
  5         210  
9              
10 5   50 5   37 use constant DEBUG => $ENV{GIT_SHIP_DEBUG} || 0;
  5         11  
  5         20273  
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 9 my ($class, $file) = @_;
38 1 0       3 return $file =~ /\.pm$/ ? 1 : 0 if $file;
    50          
39 1     2   6 return path('lib')->list_tree->grep(sub {/\.pm$/})->size;
  2         631  
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   4 (grep {-w} qw(CHANGELOG.md Changes))[0] || 'Changes';
  2         32  
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   4 my $self = shift;
185 3 50       8 return path($ENV{GIT_SHIP_MAIN_MODULE_PATH}) if $ENV{GIT_SHIP_MAIN_MODULE_PATH};
186              
187 3         7 my @project_name = split /-/, path->basename;
188 3         178 my $path = path 'lib';
189              
190             PATH_PART:
191 3         31 for my $p (@project_name) {
192 9 50       46 opendir my $DH, $path or $self->abort("Cannot find project name from $path: $!");
193              
194 9         350 for (sort { length $b <=> length $a } readdir $DH) {
  30         51  
195 9         16 my $f = "$_";
196 9         22 s!\.pm$!!;
197 9 50       21 next unless lc eq lc $p;
198 9         24 $path = path $path, $f;
199 9 100       248 last PATH_PART unless -d $path;
200 6         156 next PATH_PART;
201             }
202             }
203              
204 3         80 return $path;
205             }
206              
207             sub _build_config_param_project_name {
208 3     3   5 my $self = shift;
209 3         4 my @name = @{path($self->config('main_module_path'))};
  3         7  
210 3 50       85 shift @name if $name[0] eq 'lib';
211 3         11 $name[-1] =~ s!\.pm$!!;
212 3         16 return join '::', @name;
213             }
214              
215             sub _changes_to_commit_message {
216 1     1   570 my $self = shift;
217 1         3 my $changelog = $self->config('changelog_filename');
218 1         2 my ($version, @message);
219              
220 1         2 close ARGV; # reset <> iterator
221 1         3 local @ARGV = $changelog;
222 1         47 while (<>) {
223 7 100 100     86 last if @message and /^$VERSION_RE\s+/;
224 6 100       15 push @message, $_ if @message;
225 6 100 33     97 push @message, $_ and $version = $1 if /^$VERSION_RE\s+/;
226             }
227              
228 1 50       4 $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         3 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   371 my $self = shift;
248 2         7 my $name = $self->config('project_name') =~ s!::!-!gr;
249              
250 2     25   6 return path->list->grep(sub {m!\b$name.*\.tar!i});
  25         1108  
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   74 push @files, path($d)->list->grep(sub {-x})->each;
  1         130  
259             }
260              
261 1         30 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->{RECOMMENDS} = $prereqs->requirements_for(qw(runtime recommends))->as_string_hash;
301 0           $args->{CONTRIBUTORS} = [split /,\s*/, $self->config('contributors')];
302              
303 0           $self->render_template('Makefile.PL', $args);
304 0           $self->system(qw(perl -c Makefile.PL)); # test Makefile.PL
305             }
306              
307             sub _render_readme {
308 0     0     my $self = shift;
309 0           my $skip;
310              
311 0 0         if (-e 'README.md') {
    0          
312 0           my $re = "# NAME[\\n\\r\\s]+@{[$self->config('project_name')]}\\s-\\s";
  0            
313 0 0         $skip = path('README.md')->slurp =~ m!$re! ? undef : 'Custom README.md is in place';
314             }
315 0     0     elsif (my @alternative = path->list->grep(sub {/^README/i})->each) {
316 0           $skip = "@alternative exists.";
317             }
318              
319 0 0         if ($skip) {
320 0 0         say "# Will not generate README.md: $skip" unless $self->SILENT;
321 0           return;
322             }
323              
324 0 0         open my $README, '>:encoding(UTF-8)', 'README.md' or die "Write README.md: $!";
325 0           my $parser = Pod::Markdown->new;
326 0           $parser->output_fh($README);
327 0           $parser->parse_string_document(path($self->config('main_module_path'))->slurp);
328 0 0         say '# Generated README.md' unless $self->SILENT;
329             }
330              
331             sub _timestamp_to_changes {
332 0     0     my $self = shift;
333 0           my $changelog = $self->config('changelog_filename');
334 0           my $loc = setlocale(LC_TIME);
335 0           my $release_line;
336              
337             $release_line = sub {
338 0     0     my $v = shift;
339 0           my $str = $self->config('new_version_format');
340 0           $str =~ s!(%-?\d*)v!{ sprintf "${1}s", $v }!e;
  0            
  0            
341 0           setlocale LC_TIME, 'C';
342 0           $str = strftime $str, localtime;
343 0           setlocale LC_TIME, $loc;
344 0           return $str;
345 0           };
346              
347 0           local @ARGV = $changelog;
348 0           local $^I = '';
349 0           while (<>) {
350 0 0         $self->config(next_version => $1)
351 0           if s/^$VERSION_RE\x20*(?:Not Released)?\x20*([\r\n]+)/{ $release_line->($1) . $2 }/e;
  0            
352 0           print; # print back to same file
353             }
354              
355 0 0         say '# Building version ', $self->config('next_version') unless $self->SILENT;
356 0 0         $self->abort('Unable to add timestamp to ./%s', $changelog) unless $self->config('next_version');
357             }
358              
359             sub _update_changes {
360 0     0     my $self = shift;
361              
362 0 0         unless (eval "require CPAN::Changes; 1") {
363 0 0         say "# Cannot update './Changes' without CPAN::Changes. Install using 'cpanm CPAN::Changes'."
364             unless $self->SILENT;
365 0           return;
366             }
367              
368 0           my $changes = CPAN::Changes->load('Changes');
369 0           $changes->preamble(
370             'Revision history for perl distribution ' . ($self->config('project_name') =~ s!::!-!gr));
371 0           path('Changes')->spurt($changes->serialize);
372 0 0         say "# Generated Changes" unless $self->SILENT;
373             }
374              
375             sub _update_version_info {
376 0     0     my $self = shift;
377 0 0         my $version = $self->config('next_version')
378             or $self->abort('Internal error: Are you sure Changes has a timestamp?');
379              
380 0           local @ARGV = ($self->config('main_module_path'));
381 0           local $^I = '';
382 0           my %r;
383 0           while (<>) {
384 0 0 0       $r{pod} ||= s/$VERSION_RE/$version/ if /^=head1 VERSION/ .. $r{pod} && /^=(cut|head1)/ || eof;
      0        
385 0   0       $r{var} ||= s/((?:our)?\s*\$VERSION)\s*=.*/$1 = '$version';/;
386 0           print; # print back to same file
387             }
388              
389 0 0         $self->abort('Could not update VERSION in %s', $self->config('main_module_path')) unless $r{var};
390             }
391              
392             1;
393              
394             =encoding utf8
395              
396             =head1 NAME
397              
398             App::git::ship::perl - Ship your Perl module
399              
400             =head1 SYNOPSIS
401              
402             # Set up basic files for a Perl repo
403             # (Not needed if you already have an existing repo)
404             $ git ship start lib/My/Project.pm
405             $ git ship start
406              
407             # Make changes
408             $ $EDITOR lib/My/Project.pm
409              
410             # Build first if you want to investigate the changes
411             $ git ship build
412              
413             # Ship the project to git (and CPAN)
414             $ git ship ship
415              
416             =head1 DESCRIPTION
417              
418             L is a module that can ship your Perl module. This tool
419             differs from other tools like dzil by *NOT* requiring any configuration, except
420             for a file containing the credentials for uploading to CPAN.
421              
422             See also L.
423              
424             Example structure and how L works on your files:
425              
426             =over 4
427              
428             =item * my-app/cpanfile and my-app/Makefile.PL
429              
430             The C is used to build the "PREREQ_PM" and "BUILD_REQUIRES"
431             structures in the L based C build file.
432             The reason for this is that C is a more powerful format that can
433             be used by L and other tools, so generating C from
434             Makefile.PL would simply not be possible. Other data used to generate
435             Makefile.PL are:
436              
437             Note that the C is optional and C will be kept untouched
438             unless C exists.
439              
440             "NAME" and "LICENSE" will have values from L and
441             L. "AUTHOR" will have the name and email from
442             L or the last git committer. "ABSTRACT_FROM" and
443             "VERSION_FROM" are fetched from the L.
444             "EXE_FILES" will be the files in C and C