File Coverage

blib/lib/version.pm
Criterion Covered Total %
statement 60 63 95.2
branch 21 24 87.5
condition n/a
subroutine 10 10 100.0
pod n/a
total 91 97 93.8


line stmt bran cond sub pod time code
1             #!perl -w
2             package version;
3              
4 11     11   678983 use 5.006002;
  11         136  
5 11     11   65 use strict;
  11         19  
  11         362  
6 11     11   69 use warnings::register;
  11         19  
  11         3785  
7             if ($] >= 5.015) {
8             warnings::register_categories(qw/version/);
9             }
10              
11             our $VERSION = 0.99_26;
12             our $CLASS = 'version';
13             our (@ISA, $STRICT, $LAX);
14              
15             # !!!!Delete this next block completely when adding to Perl core!!!!
16             {
17             local $SIG{'__DIE__'};
18 11     11   4691 eval "use version::vxs $VERSION";
  11         200  
  11         190  
19             if ( $@ ) { # don't have the XS version installed
20             eval "use version::vpp $VERSION"; # don't tempt fate
21             die "$@" if ( $@ );
22             push @ISA, "version::vpp";
23             local $^W;
24             *version::qv = \&version::vpp::qv;
25             *version::declare = \&version::vpp::declare;
26             *version::_VERSION = \&version::vpp::_VERSION;
27             *version::vcmp = \&version::vpp::vcmp;
28             *version::new = \&version::vpp::new;
29             *version::numify = \&version::vpp::numify;
30             *version::normal = \&version::vpp::normal;
31             if ($] >= 5.009000) {
32 11     11   94 no strict 'refs';
  11         22  
  11         2043  
33             *version::stringify = \&version::vpp::stringify;
34             *{'version::(""'} = \&version::vpp::stringify;
35             *{'version::(<=>'} = \&version::vpp::vcmp;
36             *{'version::(cmp'} = \&version::vpp::vcmp;
37             *version::parse = \&version::vpp::parse;
38             }
39             }
40             else { # use XS module
41             push @ISA, "version::vxs";
42             local $^W;
43             *version::declare = \&version::vxs::declare;
44             *version::qv = \&version::vxs::qv;
45             *version::_VERSION = \&version::vxs::_VERSION;
46             *version::vcmp = \&version::vxs::VCMP;
47             *version::new = \&version::vxs::new;
48             *version::numify = \&version::vxs::numify;
49             *version::normal = \&version::vxs::normal;
50             if ($] >= 5.009000) {
51 11     11   73 no strict 'refs';
  11         20  
  11         2117  
52             *version::stringify = \&version::vxs::stringify;
53             *{'version::(""'} = \&version::vxs::stringify;
54             *{'version::(<=>'} = \&version::vxs::VCMP;
55             *{'version::(cmp'} = \&version::vxs::VCMP;
56             *version::parse = \&version::vxs::parse;
57             }
58             }
59             }
60              
61             # avoid using Exporter
62             require version::regex;
63             *version::is_lax = \&version::regex::is_lax;
64             *version::is_strict = \&version::regex::is_strict;
65             *LAX = \$version::regex::LAX;
66             *LAX_DECIMAL_VERSION = \$version::regex::LAX_DECIMAL_VERSION;
67             *LAX_DOTTED_DECIMAL_VERSION = \$version::regex::LAX_DOTTED_DECIMAL_VERSION;
68             *STRICT = \$version::regex::STRICT;
69             *STRICT_DECIMAL_VERSION = \$version::regex::STRICT_DECIMAL_VERSION;
70             *STRICT_DOTTED_DECIMAL_VERSION = \$version::regex::STRICT_DOTTED_DECIMAL_VERSION;
71              
72             sub import {
73 11     11   78 no strict 'refs';
  11         31  
  11         5098  
74 34     34   98257 my ($class) = shift;
75              
76             # Set up any derived class
77 34 100       143 unless ($class eq $CLASS) {
78 16         80 local $^W;
79 16         33 *{$class.'::declare'} = \&{$CLASS.'::declare'};
  16         106  
  16         79  
80 16         31 *{$class.'::qv'} = \&{$CLASS.'::qv'};
  16         74  
  16         47  
81             }
82              
83 34         79 my %args;
84 34 100       120 if (@_) { # any remaining terms are arguments
85 11         28 map { $args{$_} = 1 } @_
  22         73  
86             }
87             else { # no parameters at all on use line
88 23         98 %args =
89             (
90             qv => 1,
91             'UNIVERSAL::VERSION' => 1,
92             );
93             }
94              
95 34         96 my $callpkg = caller();
96              
97 34 100       128 if (exists($args{declare})) {
98 9         34 *{$callpkg.'::declare'} =
99 8     8   10173 sub {return $class->declare(shift) }
100 10 100       22 unless defined(&{$callpkg.'::declare'});
  10         74  
101             }
102              
103 34 100       111 if (exists($args{qv})) {
104 27         109 *{$callpkg.'::qv'} =
105 8     8   9847 sub {return $class->qv(shift) }
106 31 100       52 unless defined(&{$callpkg.'::qv'});
  31         243  
107             }
108              
109 34 100       104 if (exists($args{'UNIVERSAL::VERSION'})) {
110 23         97 local $^W;
111             *UNIVERSAL::VERSION
112 23         41 = \&{$CLASS.'::_VERSION'};
  23         110  
113             }
114              
115 34 50       109 if (exists($args{'VERSION'})) {
116 0         0 *{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'};
  0         0  
  0         0  
117             }
118              
119 34 100       107 if (exists($args{'is_strict'})) {
120 1         4 *{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'}
  1         3  
121 1 50       3 unless defined(&{$callpkg.'::is_strict'});
  1         4  
122             }
123              
124 34 100       39879 if (exists($args{'is_lax'})) {
125 1         5 *{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'}
  1         2  
126 1 50       2 unless defined(&{$callpkg.'::is_lax'});
  1         3  
127             }
128             }
129              
130              
131             1;