This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldelta.pod: tweak -Dusedefaultstrict text
[perl5.git] / cpan / version / lib / version.pm
1 #!perl -w
2 package version;
3
4 use 5.006002;
5 use strict;
6 use warnings::register;
7 if ($] >= 5.015) {
8     warnings::register_categories(qw/version/);
9 }
10
11 our $VERSION = 0.9928;
12 our $CLASS = 'version';
13 our (@ISA, $STRICT, $LAX);
14
15 # avoid using Exporter
16 require version::regex;
17 *version::is_lax = \&version::regex::is_lax;
18 *version::is_strict = \&version::regex::is_strict;
19 *LAX = \$version::regex::LAX;
20 *LAX_DECIMAL_VERSION = \$version::regex::LAX_DECIMAL_VERSION;
21 *LAX_DOTTED_DECIMAL_VERSION = \$version::regex::LAX_DOTTED_DECIMAL_VERSION;
22 *STRICT = \$version::regex::STRICT;
23 *STRICT_DECIMAL_VERSION = \$version::regex::STRICT_DECIMAL_VERSION;
24 *STRICT_DOTTED_DECIMAL_VERSION = \$version::regex::STRICT_DOTTED_DECIMAL_VERSION;
25
26 sub import {
27     no strict 'refs';
28     my ($class) = shift;
29
30     # Set up any derived class
31     unless ($class eq $CLASS) {
32         local $^W;
33         *{$class.'::declare'} =  \&{$CLASS.'::declare'};
34         *{$class.'::qv'} = \&{$CLASS.'::qv'};
35     }
36
37     my %args;
38     if (@_) { # any remaining terms are arguments
39         map { $args{$_} = 1 } @_
40     }
41     else { # no parameters at all on use line
42         %args =
43         (
44             qv => 1,
45             'UNIVERSAL::VERSION' => 1,
46         );
47     }
48
49     my $callpkg = caller();
50
51     if (exists($args{declare})) {
52         *{$callpkg.'::declare'} =
53             sub {return $class->declare(shift) }
54           unless defined(&{$callpkg.'::declare'});
55     }
56
57     if (exists($args{qv})) {
58         *{$callpkg.'::qv'} =
59             sub {return $class->qv(shift) }
60           unless defined(&{$callpkg.'::qv'});
61     }
62
63     if (exists($args{'UNIVERSAL::VERSION'})) {
64         local $^W;
65         *UNIVERSAL::VERSION
66                 = \&{$CLASS.'::_VERSION'};
67     }
68
69     if (exists($args{'VERSION'})) {
70         *{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'};
71     }
72
73     if (exists($args{'is_strict'})) {
74         *{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'}
75           unless defined(&{$callpkg.'::is_strict'});
76     }
77
78     if (exists($args{'is_lax'})) {
79         *{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'}
80           unless defined(&{$callpkg.'::is_lax'});
81     }
82 }
83
84
85 1;