1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
require v5.10;
package Module::Extract::VERSION;
use strict;
use warnings;
no warnings;
use Carp qw(carp);
our $VERSION = '1.119';
=encoding utf8
=head1 NAME
Module::Extract::VERSION - Extract a module version safely
=head1 SYNOPSIS
use Module::Extract::VERSION;
my $version # just the version
= Module::Extract::VERSION->parse_version_safely( $file );
my @version_info # extra info
= Module::Extract::VERSION->parse_version_safely( $file );
=head1 DESCRIPTION
This module lets you pull out of module source code the version number
for the module. It assumes that there is only one C<$VERSION>
in the file and the entire C<$VERSION> statement is on the same line.
=cut
=head2 Class methods
=over 4
=item $class->parse_version_safely( FILE );
Given a module file, return the module version. This works just like
C<mldistwatch> in PAUSE. It looks for the single line that has the
C<$VERSION> statement, extracts it, evals it in a Safe compartment,
and returns the result.
In scalar context, it returns just the version as a string. In list
context, it returns the list of:
sigil
fully-qualified variable name
version value
file name
line number of $VERSION
=cut
sub parse_version_safely { # stolen from PAUSE's mldistwatch, but refactored
my( $class, $file ) = @_;
local $/ = "\n";
local $_; # don't mess with the $_ in the map calling this
my $fh;
unless( open $fh, "<", $file ) {
carp( "Could not open file [$file]: $!\n" );
return;
}
my $in_pod = 0;
my( $sigil, $var, $version, $line_number, $rhs );
while( <$fh> ) {
$line_number++;
chomp;
$in_pod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $in_pod;
next if $in_pod || /^\s*#/;
# package NAMESPACE VERSION <-- we handle that
# package NAMESPACE VERSION BLOCK
next unless /
(?<sigil>
[\$*]
)
(?<var>
(?<package>
[\w\:\']*
)
\b
VERSION
)
\b
.*?
\=
(?<rhs>
.*
)
/x ||
m/
\b package \s+
(?<package> \w[\w\:\']* ) \s+
(?<rhs> \S+ ) \s* [;{]
/x;
( $sigil, $var, $rhs ) = @+{ qw(sigil var rhs) };
if ($sigil) {
$version = $class->_eval_version( $_, @+{ qw(sigil var rhs) } );
}
else {
$version = $class->_eval_version( $_, '$', 'VERSION', qq('$rhs') );
}
last;
}
$line_number = undef if eof($fh) && ! defined( $version );
close $fh;
return wantarray ?
( $sigil, $var, $version, $file, $line_number )
:
$version;
}
sub _eval_version {
my( $class, $line, $sigil, $var, $rhs ) = @_;
require Safe;
require version;
local $^W = 0;
my $s = Safe->new;
if (defined $Devel::Cover::VERSION) {
$s->share_from('main', ['&Devel::Cover::use_file']);
}
$s->reval('$VERSION = ' . $rhs);
my $version = $s->reval('$VERSION');
return $version;
}
=back
=head1 SOURCE AVAILABILITY
This code is in Github:
https://github.com/briandfoy/module-extract-version.git
=head1 AUTHOR
brian d foy, C<< <briandfoy@pobox.com> >>
I stole the some of this code from C<mldistwatch> in the PAUSE
code by Andreas König, but I've moved most of it around.
Andrey Starodubtsev added code to handle the v5.12 and v5.14
C<package> syntax.
=head1 COPYRIGHT AND LICENSE
Copyright © 2008-2025, brian d foy C<< <briandfoy@pobox.com> >>. All rights reserved.
You may redistribute this under the Artistic License 2.0.
=cut
1;
|
