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