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;