sub INHERITED () { 2**2 }
sub PROTECTED () { 2**3 }
my $Fattr = \%fields::attr;
my $fglob = ${"$base\::"}{FIELDS};
return( ($fglob && *$fglob{HASH}) ? 1 : 0 );
my $vglob = ${$base.'::'}{VERSION};
return( ($vglob && *$vglob{SCALAR}) ? 1 : 0 );
my($class) = ref $proto || $proto;
return exists $Fattr->{$class};
$Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
# Shut up a possible typo warning.
() = \%{$_[0].'::FIELDS'};
my $f = \%{$_[0].'::FIELDS'};
# should be centralized in fields? perhaps
# fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
# is used here anyway, it doesn't matter.
bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
# Shut up a possible typo warning.
() = \%{$_[0].'::FIELDS'};
return \%{$_[0].'::FIELDS'};
return SUCCESS unless @_;
# List of base classes from which we will inherit %FIELDS.
my $inheritor = caller(0);
next if $inheritor->isa($base);
if (has_version($base)) {
${$base.'::VERSION'} = '-1, set by base.pm'
unless defined ${$base.'::VERSION'};
# 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 /;
Base class package "$base" is empty.
(Perhaps you need to 'use' the module which defines that package first.)
${$base.'::VERSION'} = "-1, set by base.pm"
unless defined ${$base.'::VERSION'};
push @
{"$inheritor\::ISA"}, $base;
if ( has_fields
($base) || has_attr
($base) ) {
# No multiple fields inheritence *suck*
Carp
::croak
("Can't multiply inherit %FIELDS");
if( defined $fields_base ) {
inherit_fields
($inheritor, $fields_base);
my($derived, $base) = @_;
return SUCCESS
unless $base;
my $battr = get_attr
($base);
my $dattr = get_attr
($derived);
my $dfields = get_fields
($derived);
my $bfields = get_fields
($base);
warn "$derived is inheriting from $base but already has its own ".
"This will cause problems.\n".
"Be sure you use base BEFORE declaring fields\n";
# Iterate through the base's fields adding all the non-private
# ones to the derived class. Hang on to the original attribute
# (Public, Private, etc...) and add Inherited.
# This is all too complicated to do efficiently with add_fields().
while (my($k,$v) = each %$bfields) {
if ($fno = $dfields->{$k} and $fno != $v) {
Carp
::croak
("Inherited %FIELDS can't override existing %FIELDS");
if( $battr->[$v] & PRIVATE
) {
$dattr->[$v] = PRIVATE
| INHERITED
;
$dattr->[$v] = INHERITED
| $battr->[$v];
foreach my $idx (1..$#{$battr}) {
next if defined $dattr->[$idx];
$dattr->[$idx] = $battr->[$idx] & INHERITED
;
base - Establish IS-A relationship with base classes at compile time
Allows you to both load one or more modules, while setting up inheritance from
those modules at the same time. Roughly similar in effect to
If any of the listed modules are not loaded yet, I<base> silently attempts to
C<require> them (and silently continues if the C<require> failed). Whether to
C<require> a base class module is determined by the absence of a global variable
$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
Will also initialize the fields if one of the base classes has it.
Multiple inheritence of fields is B<NOT> supported, if two or more
base classes each have inheritable fields the 'base' pragma will
croak. See L<fields>, L<public> and L<protected> for a description of
=item Base class package "%s" is empty.
base.pm was unable to require the base package, because it was not
This module was introduced with Perl 5.004_04.
Due to the limitations of the implementation, you must use
base I<before> you declare any of your own fields.