This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Changed Copyright year as suggested by karl williamson in http://nntp.perl.org/group...
[perl5.git] / lib / version.pm
index 85be41d..9201a02 100644 (file)
@@ -4,22 +4,53 @@ package version;
 use 5.005_04;
 use strict;
 
-use vars qw(@ISA $VERSION $CLASS *qv);
+use vars qw(@ISA $VERSION $CLASS *declare *qv);
 
-$VERSION = "0.70";
+$VERSION = 0.77;
 
 $CLASS = 'version';
 
 # Preloaded methods go here.
 sub import {
-    my ($class) = @_;
-    my $callpkg = caller();
     no strict 'refs';
+    my ($class) = shift;
+
+    # Set up any derived class
+    unless ($class eq 'version') {
+       local $^W;
+       *{$class.'::declare'} =  \&version::declare;
+       *{$class.'::qv'} = \&version::qv;
+    }
+
+    my %args;
+    if (@_) { # any remaining terms are arguments
+       map { $args{$_} = 1 } @_
+    }
+    else { # no parameters at all on use line
+       %args = 
+       (
+           qv => 1,
+           'UNIVERSAL::VERSION' => 1,
+       );
+    }
     
-    *{$callpkg."::qv"} = 
-           sub {return bless version::qv(shift), $class }
-       unless defined (&{"$callpkg\::qv"});
+    my $callpkg = caller();
+    
+    if (exists($args{declare})) {
+       *{$callpkg."::declare"} = 
+           sub {return $class->declare(shift) }
+         unless defined(&{$callpkg.'::declare'});
+    }
+
+    if (exists($args{qv})) {
+       *{$callpkg."::qv"} =
+           sub {return $class->qv(shift) }
+         unless defined(&{"$callpkg\::qv"});
+    }
 
+    if (exists($args{'VERSION'})) {
+       *{$callpkg."::VERSION"} = \&version::_VERSION;
+    }
 }
 
 1;