File Coverage

blib/lib/Minilla/Release/BumpVersion.pm
Criterion Covered Total %
statement 26 72 36.1
branch 6 38 15.7
condition 0 3 0.0
subroutine 9 15 60.0
pod 0 7 0.0
total 41 135 30.3


line stmt bran cond sub pod time code
1             package Minilla::Release::BumpVersion;
2 2     2   70886 use strict;
  2         17  
  2         58  
3 2     2   10 use warnings;
  2         4  
  2         50  
4 2     2   20 use utf8;
  2         5  
  2         12  
5 2     2   875 use ExtUtils::MakeMaker qw(prompt);
  2         119091  
  2         139  
6              
7 2     2   464 use Minilla::Util qw(find_file require_optional cmd);
  2         8  
  2         173  
8 2     2   15 use Minilla::Logger;
  2         4  
  2         121  
9 2     2   567 use Module::BumpVersion;
  2         5  
  2         63  
10 2     2   14 use version ();
  2         4  
  2         1721  
11              
12             sub init {
13 0     0 0 0 require_optional(
14             'Module/BumpVersion.pm', 'Release engineering'
15             );
16 0         0 require_optional(
17             'Version/Next.pm', 'Release engineering'
18             );
19             }
20              
21             sub run {
22 0     0 0 0 my ($self, $project, $opts) = @_;
23              
24 0 0       0 if (my $ver = prompt("Next Release?", $self->default_new_version($project))) {
25             # Do not use is_strict. is_strict rejects '5.00_01' style.
26 0 0       0 if (!version::is_lax($ver)) {
27 0         0 errorf("Sorry, version '%s' is invalid. Stopping.\n", $ver);
28             }
29              
30 0         0 my $curr_ver = $project->metadata->version;
31 0 0       0 if (!check_version_compatibility($curr_ver, $ver)) {
32 0         0 my $msg = sprintf
33             "version: %s\n" .
34             "current: %s\n" .
35             "The version format doesn't match the current one.\n" .
36             "Continue the release with this version? [y/n]", $ver, $curr_ver;
37 0 0       0 if (prompt($msg) !~ /y/i) {
38 0         0 errorf("Stop the release due to version format mismatch\n");
39             }
40             }
41              
42 0         0 my @opts;
43 0         0 push @opts, '-set', $ver;
44 0 0       0 if ($opts->{dry_run}) {
45 0         0 push @opts, '-dryrun';
46             }
47 0 0       0 unless ($opts->{dry_run}) {
48 0         0 $self->bump_version($project, $ver);
49              
50             # clear old version information
51 0         0 $project->clear_metadata();
52 0         0 my $newver = $project->metadata->version;
53 0 0       0 if (exists_tag($project->format_tag($newver))) {
54 0         0 errorf("Sorry, version '%s' is already tagged. Stopping.\n", $newver);
55             }
56             }
57             }
58             }
59              
60             sub bump_version {
61 0     0 0 0 my ($self, $project, $version) = @_;
62              
63 0         0 for my $file ($project->perl_files) {
64 0 0       0 next if $file =~ /\.t$/;
65 0 0       0 next if $file =~ m{\Ashare/};
66              
67 0 0 0     0 next if $file eq 'Makefile.PL' || $file eq 'Build.PL';
68             # copy from Menlo::CLI::Compat
69 0 0       0 next if grep { $file =~ m!^$_/! } @{$project->no_index->{directory} || []};
  0 0       0  
  0         0  
70 0 0       0 next if grep { $file eq $_ } @{$project->no_index->{file} || []};
  0 0       0  
  0         0  
71              
72 0         0 my $bump = Module::BumpVersion->load($file);
73 0         0 $bump->set_version($version);
74             }
75             }
76              
77             sub default_new_version {
78 0     0 0 0 my ($self, $project) = @_;
79 0 0       0 @_==2 or die;
80              
81 0         0 my $curver = $project->metadata->version;
82 0 0       0 if (not exists_tag($project->format_tag($curver))) {
83 0         0 $curver;
84             } else {
85             # $project->metadata->version returns version.pm object.
86             # But stringify was needed by Version::Next.
87 0         0 return Version::Next::next_version("$curver");
88             }
89             }
90              
91             sub check_version_compatibility {
92 0     0 0 0 my ($curr, $next) = @_;
93              
94 0         0 return version_format($curr) eq version_format($next)
95             }
96              
97             sub version_format {
98 15     15 0 9667 local $_ = shift;
99             # All formats accept an optional alpha notation starting with '_'.
100             return
101             # ex. 0.11, 3.14, 9.4_1
102 15 100       147 /^(?:0|[1-9][0-9]*)\.[0-9]+(?:_[0-9]+)?$/ ? 'decimal' :
    100          
    100          
103             # ex. v1.2.3, v1.2.3_4, v3.3, v3.4_5
104             /^v(?:0|[1-9][0-9]*)(?:\.[0-9]+){1,2}(?:_[0-9]+)?$/ ? 'dotted' :
105             # ex. 0.1.2, 3.4.5_67 (to distinguish it from the decimal version, it must have exactly two dots)
106             /^(?:0|[1-9][0-9]*)(?:\.[0-9]+){2}(?:_[0-9]+)?$/ ? 'lax dotted' :
107             'unknown';
108             }
109              
110             sub exists_tag {
111 0     0 0   my ( $tag ) = @_;
112              
113 0           my $x = `git tag -l $tag`;
114 0           chomp $x;
115 0           return !!$x;
116             }
117              
118             1;