blob: f8afd8435b06ad949992afa5bd6354a92b40710b (
plain)
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
|
#!perl -w
package version;
use 5.006002;
use strict;
use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
$VERSION = 0.9909;
$CLASS = 'version';
# avoid using Exporter
require version::regex;
*version::is_lax = \&version::regex::is_lax;
*version::is_strict = \&version::regex::is_strict;
*LAX = \$version::regex::LAX;
*STRICT = \$version::regex::STRICT;
sub import {
no strict 'refs';
my ($class) = shift;
# Set up any derived class
unless ($class eq $CLASS) {
local $^W;
*{$class.'::declare'} = \&{$CLASS.'::declare'};
*{$class.'::qv'} = \&{$CLASS.'::qv'};
}
my %args;
if (@_) { # any remaining terms are arguments
map { $args{$_} = 1 } @_
}
else { # no parameters at all on use line
%args =
(
qv => 1,
'UNIVERSAL::VERSION' => 1,
);
}
my $callpkg = caller();
if (exists($args{declare})) {
*{$callpkg.'::declare'} =
sub {return $class->declare(shift) }
unless defined(&{$callpkg.'::declare'});
}
if (exists($args{qv})) {
*{$callpkg.'::qv'} =
sub {return $class->qv(shift) }
unless defined(&{$callpkg.'::qv'});
}
if (exists($args{'UNIVERSAL::VERSION'})) {
local $^W;
*UNIVERSAL::VERSION
= \&{$CLASS.'::_VERSION'};
}
if (exists($args{'VERSION'})) {
*{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'};
}
if (exists($args{'is_strict'})) {
*{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'}
unless defined(&{$callpkg.'::is_strict'});
}
if (exists($args{'is_lax'})) {
*{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'}
unless defined(&{$callpkg.'::is_lax'});
}
}
1;
|
