This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate CPAN version.pm release into core
[perl5.git] / cpan / version / lib / version.pm
1 #!perl -w
2 package version;
3
4 use 5.005_05;
5 use strict;
6
7 use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
8
9 $VERSION = 0.9905;
10 $CLASS = 'version';
11
12 {
13     local $SIG{'__DIE__'};
14     eval "use version::vxs $VERSION";
15     if ( $@ ) { # don't have the XS version installed
16         eval "use version::vpp $VERSION"; # don't tempt fate
17         die "$@" if ( $@ );
18         push @ISA, "version::vpp";
19         local $^W;
20         *version::qv = \&version::vpp::qv;
21         *version::declare = \&version::vpp::declare;
22         *version::_VERSION = \&version::vpp::_VERSION;
23         *version::vcmp = \&version::vpp::vcmp;
24         *version::new = \&version::vpp::new;
25         if ($] >= 5.009000) {
26             no strict 'refs';
27             *version::stringify = \&version::vpp::stringify;
28             *{'version::(""'} = \&version::vpp::stringify;
29             *{'version::(<=>'} = \&version::vpp::vcmp;
30             *version::parse = \&version::vpp::parse;
31         }
32         *version::is_strict = \&version::vpp::is_strict;
33         *version::is_lax = \&version::vpp::is_lax;
34     }
35     else { # use XS module
36         push @ISA, "version::vxs";
37         local $^W;
38         *version::declare = \&version::vxs::declare;
39         *version::qv = \&version::vxs::qv;
40         *version::_VERSION = \&version::vxs::_VERSION;
41         *version::vcmp = \&version::vxs::VCMP;
42         *version::new = \&version::vxs::new;
43         if ($] >= 5.009000) {
44             no strict 'refs';
45             *version::stringify = \&version::vxs::stringify;
46             *{'version::(""'} = \&version::vxs::stringify;
47             *{'version::(<=>'} = \&version::vxs::VCMP;
48             *version::parse = \&version::vxs::parse;
49         }
50         *version::is_strict = \&version::vxs::is_strict;
51         *version::is_lax = \&version::vxs::is_lax;
52     }
53 }
54
55 sub import {
56     no strict 'refs';
57     my ($class) = shift;
58
59     # Set up any derived class
60     unless ($class eq $CLASS) {
61         local $^W;
62         *{$class.'::declare'} =  \&{$CLASS.'::declare'};
63         *{$class.'::qv'} = \&{$CLASS.'::qv'};
64     }
65
66     my %args;
67     if (@_) { # any remaining terms are arguments
68         map { $args{$_} = 1 } @_
69     }
70     else { # no parameters at all on use line
71         %args =
72         (
73             qv => 1,
74             'UNIVERSAL::VERSION' => 1,
75         );
76     }
77
78     my $callpkg = caller();
79
80     if (exists($args{declare})) {
81         *{$callpkg.'::declare'} =
82             sub {return $class->declare(shift) }
83           unless defined(&{$callpkg.'::declare'});
84     }
85
86     if (exists($args{qv})) {
87         *{$callpkg.'::qv'} =
88             sub {return $class->qv(shift) }
89           unless defined(&{$callpkg.'::qv'});
90     }
91
92     if (exists($args{'UNIVERSAL::VERSION'})) {
93         local $^W;
94         *UNIVERSAL::VERSION
95                 = \&{$CLASS.'::_VERSION'};
96     }
97
98     if (exists($args{'VERSION'})) {
99         *{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'};
100     }
101
102     if (exists($args{'is_strict'})) {
103         *{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'}
104           unless defined(&{$callpkg.'::is_strict'});
105     }
106
107     if (exists($args{'is_lax'})) {
108         *{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'}
109           unless defined(&{$callpkg.'::is_lax'});
110     }
111 }
112
113
114 1;