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);
75 foreach my $base (@_) {
76 if ( $inheritor eq $base ) {
77 warn "Class '$inheritor' tried to inherit from itself\n";
80 next if grep $_->isa($base), ($inheritor, @bases);
82 if (has_version($base)) {
83 ${$base.'::VERSION'} = '-1, set by base.pm'
84 unless defined ${$base.'::VERSION'};
91 # Only ignore "Can't locate" errors from our eval require.
92 # Other fatal errors (syntax etc) must be reported.
93 die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
94 unless (%{"$base\::"}) {
98 Base class package "$base" is empty.
99 (Perhaps you need to 'use' the module which defines that package first,
100 or make that module available in \@INC (\@INC contains: @INC).
103 $sigdie = $SIG{__DIE__} || undef;
105 # Make sure a global $SIG{__DIE__} makes it out of the localization.
106 $SIG{__DIE__} = $sigdie if defined $sigdie;
107 ${$base.'::VERSION'} = "-1, set by base.pm"
108 unless defined ${$base.'::VERSION'};
112 if ( has_fields($base) || has_attr($base) ) {
113 # No multiple fields inheritance *suck*
116 Carp::croak("Can't multiply inherit fields");
118 $fields_base = $base;
122 # Save this until the end so it's all or nothing if the above loop croaks.
123 push @{"$inheritor\::ISA"}, @isa_classes;
125 push @{"$inheritor\::ISA"}, @bases;
127 if( defined $fields_base ) {
128 inherit_fields($inheritor, $fields_base);
134 my($derived, $base) = @_;
136 return SUCCESS unless $base;
138 my $battr = get_attr($base);
139 my $dattr = get_attr($derived);
140 my $dfields = get_fields($derived);
141 my $bfields = get_fields($base);
143 $dattr->[0] = @$battr;
145 if( keys %$dfields ) {
147 $derived is inheriting from $base but already has its own fields!
148 This will cause problems. Be sure you use base BEFORE declaring fields.
153 # Iterate through the base's fields adding all the non-private
154 # ones to the derived class. Hang on to the original attribute
155 # (Public, Private, etc...) and add Inherited.
156 # This is all too complicated to do efficiently with add_fields().
157 while (my($k,$v) = each %$bfields) {
159 if ($fno = $dfields->{$k} and $fno != $v) {
161 Carp::croak ("Inherited fields can't override existing fields");
164 if( $battr->[$v] & PRIVATE ) {
165 $dattr->[$v] = PRIVATE | INHERITED;
168 $dattr->[$v] = INHERITED | $battr->[$v];
173 foreach my $idx (1..$#{$battr}) {
174 next if defined $dattr->[$idx];
175 $dattr->[$idx] = $battr->[$idx] & INHERITED;
186 base - Establish an ISA relationship with base classes at compile time
191 use base qw(Foo Bar);
195 Allows you to both load one or more modules, while setting up inheritance from
196 those modules at the same time. Roughly similar in effect to
202 push @ISA, qw(Foo Bar);
205 C<base> employs some heuristics to determine if a module has already been
206 loaded, if it has it doesn't try again. If C<base> tries to C<require> the
207 module it will not die if it cannot find the module's file, but will die on any
208 other error. After all this, should your base class be empty, containing no
209 symbols, it will die. This is useful for inheriting from classes in the same
210 file as yourself, like so:
213 sub exclaim { "I can have such a thing?!" }
218 If $VERSION is not detected even after loading it, <base> will define $VERSION
219 in the base package, setting it to the string C<-1, set by base.pm>.
221 C<base> will also initialize the fields if one of the base classes has it.
222 Multiple inheritance of fields is B<NOT> supported, if two or more base classes
223 each have inheritable fields the 'base' pragma will croak. See L<fields>,
224 L<public> and L<protected> for a description of this feature.
226 The base class' C<import> method is B<not> called.
233 =item Base class package "%s" is empty.
235 base.pm was unable to require the base package, because it was not
238 =item Class 'Foo' tried to inherit from itself
240 Attempting to inherit from yourself generates a warning.
249 This module was introduced with Perl 5.004_04.
253 Due to the limitations of the implementation, you must use
254 base I<before> you declare any of your own fields.