X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fbase.pm;h=e98d0f1e61bd3a112e43336455178a3a95bff4d4;hb=36c726b39493413b3d290022ea8659549c919762;hp=3177488eac0e0e44bc04bd9c3ec1aa52dc47bcca;hpb=864f8ab4dc777f1f69726cb282c61127880e06f9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/base.pm b/lib/base.pm index 3177488..e98d0f1 100644 --- a/lib/base.pm +++ b/lib/base.pm @@ -2,7 +2,7 @@ package base; use strict 'vars'; use vars qw($VERSION); -$VERSION = '2.03'; +$VERSION = '2.06'; # constant.pm is slow sub SUCCESS () { 1 } @@ -38,11 +38,26 @@ sub get_attr { return $Fattr->{$_[0]}; } -sub get_fields { - # Shut up a possible typo warning. - () = \%{$_[0].'::FIELDS'}; +if ($] < 5.009) { + *get_fields = sub { + # Shut up a possible typo warning. + () = \%{$_[0].'::FIELDS'}; + my $f = \%{$_[0].'::FIELDS'}; - return \%{$_[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'); + + return $f; + } +} +else { + *get_fields = sub { + # Shut up a possible typo warning. + () = \%{$_[0].'::FIELDS'}; + return \%{$_[0].'::FIELDS'}; + } } sub import { @@ -113,7 +128,7 @@ sub inherit_fields { if( keys %$dfields ) { warn "$derived is inheriting from $base but already has its own ". "fields!\n". - "This will cause problems with pseudo-hashes.\n". + "This will cause problems.\n". "Be sure you use base BEFORE declaring fields\n"; } @@ -151,7 +166,7 @@ __END__ =head1 NAME -base - Establish IS-A relationship with base class at compile time +base - Establish IS-A relationship with base classes at compile time =head1 SYNOPSIS @@ -160,30 +175,39 @@ base - Establish IS-A relationship with base class at compile time =head1 DESCRIPTION -Roughly similar in effect to +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 + package Baz; BEGIN { require Foo; require Bar; push @ISA, qw(Foo Bar); } +If any of the listed modules are not loaded yet, I silently attempts to +C them (and silently continues if the C failed). Whether to +C 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, will define $VERSION in the base package, setting it to the string +C<-1, set by base.pm>. + Will also initialize the fields if one of the base classes has it. -Multiple Inheritence of fields is B supported, if two or more +Multiple inheritence of fields is B supported, if two or more base classes each have inheritable fields the 'base' pragma will croak. See L, L and L for a description of this feature. -When strict 'vars' is in scope, I also lets you assign to @ISA -without having to declare @ISA with the 'vars' pragma first. +=head1 DIAGNOSTICS + +=over 4 + +=item Base class package "%s" is empty. -If any of the base classes are not loaded yet, I silently -Cs them (but it won't call the C method). Whether to -C 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, I will define $VERSION in the base package, setting it to -the string C<-1, set by base.pm>. +base.pm was unable to require the base package, because it was not +found in your path. +=back =head1 HISTORY @@ -192,7 +216,7 @@ This module was introduced with Perl 5.004_04. =head1 CAVEATS -Due to the limitations of the pseudo-hash implementation, you must use +Due to the limitations of the implementation, you must use base I you declare any of your own fields.