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   699638 use 5.006002;
  11         141  
5 11     11   59 use strict;
  11         24  
  11         330  
6 11     11   57 use warnings::register;
  11         20  
  11         4026  
7             if ($] >= 5.015) {
8             warnings::register_categories(qw/version/);
9             }
10              
11             our $VERSION = '0.9930';
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   4746 eval "use version::vxs $VERSION";
  11         220  
  11         210  
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   80 no strict 'refs';
  11         23  
  11         2126  
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   101 no strict 'refs';
  11         29  
  11         2403  
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   76 no strict 'refs';
  11         19  
  11         5166  
74 34     34   97859 my ($class) = shift;
75              
76             # Set up any derived class
77 34 100       132 unless ($class eq $CLASS) {
78 16         112 local $^W;
79 16         25 *{$class.'::declare'} = \&{$CLASS.'::declare'};
  16         73  
  16         66  
80 16         27 *{$class.'::qv'} = \&{$CLASS.'::qv'};
  16         63  
  16         33  
81             }
82              
83 34         66 my %args;
84 34 100       105 if (@_) { # any remaining terms are arguments
85 11         34 map { $args{$_} = 1 } @_
  22         62  
86             }
87             else { # no parameters at all on use line
88 23         77 %args =
89             (
90             qv => 1,
91             'UNIVERSAL::VERSION' => 1,
92             );
93             }
94              
95 34         89 my $callpkg = caller();
96              
97 34 100       100 if (exists($args{declare})) {
98 9         31 *{$callpkg.'::declare'} =
99 8     8   9598 sub {return $class->declare(shift) }
100 10 100       21 unless defined(&{$callpkg.'::declare'});
  10         58  
101             }
102              
103 34 100       82 if (exists($args{qv})) {
104 27         100 *{$callpkg.'::qv'} =
105 8     8   9661 sub {return $class->qv(shift) }
106 31 100       47 unless defined(&{$callpkg.'::qv'});
  31         217  
107             }
108              
109 34 100       94 if (exists($args{'UNIVERSAL::VERSION'})) {
110 23         83 local $^W;
111             *UNIVERSAL::VERSION
112 23         33 = \&{$CLASS.'::_VERSION'};
  23         101  
113             }
114              
115 34 50       87 if (exists($args{'VERSION'})) {
116 0         0 *{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'};
  0         0  
  0         0  
117             }
118              
119 34 100       136 if (exists($args{'is_strict'})) {
120 1         3 *{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'}
  1         3  
121 1 50       2 unless defined(&{$callpkg.'::is_strict'});
  1         4  
122             }
123              
124 34 100       44435 if (exists($args{'is_lax'})) {
125 1         4 *{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'}
  1         3  
126 1 50       1 unless defined(&{$callpkg.'::is_lax'});
  1         3  
127             }
128             }
129              
130              
131             1;