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