line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package V; |
2
|
4
|
|
|
4
|
|
2824
|
use strict; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
141
|
|
3
|
|
|
|
|
|
|
|
4
|
4
|
|
|
4
|
|
20
|
use vars qw( $VERSION $NO_EXIT ); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
4249
|
|
5
|
|
|
|
|
|
|
$VERSION = '0.15'; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
$NO_EXIT ||= 0; # prevent import() from exit()ing and fall of the edge |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 NAME |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
V - Print version of the specified module(s). |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 SYNOPSIS |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
$ perl -MV=V |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
or if you want more than one |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
$ perl -MV=CPAN,V |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
Can now also be used as a light-weight module for getting versions of |
22
|
|
|
|
|
|
|
modules without loading them: |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
require V; |
25
|
|
|
|
|
|
|
printf "%s has version '%s'\n", "V", V::get_version( "V" ); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
If you want all available files/versions from C<@INC>: |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
require V; |
30
|
|
|
|
|
|
|
my @all_V = V::Module::Info->all_installed("V"); |
31
|
|
|
|
|
|
|
printf "%s:\n", $all_V[0]->name; |
32
|
|
|
|
|
|
|
printf "\t%-50s - %s\n", $_->file, $_->version |
33
|
|
|
|
|
|
|
for @all_V; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
Each element in that array isa C object with 3 attributes and a method: |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=over |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=item I B |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
The package name. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=item I B |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
Full filename with directory. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=item I B |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
The base directory (from C<@INC>) where the package-file was found. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=item I B |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
This method will look through the file to see if it can find a version |
54
|
|
|
|
|
|
|
assignment in the file and uses that determine the version. As of version |
55
|
|
|
|
|
|
|
0.13_01, all versions found are passed through the L module. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=back |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=head1 DESCRIPTION |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
This module uses stolen code from L to find the location |
62
|
|
|
|
|
|
|
and version of the specified module(s). It prints them and exit()s. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
It defines C and is based on an idea from Michael Schwern |
65
|
|
|
|
|
|
|
on the perl5-porters list. See the discussion: |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
https://www.nntp.perl.org/group/perl.perl5.porters/2002/01/msg51007.html |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head2 V::get_version($pkg) |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
Returns the version of the first available file for this package as found by |
72
|
|
|
|
|
|
|
following C<@INC>. |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head3 Arguments |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=over |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=item 1. $pkg |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
The name of the package for which one wants to know the version. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=back |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head3 Response |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
This C returns the version of the file that was first found |
87
|
|
|
|
|
|
|
for this package by following C<@INC> or C if no file was found. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=begin implementation |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=head2 report_pkg |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
This sub prints the results for a package. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head3 Arguments |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=over |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=item 1. $pkg |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
The name of the package that was probed for versions |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=item 2. @versions |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
An array of Module-objects with full path and version. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=back |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=end implementation |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=head1 AUTHOR |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
Abe Timmerman C<< >>. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
Copyright 2002-2006 Abe Timmerman, All Rights Reserved. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
120
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, |
123
|
|
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of |
124
|
|
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=cut |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub report_pkg($@) { |
129
|
1
|
|
|
1
|
1
|
2
|
my $pkg = shift; |
130
|
|
|
|
|
|
|
|
131
|
1
|
|
|
|
|
8
|
print "$pkg\n"; |
132
|
1
|
50
|
|
|
|
12
|
@_ or print "\tNot found\n"; |
133
|
1
|
|
|
|
|
3
|
for my $module ( @_ ) { |
134
|
2
|
|
50
|
|
|
41
|
printf "\t%s: %s\n", $module->file, $module->version || '?'; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
sub import { |
139
|
1
|
|
|
1
|
|
564
|
shift; |
140
|
1
|
50
|
|
|
|
4
|
@_ or push @_, 'V'; |
141
|
|
|
|
|
|
|
|
142
|
1
|
|
|
|
|
2
|
for my $pkg ( @_ ) { |
143
|
1
|
|
|
|
|
5
|
my @modules = V::Module::Info->all_installed( $pkg ); |
144
|
1
|
|
|
|
|
3
|
report_pkg $pkg, @modules; |
145
|
|
|
|
|
|
|
} |
146
|
1
|
50
|
|
|
|
5
|
exit() unless $NO_EXIT; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub get_version { |
150
|
3
|
|
|
3
|
1
|
3999
|
my( $pkg ) = @_; |
151
|
3
|
|
|
|
|
18
|
my( $first ) = V::Module::Info->all_installed( $pkg ); |
152
|
3
|
50
|
|
|
|
24
|
return $first ? $first->version : undef; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
caller or V->import( @ARGV ); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
1; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# Okay I did the AUTOLOAD() bit, but this is a Copy 'n Paste job. |
160
|
|
|
|
|
|
|
# Thank you Michael Schwern for Module::Info! This one is mostly that! |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
package V::Module::Info; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
require File::Spec; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub new_from_file { |
167
|
6
|
|
|
6
|
|
17
|
my($proto, $file) = @_; |
168
|
6
|
|
33
|
|
|
53
|
my($class) = ref $proto || $proto; |
169
|
|
|
|
|
|
|
|
170
|
6
|
50
|
|
|
|
92
|
return unless -r $file; |
171
|
|
|
|
|
|
|
|
172
|
6
|
|
|
|
|
25
|
my $self = {}; |
173
|
6
|
|
|
|
|
145
|
$self->{file} = File::Spec->rel2abs($file); |
174
|
6
|
|
|
|
|
32
|
$self->{dir} = ''; |
175
|
6
|
|
|
|
|
14
|
$self->{name} = ''; |
176
|
|
|
|
|
|
|
|
177
|
6
|
|
|
|
|
14
|
return bless $self, $class; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub all_installed { |
181
|
4
|
|
|
4
|
|
9
|
my($proto, $name, @inc) = @_; |
182
|
4
|
|
33
|
|
|
23
|
my($class) = ref $proto || $proto; |
183
|
|
|
|
|
|
|
|
184
|
4
|
50
|
|
|
|
22
|
@inc = @INC unless @inc; |
185
|
4
|
|
|
|
|
97
|
my $file = File::Spec->catfile(split m/::/, $name) . '.pm'; |
186
|
|
|
|
|
|
|
|
187
|
4
|
|
|
|
|
10
|
my @modules = (); |
188
|
4
|
|
|
|
|
10
|
foreach my $dir (@inc) { |
189
|
|
|
|
|
|
|
# Skip the new code ref in @INC feature. |
190
|
40
|
50
|
|
|
|
92
|
next if ref $dir; |
191
|
|
|
|
|
|
|
|
192
|
40
|
|
|
|
|
279
|
my $filename = File::Spec->catfile($dir, $file); |
193
|
40
|
100
|
|
|
|
788
|
if( -r $filename ) { |
194
|
6
|
|
|
|
|
24
|
my $module = $class->new_from_file($filename); |
195
|
6
|
|
|
|
|
61
|
$module->{dir} = File::Spec->rel2abs($dir); |
196
|
6
|
|
|
|
|
17
|
$module->{name} = $name; |
197
|
6
|
|
|
|
|
16
|
push @modules, $module; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
4
|
|
|
|
|
53
|
return @modules; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# Thieved from ExtUtils::MM_Unix 1.12603 |
205
|
|
|
|
|
|
|
sub version { |
206
|
5
|
|
|
5
|
|
10
|
my($self) = shift; |
207
|
|
|
|
|
|
|
|
208
|
5
|
|
|
|
|
26
|
my $parsefile = $self->file; |
209
|
|
|
|
|
|
|
|
210
|
5
|
|
|
|
|
20
|
local *MOD; |
211
|
5
|
50
|
|
|
|
207
|
open(MOD, $parsefile) or die $!; |
212
|
|
|
|
|
|
|
|
213
|
5
|
|
|
|
|
19
|
my $inpod = 0; |
214
|
5
|
|
|
|
|
7
|
my $result; |
215
|
5
|
|
|
|
|
9
|
local $_; |
216
|
5
|
|
|
|
|
143
|
while () { |
217
|
24
|
50
|
|
|
|
66
|
$inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; |
|
|
50
|
|
|
|
|
|
218
|
24
|
50
|
33
|
|
|
98
|
next if $inpod || /^\s*#/; |
219
|
|
|
|
|
|
|
|
220
|
24
|
|
|
|
|
37
|
chomp; |
221
|
24
|
100
|
|
|
|
134
|
next unless m/([\$*])(([\w\:\']*)\bVERSION)\b.*\=/; |
222
|
5
|
|
|
|
|
9
|
{ local($1, $2); ($_ = $_) = m/(.*)/; } # untaint |
|
5
|
|
|
|
|
24
|
|
|
5
|
|
|
|
|
26
|
|
223
|
5
|
|
|
|
|
27
|
my $eval = qq{ |
224
|
|
|
|
|
|
|
package V::Module::Info::_version; |
225
|
|
|
|
|
|
|
no strict; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
local $1$2; |
228
|
|
|
|
|
|
|
\$$2=undef; do { |
229
|
|
|
|
|
|
|
$_ |
230
|
|
|
|
|
|
|
}; \$$2 |
231
|
|
|
|
|
|
|
}; |
232
|
5
|
|
|
|
|
18
|
local $^W = 0; |
233
|
5
|
|
|
3
|
|
538
|
$result = eval($eval); |
|
3
|
|
|
1
|
|
22
|
|
|
3
|
|
|
1
|
|
5
|
|
|
3
|
|
|
|
|
168
|
|
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
36
|
|
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
90
|
|
234
|
5
|
50
|
|
|
|
18
|
warn "Could not eval '$eval' in $parsefile: $@" if $@; |
235
|
5
|
50
|
|
|
|
18
|
$result = "undef" unless defined $result; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# use the version modulue to deal with v-strings |
238
|
5
|
|
|
|
|
1492
|
require version; |
239
|
5
|
|
|
|
|
5868
|
$result = version->parse($result); |
240
|
5
|
|
|
|
|
20
|
last; |
241
|
|
|
|
|
|
|
} |
242
|
5
|
|
|
|
|
78
|
close MOD; |
243
|
5
|
|
|
|
|
99
|
return $result; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
sub accessor { |
247
|
7
|
|
|
7
|
|
11
|
my $self = shift; |
248
|
7
|
|
|
|
|
9
|
my $field = shift; |
249
|
|
|
|
|
|
|
|
250
|
7
|
50
|
|
|
|
16
|
$self->{ $field } = $_[0] if @_; |
251
|
7
|
|
|
|
|
19
|
return $self->{ $field }; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
sub AUTOLOAD { |
255
|
13
|
|
|
13
|
|
45
|
my( $self ) = @_; |
256
|
|
|
|
|
|
|
|
257
|
4
|
|
|
4
|
|
41
|
use vars qw( $AUTOLOAD ); |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
552
|
|
258
|
13
|
|
|
|
|
76
|
my( $method ) = $AUTOLOAD =~ m|.+::(.+)$|; |
259
|
|
|
|
|
|
|
|
260
|
13
|
100
|
|
|
|
116
|
if ( exists $self->{ $method } ) { |
261
|
7
|
|
|
|
|
18
|
splice @_, 1, 0, $method; |
262
|
7
|
|
|
|
|
27
|
goto &accessor; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
} |