Subject: | new use syntax suggestion |
I have proposed a new/alternative notation for injecting version data
into a class file.
Old:
use version;
$VERSION = qv('1.1.1');
New:
use version our=>'1.1.1';
Attached is the modified version.pm.
Note, I would usually have applied a patch, but I also ran this through
tidy and tried my best to get it as critic friendly as possible, which
does kind-of result in almost 90% difference anyway.
Also created a few functions to make the core logic easier to understand.
--
Example Usage:
use version 0.76 our=>'1.1.1';
print $VERSION; # 1.1.1
print qv('1.1.1'); # doesn't work.
use version 0.76;
print $VERSION; # doesn't work
print qv('1.1.1'); # doesn't work.
use version 0.76 'qv', our=>'1.1.1';
print $VERSION; # 1.1.1
print qv('1.1.1'); # 1.1.1
Subject: | version.pm |
#!perl -w
package version;
use 5.006;
use strict;
use vars qw(@ISA $VERSION $CLASS *qv);
$VERSION = 0.76;
$CLASS = 'version';
eval "use version::vxs $VERSION";
if ($@) { # don't have the XS version installed
eval "use version::vpp $VERSION"; # don't tempt fate
die "$@" if ($@);
push @ISA, 'version::vpp';
## no critic ( Warnings )
no warnings;
*version::qv = \&version::vpp::qv;
if ( $] > 5.009001 && $] <= 5.010000 ) {
## no critic ( Stricture )
no strict 'refs';
*{'version::stringify'} = \*version::vpp::stringify;
*{'version::(""'} = \*version::vpp::stringify;
}
}
else { # use XS module
push @ISA, "version::vxs";
## no critic ( Warnings )
no warnings;
*version::qv = \&version::vxs::qv;
if ( $] > 5.009001 && $] <= 5.010000 ) {
## no critic ( Stricture )
no strict 'refs';
*{'version::stringify'} = \*version::vxs::stringify;
*{'version::(""'} = \*version::vxs::stringify;
}
}
#
# version::_inject_version( $version_classname, $target_package, $version_string );
#
sub _inject_version {
## no critic ( Stricture )
my ( $class, $package, $version ) = @_;
my $v = bless version::qv($version), $class;
no strict 'refs';
*{ $package . '::VERSION' } = \$v;
return $v;
}
#
# version::_has_qv( $package );
#
sub _has_qv {
## no critic ( Stricture )
my (@args) = @_;
my ($package) = shift @args;
no strict 'refs';
return defined &{ $package . '::qv' };
}
sub _inject_qv {
## no critic ( Stricture )
my ( $class, $package ) = @_;
no strict 'refs';
*{ $package . '::qv' } = sub {
return bless version::qv( shift @_ ), $class;
};
return 1;
}
# Preloaded methods go here.
sub import {
my (@args) = @_;
my ($class) = shift @args;
my ($callpkg) = caller;
if ( not @args and not _has_qv($callpkg) ) {
_inject_qv( $class, $callpkg );
return;
}
for my $i ( 0 .. $#args ) {
my $j = $args[$i];
if ( "$j" eq 'qv' and not _has_qv($callpkg) ) {
_inject_qv( $class, $callpkg );
}
if ( "$j" eq 'our' and defined $args[ $i + 1 ] ) {
_inject_version( $class, $callpkg, $args[ $i + 1 ] );
}
}
return 1;
}
1;