line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PPI::App::ppi_version::BDFOY; |
2
|
2
|
|
|
2
|
|
2547
|
use parent qw(PPI::App::ppi_version); |
|
2
|
|
|
|
|
610
|
|
|
2
|
|
|
|
|
10
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
=encoding utf8 |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
PPI::App::ppi_version::BDFOY - brian d foy's rip off of Adam's ppi_version |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 SYNOPSIS |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# call it like PPI::App::ppi_version |
13
|
|
|
|
|
|
|
% ppi_version show |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
% ppi_version change 1.23 1.24 |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# call it with less typing. With no arguments, it assumes 'show'. |
18
|
|
|
|
|
|
|
% ppi_version show |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# with arguments that are not 'show' or 'change', assume 'change' |
21
|
|
|
|
|
|
|
% ppi_version 1.23 1.24 |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 DESCRIPTION |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
I like what PPI::App::Version does, mostly, but I had to be different. |
26
|
|
|
|
|
|
|
Life would just be easier if Adam did things my way from the start. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=cut |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head2 Methods |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=over 4 |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=cut |
35
|
|
|
|
|
|
|
|
36
|
2
|
|
|
2
|
|
291670
|
use 5.008; |
|
2
|
|
|
|
|
8
|
|
37
|
2
|
|
|
2
|
|
15
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
58
|
|
38
|
2
|
|
|
2
|
|
12
|
use version; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
16
|
|
39
|
2
|
|
|
2
|
|
152
|
use File::Spec (); |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
29
|
|
40
|
2
|
|
|
2
|
|
12
|
use PPI::Document (); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
24
|
|
41
|
2
|
|
|
2
|
|
10
|
use File::Find::Rule (); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
26
|
|
42
|
2
|
|
|
2
|
|
9
|
use File::Find::Rule::Perl (); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
30
|
|
43
|
2
|
|
|
2
|
|
1451
|
use Term::ANSIColor; |
|
2
|
|
|
|
|
18796
|
|
|
2
|
|
|
|
|
265
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
our $VERSION = '0.142'; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
##################################################################### |
48
|
|
|
|
|
|
|
# Main Methods |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=item main |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=cut |
53
|
|
|
|
|
|
|
|
54
|
0
|
|
|
|
|
0
|
BEGIN { |
55
|
2
|
|
|
2
|
|
8
|
my %commands = map { $_, 1 } qw( show change ); |
|
4
|
|
|
|
|
2562
|
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub main { |
58
|
0
|
|
|
0
|
1
|
0
|
my( $class, @args ) = @_; |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
0
|
my $command = do { |
61
|
2
|
|
|
2
|
|
17
|
no warnings 'uninitialized'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
182
|
|
62
|
0
|
0
|
|
|
|
0
|
if( exists $commands{ $args[0] } ) { shift @args } |
|
0
|
0
|
|
|
|
0
|
|
63
|
0
|
|
|
|
|
0
|
elsif( @args == 0 ) { 'show' } |
64
|
0
|
|
|
|
|
0
|
else { 'change' } |
65
|
|
|
|
|
|
|
}; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
|
|
0
|
$class->$command( @args ); |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=item print_my_version |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=cut |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub print_my_version { |
77
|
0
|
|
|
0
|
1
|
0
|
print "brian's ppi_version $VERSION - Copright 2009 brian d foy\n"; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=item print_file_report |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=cut |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub print_file_report { |
85
|
0
|
|
|
0
|
1
|
0
|
my $class = shift; |
86
|
0
|
|
|
|
|
0
|
my( $file, $version, $message, $error ) = @_; |
87
|
|
|
|
|
|
|
|
88
|
0
|
0
|
|
|
|
0
|
if( defined $version ) { |
|
|
0
|
|
|
|
|
|
89
|
0
|
|
|
|
|
0
|
$class->print_info( |
90
|
|
|
|
|
|
|
colored( ['green'], $version ), |
91
|
|
|
|
|
|
|
" $file" ); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
elsif( $error ) { |
94
|
0
|
|
|
|
|
0
|
$class->print_info( "$file... ", colored ['red'], $message ); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
else { |
97
|
0
|
|
|
|
|
0
|
$class->print_info( "$file... ", $message ); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=item print_info |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=cut |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub print_info { |
106
|
0
|
|
|
0
|
1
|
0
|
my $class = shift; |
107
|
|
|
|
|
|
|
|
108
|
0
|
|
|
|
|
0
|
print @_, "\n"; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=item get_file_list |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=cut |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub get_file_list { |
116
|
0
|
|
|
0
|
1
|
0
|
my( $class, $dir ) = @_; |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
0
|
|
|
0
|
my @files = grep { ! /\bblib\b/ } File::Find::Rule->perl_file |
|
0
|
|
|
|
|
0
|
|
119
|
|
|
|
|
|
|
->in( $dir || File::Spec->curdir ); |
120
|
|
|
|
|
|
|
|
121
|
0
|
|
|
|
|
0
|
print "Found " . scalar(@files) . " file(s)\n"; |
122
|
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
0
|
return \@files; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=item show |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=cut |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub show { |
131
|
0
|
|
|
0
|
1
|
0
|
my $class = shift; |
132
|
|
|
|
|
|
|
|
133
|
0
|
|
|
|
|
0
|
my @args = @_; |
134
|
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
0
|
my $files = $class->get_file_list( $args[0] ); |
136
|
|
|
|
|
|
|
|
137
|
0
|
|
|
|
|
0
|
my $count = 0; |
138
|
0
|
|
|
|
|
0
|
foreach my $file ( @$files ) { |
139
|
0
|
|
|
|
|
0
|
my( $version, $message, $error_flag ) = $class->get_version( $file ); |
140
|
0
|
|
|
|
|
0
|
$class->print_file_report( $file, $version, $message, $error_flag ); |
141
|
0
|
0
|
|
|
|
0
|
$count++ if defined $version; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
0
|
$class->print_info( "Found $count versions" ); |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=item get_version |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=cut |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub get_version { |
152
|
2
|
|
|
2
|
1
|
7375
|
my( $class, $file ) = @_; |
153
|
|
|
|
|
|
|
|
154
|
2
|
|
|
|
|
16
|
my $Document = PPI::Document->new( $file ); |
155
|
|
|
|
|
|
|
|
156
|
2
|
50
|
|
|
|
55580
|
return ( undef, " failed to parse file", 1 ) unless $Document; |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# Does the document contain a simple version number |
159
|
|
|
|
|
|
|
my $elements = $Document->find( sub { |
160
|
|
|
|
|
|
|
# Find a $VERSION symbol |
161
|
500
|
100
|
|
500
|
|
5643
|
$_[1]->isa('PPI::Token::Symbol') or return ''; |
162
|
30
|
100
|
|
|
|
79
|
$_[1]->content =~ m/^\$(?:\w+::)*VERSION$/ or return ''; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# It is the first thing in the statement |
165
|
2
|
100
|
|
|
|
49
|
if( my $sib = $_[1]->sprevious_sibling ) { |
166
|
1
|
50
|
|
|
|
63
|
return 1 if $sib->content eq 'our'; |
167
|
0
|
|
|
|
|
0
|
return ''; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# Followed by an "equals" |
171
|
1
|
50
|
|
|
|
33
|
my $equals = $_[1]->snext_sibling or return ''; |
172
|
1
|
50
|
|
|
|
30
|
$equals->isa('PPI::Token::Operator') or return ''; |
173
|
1
|
50
|
|
|
|
5
|
$equals->content eq '=' or return ''; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# Followed by a quote |
176
|
1
|
50
|
|
|
|
8
|
my $quote = $equals->snext_sibling or return ''; |
177
|
1
|
50
|
|
|
|
26
|
$quote->isa('PPI::Token::Quote') or return ''; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# ... which is EITHER the end of the statement |
180
|
1
|
50
|
|
|
|
14
|
my $next = $quote->snext_sibling or return 1; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# ... or is a statement terminator |
183
|
1
|
50
|
|
|
|
26
|
$next->isa('PPI::Token::Structure') or return ''; |
184
|
1
|
50
|
|
|
|
3
|
$next->content eq ';' or return ''; |
185
|
|
|
|
|
|
|
|
186
|
1
|
|
|
|
|
6
|
return 1; |
187
|
2
|
|
|
|
|
21
|
} ); |
188
|
|
|
|
|
|
|
|
189
|
2
|
50
|
|
|
|
41
|
return ( undef, "no version", 0 ) unless $elements; |
190
|
|
|
|
|
|
|
|
191
|
2
|
50
|
|
|
|
33
|
if ( @$elements > 1 ) { |
192
|
0
|
|
|
|
|
0
|
$class->error("$file contains more than one \$VERSION = 'something';"); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
2
|
|
|
|
|
7
|
my $element = $elements->[0]; |
196
|
2
|
|
|
|
|
14
|
my $version = $element->snext_sibling->snext_sibling; |
197
|
2
|
|
|
|
|
104
|
my $version_string = $version->string; |
198
|
|
|
|
|
|
|
|
199
|
2
|
50
|
|
|
|
20
|
$class->error("Failed to get version string") |
200
|
|
|
|
|
|
|
unless defined $version_string; |
201
|
|
|
|
|
|
|
|
202
|
2
|
|
|
|
|
13
|
return ( $version_string, undef, undef ); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=item change |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=cut |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub change { |
210
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
|
my $from = shift @_; |
213
|
|
|
|
|
|
|
|
214
|
0
|
0
|
0
|
|
|
|
unless ( $from and $from =~ /^[\d\._]+$/ ) { |
215
|
0
|
|
|
|
|
|
$class->error("From version is not a number [$from]"); |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
0
|
|
|
|
|
|
my $to = shift @_; |
219
|
0
|
0
|
0
|
|
|
|
unless ( $to and $to =~ /^[\d\._]+$/ ) { |
220
|
0
|
|
|
|
|
|
$class->error("Target to version is not a number [$to]"); |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# Find all modules and scripts below the current directory |
224
|
0
|
|
|
|
|
|
my $files = $class->get_file_list; |
225
|
|
|
|
|
|
|
|
226
|
0
|
|
|
|
|
|
my $count = 0; |
227
|
0
|
|
|
|
|
|
foreach my $file ( @$files ) { |
228
|
0
|
0
|
|
|
|
|
if ( ! -w $file ) { |
229
|
0
|
|
|
|
|
|
$class->print_info( colored ['bold red'], " no write permission" ); |
230
|
0
|
|
|
|
|
|
next; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
0
|
|
|
|
|
|
my $rv = $class->changefile( $file, $from, $to ); |
234
|
|
|
|
|
|
|
|
235
|
0
|
0
|
|
|
|
|
if ( $rv ) { |
|
|
0
|
|
|
|
|
|
236
|
0
|
|
|
|
|
|
$class->print_info( |
237
|
|
|
|
|
|
|
colored( ['cyan'], $from ), |
238
|
|
|
|
|
|
|
" -> ", |
239
|
|
|
|
|
|
|
colored( ['bold green'], $to ), |
240
|
|
|
|
|
|
|
" $file" |
241
|
|
|
|
|
|
|
); |
242
|
0
|
|
|
|
|
|
$count++; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
elsif ( defined $rv ) { |
245
|
0
|
|
|
|
|
|
$class->print_info( colored( ['red'], " skipped" ), " $file" ); |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
else { |
248
|
0
|
|
|
|
|
|
$class->print_info( colored( ['red'], " failed to parse" ), " $file" ); |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
0
|
|
|
|
|
|
$class->print_info( "Updated " . scalar($count) . " file(s)" ); |
253
|
0
|
|
|
|
|
|
$class->print_info( "Done." ); |
254
|
0
|
|
|
|
|
|
return 0; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=item changefile |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=cut |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
sub changefile { |
262
|
0
|
|
|
0
|
1
|
|
my( $self, $file, $from, $to ) = @_; |
263
|
|
|
|
|
|
|
|
264
|
0
|
|
|
|
|
|
my $document = eval { PPI::Document->new($file) }; |
|
0
|
|
|
|
|
|
|
265
|
0
|
0
|
|
|
|
|
unless( $document ) { |
266
|
0
|
|
|
|
|
|
error( "Could not parse $file!" ); |
267
|
0
|
|
|
|
|
|
return ''; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
0
|
|
|
|
|
|
my $rv = PPI::App::ppi_version::_change_document( $document, $from => $to ); |
271
|
|
|
|
|
|
|
|
272
|
0
|
0
|
|
|
|
|
error("$file contains more than one \$VERSION assignment") unless defined $rv; |
273
|
|
|
|
|
|
|
|
274
|
0
|
0
|
|
|
|
|
return '' unless $rv; |
275
|
|
|
|
|
|
|
|
276
|
0
|
0
|
|
|
|
|
error("PPI::Document save failed") unless $document->save($file); |
277
|
|
|
|
|
|
|
|
278
|
0
|
|
|
|
|
|
return 1; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=item error |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=cut |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
sub error { |
286
|
2
|
|
|
2
|
|
19
|
no warnings 'uninitialized'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
209
|
|
287
|
0
|
|
|
0
|
1
|
|
print "\n", colored ['red'], " $_[1]\n\n"; |
288
|
0
|
|
|
|
|
|
return 255; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
1; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=back |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=head1 SOURCE AVAILABILITY |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
This source is part of a Github project: |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
https://github.com/briandfoy/ppi-app-ppi_version-bdfoy |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=head1 AUTHOR |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
Adam Kennedy wrote the original, and I stole some of the code. I even |
304
|
|
|
|
|
|
|
inherit from the original. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
brian d foy, C<< >> |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=head1 COPYRIGHT |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
Copyright © 2008-2021, brian d foy . All rights reserved. |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
You may redistribute this under the same terms as the Artistic License 2.0. |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=cut |