5 fields - compile-time class fields
11 use fields qw(foo bar _Foo_private);
15 $self = fields::new($self);
16 $self->{_Foo_private} = "this is Foo's secret";
27 # this will generate an error
34 use fields qw(baz _Bar_private); # not shared with Foo
37 my $self = fields::new($class);
38 $self->SUPER::new(); # init base fields
39 $self->{baz} = 10; # init own fields
40 $self->{_Bar_private} = "this is Bar's secret";
47 The C<fields> pragma enables compile-time verified class fields.
49 NOTE: The current implementation keeps the declared fields in the %FIELDS
50 hash of the calling package, but this may change in future versions.
51 Do B<not> update the %FIELDS hash directly, because it must be created
52 at compile-time for it to be fully useful, as is done by this pragma.
54 The related C<base> pragma will combine fields from base classes and any
55 fields declared using the C<fields> pragma. This enables field
56 inheritance to work properly.
58 Field names that start with an underscore character are made private to
59 the class and are not visible to subclasses. Inherited fields can be
60 overridden but will generate a warning if used together with the C<-w>
63 The following functions are supported:
69 fields::new() creates and blesses a restricted-hash comprised of the
70 fields declared using the C<fields> pragma into the specified class.
71 This makes it possible to write a constructor like this:
73 package Critter::Sounds;
74 use fields qw(cat dog bird);
78 $self = fields::new($self) unless ref $self;
79 $self->{cat} = 'meow'; # scalar element
80 @$self{'dog','bird'} = ('bark','tweet'); # slice
86 Pseudo-hashes have been removed from Perl as of 5.10. Consider using
87 restricted hashes instead. Using fields::phash() will cause an error.
100 use warnings::register;
101 our(%attr, $VERSION);
105 use Hash::Util qw(lock_keys);
109 sub _PRIVATE () { 2 }
111 # The %attr hash holds the attributes of the currently assigned fields
112 # per class. The hash is indexed by class names and the hash value is
113 # an array reference. The first element in the array is the lowest field
114 # number not belonging to a base class. The remaining elements' indices
115 # are the field numbers. The values are integer bit masks, or undef
116 # in the case of base class private fields (which occupy a slot but are
117 # otherwise irrelevant to the class).
122 my $package = caller(0);
123 # avoid possible typo warnings
124 %{"$package\::FIELDS"} = () unless %{"$package\::FIELDS"};
125 my $fields = \%{"$package\::FIELDS"};
126 my $fattr = ($attr{$package} ||= [1]);
129 if ($next > $fattr->[0]
130 and ($fields->{$_[0]} || 0) >= $fattr->[0])
132 # There are already fields not belonging to base classes.
133 # Looks like a possible module reload...
137 my $fno = $fields->{$f};
139 # Allow the module to be reloaded so long as field positions
141 if ($fno and $fno != $next) {
143 if ($fno < $fattr->[0]) {
144 warnings::warnif("Hides field '$f' in base class") ;
146 Carp::croak("Field name '$f' already in use");
149 $fields->{$f} = $next;
150 $fattr->[$next] = ($f =~ /^_/) ? _PRIVATE : _PUBLIC;
153 if (@$fattr > $next) {
154 # Well, we gave them the benefit of the doubt by guessing the
155 # module was reloaded, but they appear to be declaring fields
156 # in more than one place. We can't be sure (without some extra
157 # bookkeeping) that the rest of the fields will be declared or
158 # have the same positions, so punt.
160 Carp::croak ("Reloaded module must declare all fields at once");
164 sub inherit { # called by base.pm when $base_fields is nonempty
165 my($derived, $base) = @_;
166 my $base_attr = $attr{$base};
167 my $derived_attr = $attr{$derived} ||= [];
168 # avoid possible typo warnings
169 %{"$base\::FIELDS"} = () unless %{"$base\::FIELDS"};
170 %{"$derived\::FIELDS"} = () unless %{"$derived\::FIELDS"};
171 my $base_fields = \%{"$base\::FIELDS"};
172 my $derived_fields = \%{"$derived\::FIELDS"};
174 $derived_attr->[0] = $base_attr ? scalar(@$base_attr) : 1;
175 while (my($k,$v) = each %$base_fields) {
177 if ($fno = $derived_fields->{$k} and $fno != $v) {
179 Carp::croak ("Inherited %FIELDS can't override existing %FIELDS");
181 if ($base_attr->[$v] & _PRIVATE) {
182 $derived_attr->[$v] = undef;
184 $derived_attr->[$v] = $base_attr->[$v];
185 $derived_fields->{$k} = $v;
190 sub _dump # sometimes useful for debugging
192 for my $pkg (sort keys %attr) {
194 if (@{"$pkg\::ISA"}) {
195 print " (", join(", ", @{"$pkg\::ISA"}), ")";
198 my $fields = \%{"$pkg\::FIELDS"};
199 for my $f (sort {$fields->{$a} <=> $fields->{$b}} keys %$fields) {
200 my $no = $fields->{$f};
202 my $fattr = $attr{$pkg}[$no];
203 if (defined $fattr) {
205 push(@a, "public") if $fattr & _PUBLIC;
206 push(@a, "private") if $fattr & _PRIVATE;
207 push(@a, "inherited") if $no < $attr{$pkg}[0];
208 print "\t(", join(", ", @a), ")";
217 $class = ref $class if ref $class;
218 my $self = bless {}, $class;
219 lock_keys(%$self, keys %{$class.'::FIELDS'});
224 die "Pseudo-hashes have been removed from Perl";