File Coverage

blib/lib/Module/BumpVersion.pm
Criterion Covered Total %
statement 9 76 11.8
branch 0 26 0.0
condition 0 9 0.0
subroutine 3 14 21.4
pod 0 9 0.0
total 12 134 8.9


line stmt bran cond sub pod time code
1             package Module::BumpVersion;
2 3     3   2419 use strict;
  3         7  
  3         91  
3 3     3   14 use warnings;
  3         5  
  3         77  
4 3     3   616 use utf8;
  3         19  
  3         19  
5              
6             sub load {
7 0     0 0   my ($class, $name) = @_;
8              
9 0           my $lines;
10             my $is_perl = sub {
11 0 0   0     return 1 if $name =~ m{ [.] (?i: pl | pm | t ) $ }x;
12 0           $lines = $class->read_file($name);
13 0 0 0       return 1 if @$lines && $lines->[0] =~ m{ ^ \#\! .* perl }ix;
14 0           return;
15 0           }->();
16 0   0       $lines ||= $class->read_file($name);
17 0 0         return unless $is_perl;
18 0 0         return unless $lines;
19              
20 0           bless {lines => $lines, name => $name}, $class;
21             }
22              
23             sub read_file {
24 0     0 0   my ($class, $name) = @_;
25 0 0         open my $fh, '<:raw', $name
26             or die "Cannot open '$name' for readding: $!";
27 0           my @ret = <$fh>;
28 0           close $fh;
29 0           return \@ret;
30             }
31              
32             sub set_version {
33 0     0 0   my ($self, $new_version) = @_;
34              
35 0           my $versions = $self->versions;
36 0           my @lines = @{$self->{lines}};
  0            
37 0           my $dirty;
38 0           for my $edits ( values %$versions ) {
39 0           for my $edit (@$edits) {
40             $lines[ $edit->{line} ] =
41 0           $edit->{pre} . $new_version . $edit->{post} . "\n";
42 0           $dirty++;
43             }
44             }
45 0 0         return unless $dirty;
46              
47             open my $fh, '>:raw', $self->{name}
48 0 0         or die "Cannot open '$self->{name}' for writing: $!";
49 0           print {$fh} $_ for @lines;
  0            
50 0           close $fh;
51             }
52              
53             sub find_version {
54 0     0 0   my $self = shift;
55 0           my ($version) = keys %{$self->versions};
  0            
56 0           return $version;
57             }
58              
59             sub versions {
60 0     0 0   my $self = shift;
61 0   0       $self->{versions} ||= $self->_find_version_for_doc();
62             }
63              
64             sub _find_version_for_doc {
65 0     0     my ( $self ) = @_;
66              
67 0           my $name = $self->{name};
68              
69 0           my $machine = $self->scanner();
70 0           my $state = $machine->{init};
71 0           my $lines = $self->{lines};
72 0           my $ver_found = {};
73              
74             LINE:
75 0           for my $ln ( 0 .. @$lines - 1 ) {
76 0           my $line = $lines->[$ln];
77              
78 0 0         next LINE if $line =~ /# No BumpVersion/;
79              
80             # Bail out when we're in a state with no possible actions.
81 0 0         last LINE unless @$state;
82              
83             STATE: {
84 0           for my $trans (@$state) {
  0            
85 0 0         if ( my @match = $line =~ $trans->{re} ) {
86 0 0         if ( $trans->{mark} ) {
87 0           my $ver = $2 . $3 . $4;
88 0           push @{ $ver_found->{ $ver } },
  0            
89             {
90             file => $name,
91             info => $self,
92             line => $ln,
93             pre => $1,
94             ver => $ver,
95             post => $5
96             };
97             }
98              
99 0 0         if ( my $code = $trans->{exec} ) {
100 0           $code->( $machine, \@match, $line );
101             }
102              
103 0 0         if ( my $goto = $trans->{goto} ) {
104 0           $state = $machine->{$goto};
105 0           redo STATE;
106             }
107             }
108             }
109             }
110             }
111 0           return $ver_found;
112             }
113              
114             sub version_re_perl {
115 0     0 0   my $ver_re = shift;
116              
117 0           return qr{ ^ ( .*? [\$\*] (?: \w+ (?: :: | ' ) )* VERSION \s* =
118             \D*? )
119             $ver_re
120             ( .* ) $ }x;
121             }
122              
123             sub version_re_pod {
124 0     0 0   my $ver_re = shift;
125 0           return qr{ ^ ( .*? (?i: version ) .*? ) $ver_re ( .* ) $ }x;
126             }
127              
128             sub version_re_package {
129 0     0 0   my $ver_re = shift;
130 0           return qr{ ^ ( package \s+ \S+ \s+ ) $ver_re (.*) $ }x;
131             }
132              
133             # State machine for Perl source
134             sub scanner{
135             # Perl::Version::REGEX
136 0     0 0   my $ver_re = qr/ ( (?i: Revision: \s+ ) | v | )
137             ( \d+ (?: [.] \d+)* )
138             ( (?: _ \d+ )? ) /x;
139              
140             {
141 0           init => [
142             {
143             re => qr{ ^ = (?! cut ) }x,
144             goto => 'pod',
145             },
146             {
147             re => version_re_perl($ver_re),
148             mark => 1,
149             },
150             {
151             re => version_re_package($ver_re),
152             mark => 1,
153             },
154             ],
155              
156             # pod within perl
157             pod => [
158             {
159             re => qr{ ^ =head\d\s+VERSION\b }x,
160             goto => 'version',
161             },
162             {
163             re => qr{ ^ =cut }x,
164             goto => 'init',
165             },
166             ],
167              
168             # version section within pod
169             version => [
170             {
171             re => qr{ ^ = (?! head\d\s+VERSION\b ) }x,
172             goto => 'pod',
173             },
174             {
175             re => version_re_pod($ver_re),
176             mark => 1,
177             },
178              
179             ],
180             };
181             }
182              
183              
184             1;