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\::"}) {
96 Base class package "$base" is empty.
97 (Perhaps you need to 'use' the module which defines that package first.)
100 $sigdie = $SIG{__DIE__};
102 # Make sure a global $SIG{__DIE__} makes it out of the localization.
103 $SIG{__DIE__} = $sigdie if defined $sigdie;
104 ${$base.'::VERSION'} = "-1, set by base.pm"
105 unless defined ${$base.'::VERSION'};
107 push @isa_classes, $base;
109 if ( has_fields($base) || has_attr($base) ) {
110 # No multiple fields inheritance *suck*
113 Carp::croak("Can't multiply inherit fields");
115 $fields_base = $base;
119 # Save this until the end so it's all or nothing if the above loop croaks.
120 push @{"$inheritor\::ISA"}, @isa_classes;
122 if( defined $fields_base ) {
123 inherit_fields($inheritor, $fields_base);
129 my($derived, $base) = @_;
131 return SUCCESS unless $base;
133 my $battr = get_attr($base);
134 my $dattr = get_attr($derived);
135 my $dfields = get_fields($derived);
136 my $bfields = get_fields($base);
138 $dattr->[0] = @$battr;
140 if( keys %$dfields ) {
142 $derived is inheriting from $base but already has its own fields!
143 This will cause problems. Be sure you use base BEFORE declaring fields.
148 # Iterate through the base's fields adding all the non-private
149 # ones to the derived class. Hang on to the original attribute
150 # (Public, Private, etc...) and add Inherited.
151 # This is all too complicated to do efficiently with add_fields().
152 while (my($k,$v) = each %$bfields) {
154 if ($fno = $dfields->{$k} and $fno != $v) {
156 Carp::croak ("Inherited fields can't override existing fields");
159 if( $battr->[$v] & PRIVATE ) {
160 $dattr->[$v] = PRIVATE | INHERITED;
163 $dattr->[$v] = INHERITED | $battr->[$v];
168 foreach my $idx (1..$#{$battr}) {
169 next if defined $dattr->[$idx];
170 $dattr->[$idx] = $battr->[$idx] & INHERITED;
181 base - Establish an ISA relationship with base classes at compile time
186 use base qw(Foo Bar);
190 Allows you to both load one or more modules, while setting up inheritance from
191 those modules at the same time. Roughly similar in effect to
197 push @ISA, qw(Foo Bar);
200 C<base> employs some heuristics to determine if a module has already been
201 loaded, if it has it doesn't try again. If C<base> tries to C<require> the
202 module it will not die if it cannot find the module's file, but will die on any
203 other error. After all this, should your base class be empty, containing no
204 symbols, it will die. This is useful for inheriting from classes in the same
205 file as yourself, like so:
208 sub exclaim { "I can have such a thing?!" }
213 If $VERSION is not detected even after loading it, <base> will define $VERSION
214 in the base package, setting it to the string C<-1, set by base.pm>.
216 C<base> will also initialize the fields if one of the base classes has it.
217 Multiple inheritance of fields is B<NOT> supported, if two or more base classes
218 each have inheritable fields the 'base' pragma will croak. See L<fields>,
219 L<public> and L<protected> for a description of this feature.
221 The base class' C<import> method is B<not> called.
228 =item Base class package "%s" is empty.
230 base.pm was unable to require the base package, because it was not
233 =item Class 'Foo' tried to inherit from itself
235 Attempting to inherit from yourself generates a warning.
244 This module was introduced with Perl 5.004_04.
248 Due to the limitations of the implementation, you must use
249 base I<before> you declare any of your own fields.