1
package Class::Meta::Attribute;
3
# $Id: Attribute.pm 2405 2005-12-17 03:41:09Z theory $
7
Class::Meta::Attribute - Class::Meta class attribute introspection
11
# Assuming MyApp::Thingy was generated by Class::Meta.
12
my $class = MyApp::Thingy->my_class;
13
my $thingy = MyApp::Thingy->new;
15
print "\nAttributes:\n";
16
for my $attr ($class->attributes) {
17
print " o ", $attr->name, " => ", $attr->get($thingy), $/;
18
if ($attr->authz >= Class::Meta::SET && $attr->type eq 'string') {
19
$attr->get($thingy, 'hey there!');
20
print " Changed to: ", $attr->get($thingy) $/;
26
An object of this class describes an attribute of a class created by
27
Class::Meta. It includes metadata such as the name of the attribute, its data
28
type, its accessibility, and whether or not a value is required. It also
29
provides methods to easily get and set the value of the attribute for a given
30
instance of the class.
32
Class::Meta::Attribute objects are created by Class::Meta; they are never
33
instantiated directly in client code. To access the attribute objects for a
34
Class::Meta-generated class, simply call its C<my_class()> method to retrieve
35
its Class::Meta::Class object, and then call the C<attributes()> method on the
36
Class::Meta::Class object.
40
##############################################################################
42
##############################################################################
45
##############################################################################
47
##############################################################################
48
our $VERSION = "0.52";
50
##############################################################################
52
##############################################################################
60
A protected method for constructing a Class::Meta::Attribute object. Do not
61
call this method directly; Call the
62
L<C<add_attribute()>|Class::Meta/"add_attribute"> method on a Class::Meta
71
# Check to make sure that only Class::Meta or a subclass is constructing a
72
# Class::Meta::Attribute object.
74
Class::Meta->handle_error("Package '$caller' cannot create $pkg "
76
unless UNIVERSAL::isa($caller, 'Class::Meta')
77
|| UNIVERSAL::isa($caller, __PACKAGE__);
79
# Make sure we can get all the arguments.
80
$class->handle_error("Odd number of parameters in call to new() when "
81
. "named parameters were expected")
86
$class->handle_error("Parameter 'name' is required in call to new()")
88
# Is this too paranoid?
89
$class->handle_error("Attribute '$p{name}' is not a valid attribute "
90
. "name -- only alphanumeric and '_' characters "
94
# Grab the package name.
95
$p{package} = $class->{package};
97
# Set the required and once attributes.
98
for (qw(required once)) {
99
$p{$_} = $p{$_} ? 1 : 0;
102
# Make sure the name hasn't already been used for another attribute
103
$class->handle_error("Attribute '$p{name}' already exists in class '"
104
. $class->{attrs}{$p{name}}{package} . "'")
105
if ! delete $p{override} && exists $class->{attrs}{$p{name}};
108
if (exists $p{view}) {
109
$class->handle_error("Not a valid view parameter: "
111
unless $p{view} == Class::Meta::PUBLIC
112
or $p{view} == Class::Meta::PROTECTED
113
or $p{view} == Class::Meta::TRUSTED
114
or $p{view} == Class::Meta::PRIVATE;
116
# Make it public by default.
117
$p{view} = Class::Meta::PUBLIC;
120
# Check the authorization level.
121
if (exists $p{authz}) {
122
$class->handle_error("Not a valid authz parameter: "
124
unless $p{authz} == Class::Meta::NONE
125
or $p{authz} == Class::Meta::READ
126
or $p{authz} == Class::Meta::WRITE
127
or $p{authz} == Class::Meta::RDWR;
129
# Make it read/write by default.
130
$p{authz} = Class::Meta::RDWR;
133
# Check the creation constant.
134
if (exists $p{create}) {
135
$class->handle_error("Not a valid create parameter: "
137
unless $p{create} == Class::Meta::NONE
138
or $p{create} == Class::Meta::GET
139
or $p{create} == Class::Meta::SET
140
or $p{create} == Class::Meta::GETSET;
142
# Rely on the authz setting by default.
143
$p{create} = $p{authz};
147
if (exists $p{context}) {
148
$class->handle_error("Not a valid context parameter: "
150
unless $p{context} == Class::Meta::OBJECT
151
or $p{context} == Class::Meta::CLASS;
153
# Put it in object context by default.
154
$p{context} = Class::Meta::OBJECT;
158
if (exists $p{default}) {
159
# A code ref should be executed when the default is called.
160
$p{_def_code} = delete $p{default}
161
if ref $p{default} eq 'CODE';
164
# Create and cache the attribute object.
165
$class->{attrs}{$p{name}} = bless \%p, ref $pkg || $pkg;
168
push @{ $class->{all_attr_ord} }, $p{name};
169
if ($p{view} > Class::Meta::PRIVATE) {
170
push @{$class->{prot_attr_ord}}, $p{name}
171
unless $p{view} == Class::Meta::TRUSTED;
172
if ($p{view} > Class::Meta::PROTECTED) {
173
push @{$class->{trst_attr_ord}}, $p{name};
174
push @{$class->{attr_ord}}, $p{name}
175
if $p{view} == Class::Meta::PUBLIC;
179
# Store a reference to the class object.
183
return $class->{attrs}{$p{name}};
186
##############################################################################
188
##############################################################################
190
=head2 Instance Methods
194
my $name = $attr->name;
196
Returns the name of the attribute.
200
my $type = $attr->type;
202
Returns the name of the attribute's data type. Typical values are "scalar",
203
"string", and "boolean". See L<Class::Meta|Class::Meta/"Data Types"> for a
208
my $desc = $attr->desc;
210
Returns a description of the attribute.
214
my $label = $attr->label;
216
Returns a label for the attribute, suitable for use in a user interface. It is
217
distinguished from the attribute name, which functions to name the accessor
218
methods for the attribute.
222
my $req = $attr->required;
224
Indicates if the attribute is required to have a value.
228
my $once = $attr->once;
230
Indicates whether an attribute value can be set to a defined value only once.
234
my $package = $attr->package;
236
Returns the package name of the class that attribute is associated with.
240
my $view = $attr->view;
242
Returns the view of the attribute, reflecting its visibility. The possible
243
values are defined by the following constants:
247
=item Class::Meta::PUBLIC
249
=item Class::Meta::PRIVATE
251
=item Class::Meta::TRUSTED
253
=item Class::Meta::PROTECTED
259
my $context = $attr->context;
261
Returns the context of the attribute, essentially whether it is a class or
262
object attribute. The possible values are defined by the following constants:
266
=item Class::Meta::CLASS
268
=item Class::Meta::OBJECT
274
my $authz = $attr->authz;
276
Returns the authorization for the attribute, which determines whether it can be
277
read or changed. The possible values are defined by the following constants:
281
=item Class::Meta::READ
283
=item Class::Meta::WRITE
285
=item Class::Meta::RDWR
287
=item Class::Meta::NONE
293
my $class = $attr->class;
295
Returns the Class::Meta::Class object that this attribute is associated
296
with. Note that this object will always represent the class in which the
297
attribute is defined, and I<not> any of its subclasses.
301
sub name { $_[0]->{name} }
302
sub type { $_[0]->{type} }
303
sub desc { $_[0]->{desc} }
304
sub label { $_[0]->{label} }
305
sub required { $_[0]->{required} }
306
sub once { $_[0]->{once} }
307
sub package { $_[0]->{package} }
308
sub view { $_[0]->{view} }
309
sub context { $_[0]->{context} }
310
sub authz { $_[0]->{authz} }
311
sub class { $_[0]->{class} }
313
##############################################################################
317
my $default = $attr->default;
319
Returns the default value for a new instance of this attribute. Since the
320
default value can be determined dynamically, the value returned by
321
C<default()> may change on subsequent calls. It all depends on what was
322
passed for the C<default> parameter in the call to C<add_attribute()> on the
323
Class::Meta object that generated the class.
328
if (my $code = $_[0]->{_def_code}) {
331
return $_[0]->{default};
334
##############################################################################
338
my $value = $attr->get($thingy);
340
This method calls the "get" accessor method on the object passed as the sole
341
argument and returns the value of the attribute for that object. Note that it
342
uses a C<goto> to execute the accessor, so the call to C<set()> itself
343
will not appear in a call stack trace.
349
my $code = $self->{_get}
350
or $self->class->handle_error("Cannot get attribute '",
355
##############################################################################
359
$attr->set($thingy, $new_value);
361
This method calls the "set" accessor method on the object passed as the first
362
argument and passes any remaining arguments to assign a new value to the
363
attribute for that object. Note that it uses a C<goto> to execute the
364
accessor, so the call to C<set()> itself will not appear in a call stack
371
my $code = $self->{_set}
372
or $self->class->handle_error("Cannot set attribute '",
377
##############################################################################
381
$attr->build($class);
383
This is a protected method, designed to be called only by the Class::Meta
384
class or a subclass of Class::Meta. It takes a single argument, the
385
Class::Meta::Class object for the class in which the attribute was defined,
386
and generates attribute accessors by calling out to the C<make_attr_get()> and
387
C<make_attr_set()> methods of Class::Meta::Type as appropriate for the
388
Class::Meta::Attribute object.
390
Although you should never call this method directly, subclasses of
391
Class::Meta::Constructor may need to override its behavior.
396
my ($self, $class) = @_;
398
# Check to make sure that only Class::Meta or a subclass is building
399
# attribute accessors.
401
$self->class->handle_error("Package '$caller' cannot call " . ref($self)
403
unless UNIVERSAL::isa($caller, 'Class::Meta')
404
|| UNIVERSAL::isa($caller, __PACKAGE__);
406
# Get the data type object, replace any alias, and assemble the
408
my $type = Class::Meta::Type->new($self->{type});
409
$self->{type} = $type->key;
410
my $create = delete $self->{create};
411
$type->build($class->{package}, $self, $create)
412
if $create != Class::Meta::NONE;
414
# Create the attribute object get code reference.
415
if ($self->{authz} >= Class::Meta::READ) {
416
$self->{_get} = $type->make_attr_get($self);
419
# Create the attribute object set code reference.
420
if ($self->{authz} >= Class::Meta::WRITE) {
421
$self->{_set} = $type->make_attr_set($self);
431
Please send bug reports to <bug-class-meta@rt.cpan.org> or report them via the
432
CPAN Request Tracker at L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Class-Meta>.
436
David Wheeler <david@kineticode.com>
440
Other classes of interest within the Class::Meta distribution include:
444
=item L<Class::Meta|Class::Meta>
446
=item L<Class::Meta::Class|Class::Meta::Class>
448
=item L<Class::Meta::Method|Class::Meta::Method>
450
=item L<Class::Meta::Constructor|Class::Meta::Constructor>
452
=item L<Class::Meta::Type|Class::Meta::Type>
456
=head1 COPYRIGHT AND LICENSE
458
Copyright (c) 2002-2005, David Wheeler. All Rights Reserved.
460
This module is free software; you can redistribute it and/or modify it under
461
the same terms as Perl itself.