10 sub PUBLIC () { 2**0 }
11 sub PRIVATE () { 2**1 }
12 sub INHERITED () { 2**2 }
13 sub PROTECTED () { 2**3 }
16 my $Fattr = \%fields::attr;
20 my $fglob = ${"$base\::"}{FIELDS};
21 return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
26 my $vglob = ${$base.'::'}{VERSION};
27 return( ($vglob && *$vglob{SCALAR}) ? 1 : 0 );
32 my($class) = ref $proto || $proto;
33 return exists $Fattr->{$class};
37 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
38 return $Fattr->{$_[0]};
43 # Shut up a possible typo warning.
44 () = \%{$_[0].'::FIELDS'};
45 my $f = \%{$_[0].'::FIELDS'};
47 # should be centralized in fields? perhaps
48 # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
49 # is used here anyway, it doesn't matter.
50 bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
57 # Shut up a possible typo warning.
58 () = \%{$_[0].'::FIELDS'};
59 return \%{$_[0].'::FIELDS'};
66 return SUCCESS unless @_;
68 # List of base classes from which we will inherit %FIELDS.
71 my $inheritor = caller(0);
74 foreach my $base (@_) {
75 if ( $inheritor eq $base ) {
76 warn "Class '$inheritor' tried to inherit from itself\n";
79 next if $inheritor->isa($base);
81 if (has_version($base)) {
82 ${$base.'::VERSION'} = '-1, set by base.pm'
83 unless defined ${$base.'::VERSION'};
90 # Only ignore "Can't locate" errors from our eval require.
91 # Other fatal errors (syntax etc) must be reported.
92 die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
93 unless (%{"$base\::"}) {
97 Base class package "$base" is empty.
98 (Perhaps you need to 'use' the module which defines that package first,
99 or make that module available in \@INC (\@INC contains: @INC).
102 $sigdie = $SIG{__DIE__};
104 # Make sure a global $SIG{__DIE__} makes it out of the localization.
105 $SIG{__DIE__} = $sigdie if defined $sigdie;
106 ${$base.'::VERSION'} = "-1, set by base.pm"
107 unless defined ${$base.'::VERSION'};
109 push @isa_classes, $base;
111 if ( has_fields($base) || has_attr($base) ) {
112 # No multiple fields inheritance *suck*
115 Carp::croak("Can't multiply inherit fields");
117 $fields_base = $base;
121 # Save this until the end so it's all or nothing if the above loop croaks.
122 push @{"$inheritor\::ISA"}, @isa_classes;
124 if( defined $fields_base ) {
125 inherit_fields($inheritor, $fields_base);
131 my($derived, $base) = @_;
133 return SUCCESS unless $base;
135 my $battr = get_attr($base);
136 my $dattr = get_attr($derived);
137 my $dfields = get_fields($derived);
138 my $bfields = get_fields($base);
140 $dattr->[0] = @$battr;
142 if( keys %$dfields ) {
144 $derived is inheriting from $base but already has its own fields!
145 This will cause problems. Be sure you use base BEFORE declaring fields.
150 # Iterate through the base's fields adding all the non-private
151 # ones to the derived class. Hang on to the original attribute
152 # (Public, Private, etc...) and add Inherited.
153 # This is all too complicated to do efficiently with add_fields().
154 while (my($k,$v) = each %$bfields) {
156 if ($fno = $dfields->{$k} and $fno != $v) {
158 Carp::croak ("Inherited fields can't override existing fields");
161 if( $battr->[$v] & PRIVATE ) {
162 $dattr->[$v] = PRIVATE | INHERITED;
165 $dattr->[$v] = INHERITED | $battr->[$v];
170 foreach my $idx (1..$#{$battr}) {
171 next if defined $dattr->[$idx];
172 $dattr->[$idx] = $battr->[$idx] & INHERITED;
183 base - Establish an ISA relationship with base classes at compile time
188 use base qw(Foo Bar);
192 Allows you to both load one or more modules, while setting up inheritance from
193 those modules at the same time. Roughly similar in effect to
199 push @ISA, qw(Foo Bar);
202 C<base> employs some heuristics to determine if a module has already been
203 loaded, if it has it doesn't try again. If C<base> tries to C<require> the
204 module it will not die if it cannot find the module's file, but will die on any
205 other error. After all this, should your base class be empty, containing no
206 symbols, it will die. This is useful for inheriting from classes in the same
207 file as yourself, like so:
210 sub exclaim { "I can have such a thing?!" }
215 If $VERSION is not detected even after loading it, <base> will define $VERSION
216 in the base package, setting it to the string C<-1, set by base.pm>.
218 C<base> will also initialize the fields if one of the base classes has it.
219 Multiple inheritance of fields is B<NOT> supported, if two or more base classes
220 each have inheritable fields the 'base' pragma will croak. See L<fields>,
221 L<public> and L<protected> for a description of this feature.
223 The base class' C<import> method is B<not> called.
230 =item Base class package "%s" is empty.
232 base.pm was unable to require the base package, because it was not
235 =item Class 'Foo' tried to inherit from itself
237 Attempting to inherit from yourself generates a warning.
246 This module was introduced with Perl 5.004_04.
250 Due to the limitations of the implementation, you must use
251 base I<before> you declare any of your own fields.