After I finally decided to submit this to the perl5 porters, somebody took interest and pointed out a few flaws, like the fact that the original version of my update breaks inheritance. Benjamin Goldberg also went out to say that he likes to use the
VERSION function for version checking, so here it is, the final rendition of base.pm (replacing the {} with [ ], and not breaking inheritance, or causing
weirdo exporter errors)
a patch for CORE MODULE base.pm, to allow for use base [ MODULE => VER
+SION ];
Feel free to do as you wish.
A thanks to benjamin goldbert for taking the time to point out the fla
+ws in my previous submission.
=head1 NAME
base - Establish IS-A relationship with base class at compile time
=head1 SYNOPSIS
package Baz;
use base qw(Foo Bar);
## new usage allowed by podmaster, allows you to request a version
+ number;
package Baz;
use base [ Foo => 1, 'Foo::Bar' => 2 ];
=head1 DESCRIPTION
Roughly similar in effect to
BEGIN {
require Foo;
require Bar;
push @ISA, qw(Foo Bar);
}
Will also initialize the %FIELDS hash if one of the base classes has
it. Multiple inheritance of %FIELDS is not supported. The 'base'
pragma will croak if multiple base classes have a %FIELDS hash. See
L<fields> for a description of this feature.
When strict 'vars' is in scope I<base> also let you assign to @ISA
without having to declare @ISA with the 'vars' pragma first.
If any of the base classes are not loaded yet, I<base> silently
C<require>s them. Whether to C<require> a base class package is
determined by the absence of a global $VERSION in the base package.
If $VERSION is not detected even after loading it, <base> will
define $VERSION in the base package, setting it to the string
C<-1, set by base.pm>.
The new feature of this module, allows for version checking via
use base [ 'MODULE' => 33 ]; # version 33
which is roughly equivalent to
use MODULE 33;
use base 'MODULE';
and will C<croak> much like C<perl -MMODULE=33 -e 1>
if version 33 of MODULE is not available
=head1 HISTORY
This module was introduced with Perl 5.004_04.
=head1 SEE ALSO
L<fields>
=cut
package base;
use 5.006_001;
our $VERSION = "1.02";
sub import {
my $class = shift;
my $fields_base;
my $pkg = caller(0);
my @bases = @_; ##podmaster - cause i don't wanna modify @bases
my %BASV=(); ##podmaster
my @BASV=(); ##podmaster
if(ref $bases[0] eq 'ARRAY') { ##podmaster
my $beep = 0;
@BASV = @{$bases[0]};
%BASV = @BASV;
@bases = grep {$_} map { ($beep++ % 2) ? () : ($_) } @BASV;
}
foreach my $base (@bases) { ##podmaster
next if $pkg->isa($base);
push @{"$pkg\::ISA"}, $base;
my $vglob;
unless (${*{"$base\::VERSION"}{SCALAR}}) {
eval "require $base";
# Only ignore "Can't locate" errors from our eval require.
# Other fatal errors (syntax etc) must be reported.
die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
unless (%{"$base\::"}) {
require Carp;
Carp::croak("Base class package \"$base\" is empty.\n",
"\t(Perhaps you need to 'use' the module ",
"which defines that package first.)");
}
${"$base\::VERSION"} = "-1, set by base.pm"
unless ${*{"$base\::VERSION"}{SCALAR}}; #'
}
##podmaster - allows for use base [ module => versionnumber ]
## thanks Benjamin Goldberg
if(exists $BASV{$base} ) { ## wanted > available
$base->VERSION( $BASV{$base} );
}
# A simple test like (defined %{"$base\::FIELDS"}) will
# sometimes produce typo warnings because it would create
# the hash if it was not present before.
my $fglob;
if ($fglob = ${"$base\::"}{"FIELDS"} and *$fglob{HASH}) {
if ($fields_base) {
require Carp;
Carp::croak("Can't multiply inherit %FIELDS");
} else {
$fields_base = $base;
}
}
}
if ($fields_base) {
require fields;
fields::inherit($pkg, $fields_base);
}
}
1;
