1 | =head1 NAME
|
---|
2 |
|
---|
3 | perltooc - Tom's OO Tutorial for Class Data in Perl
|
---|
4 |
|
---|
5 | =head1 DESCRIPTION
|
---|
6 |
|
---|
7 | When designing an object class, you are sometimes faced with the situation
|
---|
8 | of wanting common state shared by all objects of that class.
|
---|
9 | Such I<class attributes> act somewhat like global variables for the entire
|
---|
10 | class, but unlike program-wide globals, class attributes have meaning only to
|
---|
11 | the class itself.
|
---|
12 |
|
---|
13 | Here are a few examples where class attributes might come in handy:
|
---|
14 |
|
---|
15 | =over 4
|
---|
16 |
|
---|
17 | =item *
|
---|
18 |
|
---|
19 | to keep a count of the objects you've created, or how many are
|
---|
20 | still extant.
|
---|
21 |
|
---|
22 | =item *
|
---|
23 |
|
---|
24 | to extract the name or file descriptor for a logfile used by a debugging
|
---|
25 | method.
|
---|
26 |
|
---|
27 | =item *
|
---|
28 |
|
---|
29 | to access collective data, like the total amount of cash dispensed by
|
---|
30 | all ATMs in a network in a given day.
|
---|
31 |
|
---|
32 | =item *
|
---|
33 |
|
---|
34 | to access the last object created by a class, or the most accessed object,
|
---|
35 | or to retrieve a list of all objects.
|
---|
36 |
|
---|
37 | =back
|
---|
38 |
|
---|
39 | Unlike a true global, class attributes should not be accessed directly.
|
---|
40 | Instead, their state should be inspected, and perhaps altered, only
|
---|
41 | through the mediated access of I<class methods>. These class attributes
|
---|
42 | accessor methods are similar in spirit and function to accessors used
|
---|
43 | to manipulate the state of instance attributes on an object. They provide a
|
---|
44 | clear firewall between interface and implementation.
|
---|
45 |
|
---|
46 | You should allow access to class attributes through either the class
|
---|
47 | name or any object of that class. If we assume that $an_object is of
|
---|
48 | type Some_Class, and the &Some_Class::population_count method accesses
|
---|
49 | class attributes, then these two invocations should both be possible,
|
---|
50 | and almost certainly equivalent.
|
---|
51 |
|
---|
52 | Some_Class->population_count()
|
---|
53 | $an_object->population_count()
|
---|
54 |
|
---|
55 | The question is, where do you store the state which that method accesses?
|
---|
56 | Unlike more restrictive languages like C++, where these are called
|
---|
57 | static data members, Perl provides no syntactic mechanism to declare
|
---|
58 | class attributes, any more than it provides a syntactic mechanism to
|
---|
59 | declare instance attributes. Perl provides the developer with a broad
|
---|
60 | set of powerful but flexible features that can be uniquely crafted to
|
---|
61 | the particular demands of the situation.
|
---|
62 |
|
---|
63 | A class in Perl is typically implemented in a module. A module consists
|
---|
64 | of two complementary feature sets: a package for interfacing with the
|
---|
65 | outside world, and a lexical file scope for privacy. Either of these
|
---|
66 | two mechanisms can be used to implement class attributes. That means you
|
---|
67 | get to decide whether to put your class attributes in package variables
|
---|
68 | or to put them in lexical variables.
|
---|
69 |
|
---|
70 | And those aren't the only decisions to make. If you choose to use package
|
---|
71 | variables, you can make your class attribute accessor methods either ignorant
|
---|
72 | of inheritance or sensitive to it. If you choose lexical variables,
|
---|
73 | you can elect to permit access to them from anywhere in the entire file
|
---|
74 | scope, or you can limit direct data access exclusively to the methods
|
---|
75 | implementing those attributes.
|
---|
76 |
|
---|
77 | =head1 Class Data in a Can
|
---|
78 |
|
---|
79 | One of the easiest ways to solve a hard problem is to let someone else
|
---|
80 | do it for you! In this case, Class::Data::Inheritable (available on a
|
---|
81 | CPAN near you) offers a canned solution to the class data problem
|
---|
82 | using closures. So before you wade into this document, consider
|
---|
83 | having a look at that module.
|
---|
84 |
|
---|
85 |
|
---|
86 | =head1 Class Data as Package Variables
|
---|
87 |
|
---|
88 | Because a class in Perl is really just a package, using package variables
|
---|
89 | to hold class attributes is the most natural choice. This makes it simple
|
---|
90 | for each class to have its own class attributes. Let's say you have a class
|
---|
91 | called Some_Class that needs a couple of different attributes that you'd
|
---|
92 | like to be global to the entire class. The simplest thing to do is to
|
---|
93 | use package variables like $Some_Class::CData1 and $Some_Class::CData2
|
---|
94 | to hold these attributes. But we certainly don't want to encourage
|
---|
95 | outsiders to touch those data directly, so we provide methods
|
---|
96 | to mediate access.
|
---|
97 |
|
---|
98 | In the accessor methods below, we'll for now just ignore the first
|
---|
99 | argument--that part to the left of the arrow on method invocation, which
|
---|
100 | is either a class name or an object reference.
|
---|
101 |
|
---|
102 | package Some_Class;
|
---|
103 | sub CData1 {
|
---|
104 | shift; # XXX: ignore calling class/object
|
---|
105 | $Some_Class::CData1 = shift if @_;
|
---|
106 | return $Some_Class::CData1;
|
---|
107 | }
|
---|
108 | sub CData2 {
|
---|
109 | shift; # XXX: ignore calling class/object
|
---|
110 | $Some_Class::CData2 = shift if @_;
|
---|
111 | return $Some_Class::CData2;
|
---|
112 | }
|
---|
113 |
|
---|
114 | This technique is highly legible and should be completely straightforward
|
---|
115 | to even the novice Perl programmer. By fully qualifying the package
|
---|
116 | variables, they stand out clearly when reading the code. Unfortunately,
|
---|
117 | if you misspell one of these, you've introduced an error that's hard
|
---|
118 | to catch. It's also somewhat disconcerting to see the class name itself
|
---|
119 | hard-coded in so many places.
|
---|
120 |
|
---|
121 | Both these problems can be easily fixed. Just add the C<use strict>
|
---|
122 | pragma, then pre-declare your package variables. (The C<our> operator
|
---|
123 | will be new in 5.6, and will work for package globals just like C<my>
|
---|
124 | works for scoped lexicals.)
|
---|
125 |
|
---|
126 | package Some_Class;
|
---|
127 | use strict;
|
---|
128 | our($CData1, $CData2); # our() is new to perl5.6
|
---|
129 | sub CData1 {
|
---|
130 | shift; # XXX: ignore calling class/object
|
---|
131 | $CData1 = shift if @_;
|
---|
132 | return $CData1;
|
---|
133 | }
|
---|
134 | sub CData2 {
|
---|
135 | shift; # XXX: ignore calling class/object
|
---|
136 | $CData2 = shift if @_;
|
---|
137 | return $CData2;
|
---|
138 | }
|
---|
139 |
|
---|
140 |
|
---|
141 | As with any other global variable, some programmers prefer to start their
|
---|
142 | package variables with capital letters. This helps clarity somewhat, but
|
---|
143 | by no longer fully qualifying the package variables, their significance
|
---|
144 | can be lost when reading the code. You can fix this easily enough by
|
---|
145 | choosing better names than were used here.
|
---|
146 |
|
---|
147 | =head2 Putting All Your Eggs in One Basket
|
---|
148 |
|
---|
149 | Just as the mindless enumeration of accessor methods for instance attributes
|
---|
150 | grows tedious after the first few (see L<perltoot>), so too does the
|
---|
151 | repetition begin to grate when listing out accessor methods for class
|
---|
152 | data. Repetition runs counter to the primary virtue of a programmer:
|
---|
153 | Laziness, here manifesting as that innate urge every programmer feels
|
---|
154 | to factor out duplicate code whenever possible.
|
---|
155 |
|
---|
156 | Here's what to do. First, make just one hash to hold all class attributes.
|
---|
157 |
|
---|
158 | package Some_Class;
|
---|
159 | use strict;
|
---|
160 | our %ClassData = ( # our() is new to perl5.6
|
---|
161 | CData1 => "",
|
---|
162 | CData2 => "",
|
---|
163 | );
|
---|
164 |
|
---|
165 | Using closures (see L<perlref>) and direct access to the package symbol
|
---|
166 | table (see L<perlmod>), now clone an accessor method for each key in
|
---|
167 | the %ClassData hash. Each of these methods is used to fetch or store
|
---|
168 | values to the specific, named class attribute.
|
---|
169 |
|
---|
170 | for my $datum (keys %ClassData) {
|
---|
171 | no strict "refs"; # to register new methods in package
|
---|
172 | *$datum = sub {
|
---|
173 | shift; # XXX: ignore calling class/object
|
---|
174 | $ClassData{$datum} = shift if @_;
|
---|
175 | return $ClassData{$datum};
|
---|
176 | }
|
---|
177 | }
|
---|
178 |
|
---|
179 | It's true that you could work out a solution employing an &AUTOLOAD
|
---|
180 | method, but this approach is unlikely to prove satisfactory. Your
|
---|
181 | function would have to distinguish between class attributes and object
|
---|
182 | attributes; it could interfere with inheritance; and it would have to
|
---|
183 | careful about DESTROY. Such complexity is uncalled for in most cases,
|
---|
184 | and certainly in this one.
|
---|
185 |
|
---|
186 | You may wonder why we're rescinding strict refs for the loop. We're
|
---|
187 | manipulating the package's symbol table to introduce new function names
|
---|
188 | using symbolic references (indirect naming), which the strict pragma
|
---|
189 | would otherwise forbid. Normally, symbolic references are a dodgy
|
---|
190 | notion at best. This isn't just because they can be used accidentally
|
---|
191 | when you aren't meaning to. It's also because for most uses
|
---|
192 | to which beginning Perl programmers attempt to put symbolic references,
|
---|
193 | we have much better approaches, like nested hashes or hashes of arrays.
|
---|
194 | But there's nothing wrong with using symbolic references to manipulate
|
---|
195 | something that is meaningful only from the perspective of the package
|
---|
196 | symbol table, like method names or package variables. In other
|
---|
197 | words, when you want to refer to the symbol table, use symbol references.
|
---|
198 |
|
---|
199 | Clustering all the class attributes in one place has several advantages.
|
---|
200 | They're easy to spot, initialize, and change. The aggregation also
|
---|
201 | makes them convenient to access externally, such as from a debugger
|
---|
202 | or a persistence package. The only possible problem is that we don't
|
---|
203 | automatically know the name of each class's class object, should it have
|
---|
204 | one. This issue is addressed below in L<"The Eponymous Meta-Object">.
|
---|
205 |
|
---|
206 | =head2 Inheritance Concerns
|
---|
207 |
|
---|
208 | Suppose you have an instance of a derived class, and you access class
|
---|
209 | data using an inherited method call. Should that end up referring
|
---|
210 | to the base class's attributes, or to those in the derived class?
|
---|
211 | How would it work in the earlier examples? The derived class inherits
|
---|
212 | all the base class's methods, including those that access class attributes.
|
---|
213 | But what package are the class attributes stored in?
|
---|
214 |
|
---|
215 | The answer is that, as written, class attributes are stored in the package into
|
---|
216 | which those methods were compiled. When you invoke the &CData1 method
|
---|
217 | on the name of the derived class or on one of that class's objects, the
|
---|
218 | version shown above is still run, so you'll access $Some_Class::CData1--or
|
---|
219 | in the method cloning version, C<$Some_Class::ClassData{CData1}>.
|
---|
220 |
|
---|
221 | Think of these class methods as executing in the context of their base
|
---|
222 | class, not in that of their derived class. Sometimes this is exactly
|
---|
223 | what you want. If Feline subclasses Carnivore, then the population of
|
---|
224 | Carnivores in the world should go up when a new Feline is born.
|
---|
225 | But what if you wanted to figure out how many Felines you have apart
|
---|
226 | from Carnivores? The current approach doesn't support that.
|
---|
227 |
|
---|
228 | You'll have to decide on a case-by-case basis whether it makes any sense
|
---|
229 | for class attributes to be package-relative. If you want it to be so,
|
---|
230 | then stop ignoring the first argument to the function. Either it will
|
---|
231 | be a package name if the method was invoked directly on a class name,
|
---|
232 | or else it will be an object reference if the method was invoked on an
|
---|
233 | object reference. In the latter case, the ref() function provides the
|
---|
234 | class of that object.
|
---|
235 |
|
---|
236 | package Some_Class;
|
---|
237 | sub CData1 {
|
---|
238 | my $obclass = shift;
|
---|
239 | my $class = ref($obclass) || $obclass;
|
---|
240 | my $varname = $class . "::CData1";
|
---|
241 | no strict "refs"; # to access package data symbolically
|
---|
242 | $$varname = shift if @_;
|
---|
243 | return $$varname;
|
---|
244 | }
|
---|
245 |
|
---|
246 | And then do likewise for all other class attributes (such as CData2,
|
---|
247 | etc.) that you wish to access as package variables in the invoking package
|
---|
248 | instead of the compiling package as we had previously.
|
---|
249 |
|
---|
250 | Once again we temporarily disable the strict references ban, because
|
---|
251 | otherwise we couldn't use the fully-qualified symbolic name for
|
---|
252 | the package global. This is perfectly reasonable: since all package
|
---|
253 | variables by definition live in a package, there's nothing wrong with
|
---|
254 | accessing them via that package's symbol table. That's what it's there
|
---|
255 | for (well, somewhat).
|
---|
256 |
|
---|
257 | What about just using a single hash for everything and then cloning
|
---|
258 | methods? What would that look like? The only difference would be the
|
---|
259 | closure used to produce new method entries for the class's symbol table.
|
---|
260 |
|
---|
261 | no strict "refs";
|
---|
262 | *$datum = sub {
|
---|
263 | my $obclass = shift;
|
---|
264 | my $class = ref($obclass) || $obclass;
|
---|
265 | my $varname = $class . "::ClassData";
|
---|
266 | $varname->{$datum} = shift if @_;
|
---|
267 | return $varname->{$datum};
|
---|
268 | }
|
---|
269 |
|
---|
270 | =head2 The Eponymous Meta-Object
|
---|
271 |
|
---|
272 | It could be argued that the %ClassData hash in the previous example is
|
---|
273 | neither the most imaginative nor the most intuitive of names. Is there
|
---|
274 | something else that might make more sense, be more useful, or both?
|
---|
275 |
|
---|
276 | As it happens, yes, there is. For the "class meta-object", we'll use
|
---|
277 | a package variable of the same name as the package itself. Within the
|
---|
278 | scope of a package Some_Class declaration, we'll use the eponymously
|
---|
279 | named hash %Some_Class as that class's meta-object. (Using an eponymously
|
---|
280 | named hash is somewhat reminiscent of classes that name their constructors
|
---|
281 | eponymously in the Python or C++ fashion. That is, class Some_Class would
|
---|
282 | use &Some_Class::Some_Class as a constructor, probably even exporting that
|
---|
283 | name as well. The StrNum class in Recipe 13.14 in I<The Perl Cookbook>
|
---|
284 | does this, if you're looking for an example.)
|
---|
285 |
|
---|
286 | This predictable approach has many benefits, including having a well-known
|
---|
287 | identifier to aid in debugging, transparent persistence,
|
---|
288 | or checkpointing. It's also the obvious name for monadic classes and
|
---|
289 | translucent attributes, discussed later.
|
---|
290 |
|
---|
291 | Here's an example of such a class. Notice how the name of the
|
---|
292 | hash storing the meta-object is the same as the name of the package
|
---|
293 | used to implement the class.
|
---|
294 |
|
---|
295 | package Some_Class;
|
---|
296 | use strict;
|
---|
297 |
|
---|
298 | # create class meta-object using that most perfect of names
|
---|
299 | our %Some_Class = ( # our() is new to perl5.6
|
---|
300 | CData1 => "",
|
---|
301 | CData2 => "",
|
---|
302 | );
|
---|
303 |
|
---|
304 | # this accessor is calling-package-relative
|
---|
305 | sub CData1 {
|
---|
306 | my $obclass = shift;
|
---|
307 | my $class = ref($obclass) || $obclass;
|
---|
308 | no strict "refs"; # to access eponymous meta-object
|
---|
309 | $class->{CData1} = shift if @_;
|
---|
310 | return $class->{CData1};
|
---|
311 | }
|
---|
312 |
|
---|
313 | # but this accessor is not
|
---|
314 | sub CData2 {
|
---|
315 | shift; # XXX: ignore calling class/object
|
---|
316 | no strict "refs"; # to access eponymous meta-object
|
---|
317 | __PACKAGE__ -> {CData2} = shift if @_;
|
---|
318 | return __PACKAGE__ -> {CData2};
|
---|
319 | }
|
---|
320 |
|
---|
321 | In the second accessor method, the __PACKAGE__ notation was used for
|
---|
322 | two reasons. First, to avoid hardcoding the literal package name
|
---|
323 | in the code in case we later want to change that name. Second, to
|
---|
324 | clarify to the reader that what matters here is the package currently
|
---|
325 | being compiled into, not the package of the invoking object or class.
|
---|
326 | If the long sequence of non-alphabetic characters bothers you, you can
|
---|
327 | always put the __PACKAGE__ in a variable first.
|
---|
328 |
|
---|
329 | sub CData2 {
|
---|
330 | shift; # XXX: ignore calling class/object
|
---|
331 | no strict "refs"; # to access eponymous meta-object
|
---|
332 | my $class = __PACKAGE__;
|
---|
333 | $class->{CData2} = shift if @_;
|
---|
334 | return $class->{CData2};
|
---|
335 | }
|
---|
336 |
|
---|
337 | Even though we're using symbolic references for good not evil, some
|
---|
338 | folks tend to become unnerved when they see so many places with strict
|
---|
339 | ref checking disabled. Given a symbolic reference, you can always
|
---|
340 | produce a real reference (the reverse is not true, though). So we'll
|
---|
341 | create a subroutine that does this conversion for us. If invoked as a
|
---|
342 | function of no arguments, it returns a reference to the compiling class's
|
---|
343 | eponymous hash. Invoked as a class method, it returns a reference to
|
---|
344 | the eponymous hash of its caller. And when invoked as an object method,
|
---|
345 | this function returns a reference to the eponymous hash for whatever
|
---|
346 | class the object belongs to.
|
---|
347 |
|
---|
348 | package Some_Class;
|
---|
349 | use strict;
|
---|
350 |
|
---|
351 | our %Some_Class = ( # our() is new to perl5.6
|
---|
352 | CData1 => "",
|
---|
353 | CData2 => "",
|
---|
354 | );
|
---|
355 |
|
---|
356 | # tri-natured: function, class method, or object method
|
---|
357 | sub _classobj {
|
---|
358 | my $obclass = shift || __PACKAGE__;
|
---|
359 | my $class = ref($obclass) || $obclass;
|
---|
360 | no strict "refs"; # to convert sym ref to real one
|
---|
361 | return \%$class;
|
---|
362 | }
|
---|
363 |
|
---|
364 | for my $datum (keys %{ _classobj() } ) {
|
---|
365 | # turn off strict refs so that we can
|
---|
366 | # register a method in the symbol table
|
---|
367 | no strict "refs";
|
---|
368 | *$datum = sub {
|
---|
369 | use strict "refs";
|
---|
370 | my $self = shift->_classobj();
|
---|
371 | $self->{$datum} = shift if @_;
|
---|
372 | return $self->{$datum};
|
---|
373 | }
|
---|
374 | }
|
---|
375 |
|
---|
376 | =head2 Indirect References to Class Data
|
---|
377 |
|
---|
378 | A reasonably common strategy for handling class attributes is to store
|
---|
379 | a reference to each package variable on the object itself. This is
|
---|
380 | a strategy you've probably seen before, such as in L<perltoot> and
|
---|
381 | L<perlbot>, but there may be variations in the example below that you
|
---|
382 | haven't thought of before.
|
---|
383 |
|
---|
384 | package Some_Class;
|
---|
385 | our($CData1, $CData2); # our() is new to perl5.6
|
---|
386 |
|
---|
387 | sub new {
|
---|
388 | my $obclass = shift;
|
---|
389 | return bless my $self = {
|
---|
390 | ObData1 => "",
|
---|
391 | ObData2 => "",
|
---|
392 | CData1 => \$CData1,
|
---|
393 | CData2 => \$CData2,
|
---|
394 | } => (ref $obclass || $obclass);
|
---|
395 | }
|
---|
396 |
|
---|
397 | sub ObData1 {
|
---|
398 | my $self = shift;
|
---|
399 | $self->{ObData1} = shift if @_;
|
---|
400 | return $self->{ObData1};
|
---|
401 | }
|
---|
402 |
|
---|
403 | sub ObData2 {
|
---|
404 | my $self = shift;
|
---|
405 | $self->{ObData2} = shift if @_;
|
---|
406 | return $self->{ObData2};
|
---|
407 | }
|
---|
408 |
|
---|
409 | sub CData1 {
|
---|
410 | my $self = shift;
|
---|
411 | my $dataref = ref $self
|
---|
412 | ? $self->{CData1}
|
---|
413 | : \$CData1;
|
---|
414 | $$dataref = shift if @_;
|
---|
415 | return $$dataref;
|
---|
416 | }
|
---|
417 |
|
---|
418 | sub CData2 {
|
---|
419 | my $self = shift;
|
---|
420 | my $dataref = ref $self
|
---|
421 | ? $self->{CData2}
|
---|
422 | : \$CData2;
|
---|
423 | $$dataref = shift if @_;
|
---|
424 | return $$dataref;
|
---|
425 | }
|
---|
426 |
|
---|
427 | As written above, a derived class will inherit these methods, which
|
---|
428 | will consequently access package variables in the base class's package.
|
---|
429 | This is not necessarily expected behavior in all circumstances. Here's an
|
---|
430 | example that uses a variable meta-object, taking care to access the
|
---|
431 | proper package's data.
|
---|
432 |
|
---|
433 | package Some_Class;
|
---|
434 | use strict;
|
---|
435 |
|
---|
436 | our %Some_Class = ( # our() is new to perl5.6
|
---|
437 | CData1 => "",
|
---|
438 | CData2 => "",
|
---|
439 | );
|
---|
440 |
|
---|
441 | sub _classobj {
|
---|
442 | my $self = shift;
|
---|
443 | my $class = ref($self) || $self;
|
---|
444 | no strict "refs";
|
---|
445 | # get (hard) ref to eponymous meta-object
|
---|
446 | return \%$class;
|
---|
447 | }
|
---|
448 |
|
---|
449 | sub new {
|
---|
450 | my $obclass = shift;
|
---|
451 | my $classobj = $obclass->_classobj();
|
---|
452 | bless my $self = {
|
---|
453 | ObData1 => "",
|
---|
454 | ObData2 => "",
|
---|
455 | CData1 => \$classobj->{CData1},
|
---|
456 | CData2 => \$classobj->{CData2},
|
---|
457 | } => (ref $obclass || $obclass);
|
---|
458 | return $self;
|
---|
459 | }
|
---|
460 |
|
---|
461 | sub ObData1 {
|
---|
462 | my $self = shift;
|
---|
463 | $self->{ObData1} = shift if @_;
|
---|
464 | return $self->{ObData1};
|
---|
465 | }
|
---|
466 |
|
---|
467 | sub ObData2 {
|
---|
468 | my $self = shift;
|
---|
469 | $self->{ObData2} = shift if @_;
|
---|
470 | return $self->{ObData2};
|
---|
471 | }
|
---|
472 |
|
---|
473 | sub CData1 {
|
---|
474 | my $self = shift;
|
---|
475 | $self = $self->_classobj() unless ref $self;
|
---|
476 | my $dataref = $self->{CData1};
|
---|
477 | $$dataref = shift if @_;
|
---|
478 | return $$dataref;
|
---|
479 | }
|
---|
480 |
|
---|
481 | sub CData2 {
|
---|
482 | my $self = shift;
|
---|
483 | $self = $self->_classobj() unless ref $self;
|
---|
484 | my $dataref = $self->{CData2};
|
---|
485 | $$dataref = shift if @_;
|
---|
486 | return $$dataref;
|
---|
487 | }
|
---|
488 |
|
---|
489 | Not only are we now strict refs clean, using an eponymous meta-object
|
---|
490 | seems to make the code cleaner. Unlike the previous version, this one
|
---|
491 | does something interesting in the face of inheritance: it accesses the
|
---|
492 | class meta-object in the invoking class instead of the one into which
|
---|
493 | the method was initially compiled.
|
---|
494 |
|
---|
495 | You can easily access data in the class meta-object, making
|
---|
496 | it easy to dump the complete class state using an external mechanism such
|
---|
497 | as when debugging or implementing a persistent class. This works because
|
---|
498 | the class meta-object is a package variable, has a well-known name, and
|
---|
499 | clusters all its data together. (Transparent persistence
|
---|
500 | is not always feasible, but it's certainly an appealing idea.)
|
---|
501 |
|
---|
502 | There's still no check that object accessor methods have not been
|
---|
503 | invoked on a class name. If strict ref checking is enabled, you'd
|
---|
504 | blow up. If not, then you get the eponymous meta-object. What you do
|
---|
505 | with--or about--this is up to you. The next two sections demonstrate
|
---|
506 | innovative uses for this powerful feature.
|
---|
507 |
|
---|
508 | =head2 Monadic Classes
|
---|
509 |
|
---|
510 | Some of the standard modules shipped with Perl provide class interfaces
|
---|
511 | without any attribute methods whatsoever. The most commonly used module
|
---|
512 | not numbered amongst the pragmata, the Exporter module, is a class with
|
---|
513 | neither constructors nor attributes. Its job is simply to provide a
|
---|
514 | standard interface for modules wishing to export part of their namespace
|
---|
515 | into that of their caller. Modules use the Exporter's &import method by
|
---|
516 | setting their inheritance list in their package's @ISA array to mention
|
---|
517 | "Exporter". But class Exporter provides no constructor, so you can't
|
---|
518 | have several instances of the class. In fact, you can't have any--it
|
---|
519 | just doesn't make any sense. All you get is its methods. Its interface
|
---|
520 | contains no statefulness, so state data is wholly superfluous.
|
---|
521 |
|
---|
522 | Another sort of class that pops up from time to time is one that supports
|
---|
523 | a unique instance. Such classes are called I<monadic classes>, or less
|
---|
524 | formally, I<singletons> or I<highlander classes>.
|
---|
525 |
|
---|
526 | If a class is monadic, where do you store its state, that is,
|
---|
527 | its attributes? How do you make sure that there's never more than
|
---|
528 | one instance? While you could merely use a slew of package variables,
|
---|
529 | it's a lot cleaner to use the eponymously named hash. Here's a complete
|
---|
530 | example of a monadic class:
|
---|
531 |
|
---|
532 | package Cosmos;
|
---|
533 | %Cosmos = ();
|
---|
534 |
|
---|
535 | # accessor method for "name" attribute
|
---|
536 | sub name {
|
---|
537 | my $self = shift;
|
---|
538 | $self->{name} = shift if @_;
|
---|
539 | return $self->{name};
|
---|
540 | }
|
---|
541 |
|
---|
542 | # read-only accessor method for "birthday" attribute
|
---|
543 | sub birthday {
|
---|
544 | my $self = shift;
|
---|
545 | die "can't reset birthday" if @_; # XXX: croak() is better
|
---|
546 | return $self->{birthday};
|
---|
547 | }
|
---|
548 |
|
---|
549 | # accessor method for "stars" attribute
|
---|
550 | sub stars {
|
---|
551 | my $self = shift;
|
---|
552 | $self->{stars} = shift if @_;
|
---|
553 | return $self->{stars};
|
---|
554 | }
|
---|
555 |
|
---|
556 | # oh my - one of our stars just went out!
|
---|
557 | sub supernova {
|
---|
558 | my $self = shift;
|
---|
559 | my $count = $self->stars();
|
---|
560 | $self->stars($count - 1) if $count > 0;
|
---|
561 | }
|
---|
562 |
|
---|
563 | # constructor/initializer method - fix by reboot
|
---|
564 | sub bigbang {
|
---|
565 | my $self = shift;
|
---|
566 | %$self = (
|
---|
567 | name => "the world according to tchrist",
|
---|
568 | birthday => time(),
|
---|
569 | stars => 0,
|
---|
570 | );
|
---|
571 | return $self; # yes, it's probably a class. SURPRISE!
|
---|
572 | }
|
---|
573 |
|
---|
574 | # After the class is compiled, but before any use or require
|
---|
575 | # returns, we start off the universe with a bang.
|
---|
576 | __PACKAGE__ -> bigbang();
|
---|
577 |
|
---|
578 | Hold on, that doesn't look like anything special. Those attribute
|
---|
579 | accessors look no different than they would if this were a regular class
|
---|
580 | instead of a monadic one. The crux of the matter is there's nothing
|
---|
581 | that says that $self must hold a reference to a blessed object. It merely
|
---|
582 | has to be something you can invoke methods on. Here the package name
|
---|
583 | itself, Cosmos, works as an object. Look at the &supernova method. Is that
|
---|
584 | a class method or an object method? The answer is that static analysis
|
---|
585 | cannot reveal the answer. Perl doesn't care, and neither should you.
|
---|
586 | In the three attribute methods, C<%$self> is really accessing the %Cosmos
|
---|
587 | package variable.
|
---|
588 |
|
---|
589 | If like Stephen Hawking, you posit the existence of multiple, sequential,
|
---|
590 | and unrelated universes, then you can invoke the &bigbang method yourself
|
---|
591 | at any time to start everything all over again. You might think of
|
---|
592 | &bigbang as more of an initializer than a constructor, since the function
|
---|
593 | doesn't allocate new memory; it only initializes what's already there.
|
---|
594 | But like any other constructor, it does return a scalar value to use
|
---|
595 | for later method invocations.
|
---|
596 |
|
---|
597 | Imagine that some day in the future, you decide that one universe just
|
---|
598 | isn't enough. You could write a new class from scratch, but you already
|
---|
599 | have an existing class that does what you want--except that it's monadic,
|
---|
600 | and you want more than just one cosmos.
|
---|
601 |
|
---|
602 | That's what code reuse via subclassing is all about. Look how short
|
---|
603 | the new code is:
|
---|
604 |
|
---|
605 | package Multiverse;
|
---|
606 | use Cosmos;
|
---|
607 | @ISA = qw(Cosmos);
|
---|
608 |
|
---|
609 | sub new {
|
---|
610 | my $protoverse = shift;
|
---|
611 | my $class = ref($protoverse) || $protoverse;
|
---|
612 | my $self = {};
|
---|
613 | return bless($self, $class)->bigbang();
|
---|
614 | }
|
---|
615 | 1;
|
---|
616 |
|
---|
617 | Because we were careful to be good little creators when we designed our
|
---|
618 | Cosmos class, we can now reuse it without touching a single line of code
|
---|
619 | when it comes time to write our Multiverse class. The same code that
|
---|
620 | worked when invoked as a class method continues to work perfectly well
|
---|
621 | when invoked against separate instances of a derived class.
|
---|
622 |
|
---|
623 | The astonishing thing about the Cosmos class above is that the value
|
---|
624 | returned by the &bigbang "constructor" is not a reference to a blessed
|
---|
625 | object at all. It's just the class's own name. A class name is, for
|
---|
626 | virtually all intents and purposes, a perfectly acceptable object.
|
---|
627 | It has state, behavior, and identity, the three crucial components
|
---|
628 | of an object system. It even manifests inheritance, polymorphism,
|
---|
629 | and encapsulation. And what more can you ask of an object?
|
---|
630 |
|
---|
631 | To understand object orientation in Perl, it's important to recognize the
|
---|
632 | unification of what other programming languages might think of as class
|
---|
633 | methods and object methods into just plain methods. "Class methods"
|
---|
634 | and "object methods" are distinct only in the compartmentalizing mind
|
---|
635 | of the Perl programmer, not in the Perl language itself.
|
---|
636 |
|
---|
637 | Along those same lines, a constructor is nothing special either, which
|
---|
638 | is one reason why Perl has no pre-ordained name for them. "Constructor"
|
---|
639 | is just an informal term loosely used to describe a method that returns
|
---|
640 | a scalar value that you can make further method calls against. So long
|
---|
641 | as it's either a class name or an object reference, that's good enough.
|
---|
642 | It doesn't even have to be a reference to a brand new object.
|
---|
643 |
|
---|
644 | You can have as many--or as few--constructors as you want, and you can
|
---|
645 | name them whatever you care to. Blindly and obediently using new()
|
---|
646 | for each and every constructor you ever write is to speak Perl with
|
---|
647 | such a severe C++ accent that you do a disservice to both languages.
|
---|
648 | There's no reason to insist that each class have but one constructor,
|
---|
649 | or that a constructor be named new(), or that a constructor be
|
---|
650 | used solely as a class method and not an object method.
|
---|
651 |
|
---|
652 | The next section shows how useful it can be to further distance ourselves
|
---|
653 | from any formal distinction between class method calls and object method
|
---|
654 | calls, both in constructors and in accessor methods.
|
---|
655 |
|
---|
656 | =head2 Translucent Attributes
|
---|
657 |
|
---|
658 | A package's eponymous hash can be used for more than just containing
|
---|
659 | per-class, global state data. It can also serve as a sort of template
|
---|
660 | containing default settings for object attributes. These default
|
---|
661 | settings can then be used in constructors for initialization of a
|
---|
662 | particular object. The class's eponymous hash can also be used to
|
---|
663 | implement I<translucent attributes>. A translucent attribute is one
|
---|
664 | that has a class-wide default. Each object can set its own value for the
|
---|
665 | attribute, in which case C<< $object->attribute() >> returns that value.
|
---|
666 | But if no value has been set, then C<< $object->attribute() >> returns
|
---|
667 | the class-wide default.
|
---|
668 |
|
---|
669 | We'll apply something of a copy-on-write approach to these translucent
|
---|
670 | attributes. If you're just fetching values from them, you get
|
---|
671 | translucency. But if you store a new value to them, that new value is
|
---|
672 | set on the current object. On the other hand, if you use the class as
|
---|
673 | an object and store the attribute value directly on the class, then the
|
---|
674 | meta-object's value changes, and later fetch operations on objects with
|
---|
675 | uninitialized values for those attributes will retrieve the meta-object's
|
---|
676 | new values. Objects with their own initialized values, however, won't
|
---|
677 | see any change.
|
---|
678 |
|
---|
679 | Let's look at some concrete examples of using these properties before we
|
---|
680 | show how to implement them. Suppose that a class named Some_Class
|
---|
681 | had a translucent data attribute called "color". First you set the color
|
---|
682 | in the meta-object, then you create three objects using a constructor
|
---|
683 | that happens to be named &spawn.
|
---|
684 |
|
---|
685 | use Vermin;
|
---|
686 | Vermin->color("vermilion");
|
---|
687 |
|
---|
688 | $ob1 = Vermin->spawn(); # so that's where Jedi come from
|
---|
689 | $ob2 = Vermin->spawn();
|
---|
690 | $ob3 = Vermin->spawn();
|
---|
691 |
|
---|
692 | print $obj3->color(); # prints "vermilion"
|
---|
693 |
|
---|
694 | Each of these objects' colors is now "vermilion", because that's the
|
---|
695 | meta-object's value for that attribute, and these objects do not have
|
---|
696 | individual color values set.
|
---|
697 |
|
---|
698 | Changing the attribute on one object has no effect on other objects
|
---|
699 | previously created.
|
---|
700 |
|
---|
701 | $ob3->color("chartreuse");
|
---|
702 | print $ob3->color(); # prints "chartreuse"
|
---|
703 | print $ob1->color(); # prints "vermilion", translucently
|
---|
704 |
|
---|
705 | If you now use $ob3 to spawn off another object, the new object will
|
---|
706 | take the color its parent held, which now happens to be "chartreuse".
|
---|
707 | That's because the constructor uses the invoking object as its template
|
---|
708 | for initializing attributes. When that invoking object is the
|
---|
709 | class name, the object used as a template is the eponymous meta-object.
|
---|
710 | When the invoking object is a reference to an instantiated object, the
|
---|
711 | &spawn constructor uses that existing object as a template.
|
---|
712 |
|
---|
713 | $ob4 = $ob3->spawn(); # $ob3 now template, not %Vermin
|
---|
714 | print $ob4->color(); # prints "chartreuse"
|
---|
715 |
|
---|
716 | Any actual values set on the template object will be copied to the
|
---|
717 | new object. But attributes undefined in the template object, being
|
---|
718 | translucent, will remain undefined and consequently translucent in the
|
---|
719 | new one as well.
|
---|
720 |
|
---|
721 | Now let's change the color attribute on the entire class:
|
---|
722 |
|
---|
723 | Vermin->color("azure");
|
---|
724 | print $ob1->color(); # prints "azure"
|
---|
725 | print $ob2->color(); # prints "azure"
|
---|
726 | print $ob3->color(); # prints "chartreuse"
|
---|
727 | print $ob4->color(); # prints "chartreuse"
|
---|
728 |
|
---|
729 | That color change took effect only in the first pair of objects, which
|
---|
730 | were still translucently accessing the meta-object's values. The second
|
---|
731 | pair had per-object initialized colors, and so didn't change.
|
---|
732 |
|
---|
733 | One important question remains. Changes to the meta-object are reflected
|
---|
734 | in translucent attributes in the entire class, but what about
|
---|
735 | changes to discrete objects? If you change the color of $ob3, does the
|
---|
736 | value of $ob4 see that change? Or vice-versa. If you change the color
|
---|
737 | of $ob4, does then the value of $ob3 shift?
|
---|
738 |
|
---|
739 | $ob3->color("amethyst");
|
---|
740 | print $ob3->color(); # prints "amethyst"
|
---|
741 | print $ob4->color(); # hmm: "chartreuse" or "amethyst"?
|
---|
742 |
|
---|
743 | While one could argue that in certain rare cases it should, let's not
|
---|
744 | do that. Good taste aside, we want the answer to the question posed in
|
---|
745 | the comment above to be "chartreuse", not "amethyst". So we'll treat
|
---|
746 | these attributes similar to the way process attributes like environment
|
---|
747 | variables, user and group IDs, or the current working directory are
|
---|
748 | treated across a fork(). You can change only yourself, but you will see
|
---|
749 | those changes reflected in your unspawned children. Changes to one object
|
---|
750 | will propagate neither up to the parent nor down to any existing child objects.
|
---|
751 | Those objects made later, however, will see the changes.
|
---|
752 |
|
---|
753 | If you have an object with an actual attribute value, and you want to
|
---|
754 | make that object's attribute value translucent again, what do you do?
|
---|
755 | Let's design the class so that when you invoke an accessor method with
|
---|
756 | C<undef> as its argument, that attribute returns to translucency.
|
---|
757 |
|
---|
758 | $ob4->color(undef); # back to "azure"
|
---|
759 |
|
---|
760 | Here's a complete implementation of Vermin as described above.
|
---|
761 |
|
---|
762 | package Vermin;
|
---|
763 |
|
---|
764 | # here's the class meta-object, eponymously named.
|
---|
765 | # it holds all class attributes, and also all instance attributes
|
---|
766 | # so the latter can be used for both initialization
|
---|
767 | # and translucency.
|
---|
768 |
|
---|
769 | our %Vermin = ( # our() is new to perl5.6
|
---|
770 | PopCount => 0, # capital for class attributes
|
---|
771 | color => "beige", # small for instance attributes
|
---|
772 | );
|
---|
773 |
|
---|
774 | # constructor method
|
---|
775 | # invoked as class method or object method
|
---|
776 | sub spawn {
|
---|
777 | my $obclass = shift;
|
---|
778 | my $class = ref($obclass) || $obclass;
|
---|
779 | my $self = {};
|
---|
780 | bless($self, $class);
|
---|
781 | $class->{PopCount}++;
|
---|
782 | # init fields from invoking object, or omit if
|
---|
783 | # invoking object is the class to provide translucency
|
---|
784 | %$self = %$obclass if ref $obclass;
|
---|
785 | return $self;
|
---|
786 | }
|
---|
787 |
|
---|
788 | # translucent accessor for "color" attribute
|
---|
789 | # invoked as class method or object method
|
---|
790 | sub color {
|
---|
791 | my $self = shift;
|
---|
792 | my $class = ref($self) || $self;
|
---|
793 |
|
---|
794 | # handle class invocation
|
---|
795 | unless (ref $self) {
|
---|
796 | $class->{color} = shift if @_;
|
---|
797 | return $class->{color}
|
---|
798 | }
|
---|
799 |
|
---|
800 | # handle object invocation
|
---|
801 | $self->{color} = shift if @_;
|
---|
802 | if (defined $self->{color}) { # not exists!
|
---|
803 | return $self->{color};
|
---|
804 | } else {
|
---|
805 | return $class->{color};
|
---|
806 | }
|
---|
807 | }
|
---|
808 |
|
---|
809 | # accessor for "PopCount" class attribute
|
---|
810 | # invoked as class method or object method
|
---|
811 | # but uses object solely to locate meta-object
|
---|
812 | sub population {
|
---|
813 | my $obclass = shift;
|
---|
814 | my $class = ref($obclass) || $obclass;
|
---|
815 | return $class->{PopCount};
|
---|
816 | }
|
---|
817 |
|
---|
818 | # instance destructor
|
---|
819 | # invoked only as object method
|
---|
820 | sub DESTROY {
|
---|
821 | my $self = shift;
|
---|
822 | my $class = ref $self;
|
---|
823 | $class->{PopCount}--;
|
---|
824 | }
|
---|
825 |
|
---|
826 | Here are a couple of helper methods that might be convenient. They aren't
|
---|
827 | accessor methods at all. They're used to detect accessibility of data
|
---|
828 | attributes. The &is_translucent method determines whether a particular
|
---|
829 | object attribute is coming from the meta-object. The &has_attribute
|
---|
830 | method detects whether a class implements a particular property at all.
|
---|
831 | It could also be used to distinguish undefined properties from non-existent
|
---|
832 | ones.
|
---|
833 |
|
---|
834 | # detect whether an object attribute is translucent
|
---|
835 | # (typically?) invoked only as object method
|
---|
836 | sub is_translucent {
|
---|
837 | my($self, $attr) = @_;
|
---|
838 | return !defined $self->{$attr};
|
---|
839 | }
|
---|
840 |
|
---|
841 | # test for presence of attribute in class
|
---|
842 | # invoked as class method or object method
|
---|
843 | sub has_attribute {
|
---|
844 | my($self, $attr) = @_;
|
---|
845 | my $class = ref($self) || $self;
|
---|
846 | return exists $class->{$attr};
|
---|
847 | }
|
---|
848 |
|
---|
849 | If you prefer to install your accessors more generically, you can make
|
---|
850 | use of the upper-case versus lower-case convention to register into the
|
---|
851 | package appropriate methods cloned from generic closures.
|
---|
852 |
|
---|
853 | for my $datum (keys %{ +__PACKAGE__ }) {
|
---|
854 | *$datum = ($datum =~ /^[A-Z]/)
|
---|
855 | ? sub { # install class accessor
|
---|
856 | my $obclass = shift;
|
---|
857 | my $class = ref($obclass) || $obclass;
|
---|
858 | return $class->{$datum};
|
---|
859 | }
|
---|
860 | : sub { # install translucent accessor
|
---|
861 | my $self = shift;
|
---|
862 | my $class = ref($self) || $self;
|
---|
863 | unless (ref $self) {
|
---|
864 | $class->{$datum} = shift if @_;
|
---|
865 | return $class->{$datum}
|
---|
866 | }
|
---|
867 | $self->{$datum} = shift if @_;
|
---|
868 | return defined $self->{$datum}
|
---|
869 | ? $self -> {$datum}
|
---|
870 | : $class -> {$datum}
|
---|
871 | }
|
---|
872 | }
|
---|
873 |
|
---|
874 | Translations of this closure-based approach into C++, Java, and Python
|
---|
875 | have been left as exercises for the reader. Be sure to send us mail as
|
---|
876 | soon as you're done.
|
---|
877 |
|
---|
878 | =head1 Class Data as Lexical Variables
|
---|
879 |
|
---|
880 | =head2 Privacy and Responsibility
|
---|
881 |
|
---|
882 | Unlike conventions used by some Perl programmers, in the previous
|
---|
883 | examples, we didn't prefix the package variables used for class attributes
|
---|
884 | with an underscore, nor did we do so for the names of the hash keys used
|
---|
885 | for instance attributes. You don't need little markers on data names to
|
---|
886 | suggest nominal privacy on attribute variables or hash keys, because these
|
---|
887 | are B<already> notionally private! Outsiders have no business whatsoever
|
---|
888 | playing with anything within a class save through the mediated access of
|
---|
889 | its documented interface; in other words, through method invocations.
|
---|
890 | And not even through just any method, either. Methods that begin with
|
---|
891 | an underscore are traditionally considered off-limits outside the class.
|
---|
892 | If outsiders skip the documented method interface to poke around the
|
---|
893 | internals of your class and end up breaking something, that's not your
|
---|
894 | fault--it's theirs.
|
---|
895 |
|
---|
896 | Perl believes in individual responsibility rather than mandated control.
|
---|
897 | Perl respects you enough to let you choose your own preferred level of
|
---|
898 | pain, or of pleasure. Perl believes that you are creative, intelligent,
|
---|
899 | and capable of making your own decisions--and fully expects you to
|
---|
900 | take complete responsibility for your own actions. In a perfect world,
|
---|
901 | these admonitions alone would suffice, and everyone would be intelligent,
|
---|
902 | responsible, happy, and creative. And careful. One probably shouldn't
|
---|
903 | forget careful, and that's a good bit harder to expect. Even Einstein
|
---|
904 | would take wrong turns by accident and end up lost in the wrong part
|
---|
905 | of town.
|
---|
906 |
|
---|
907 | Some folks get the heebie-jeebies when they see package variables
|
---|
908 | hanging out there for anyone to reach over and alter them. Some folks
|
---|
909 | live in constant fear that someone somewhere might do something wicked.
|
---|
910 | The solution to that problem is simply to fire the wicked, of course.
|
---|
911 | But unfortunately, it's not as simple as all that. These cautious
|
---|
912 | types are also afraid that they or others will do something not so
|
---|
913 | much wicked as careless, whether by accident or out of desperation.
|
---|
914 | If we fire everyone who ever gets careless, pretty soon there won't be
|
---|
915 | anybody left to get any work done.
|
---|
916 |
|
---|
917 | Whether it's needless paranoia or sensible caution, this uneasiness can
|
---|
918 | be a problem for some people. We can take the edge off their discomfort
|
---|
919 | by providing the option of storing class attributes as lexical variables
|
---|
920 | instead of as package variables. The my() operator is the source of
|
---|
921 | all privacy in Perl, and it is a powerful form of privacy indeed.
|
---|
922 |
|
---|
923 | It is widely perceived, and indeed has often been written, that Perl
|
---|
924 | provides no data hiding, that it affords the class designer no privacy
|
---|
925 | nor isolation, merely a rag-tag assortment of weak and unenforceable
|
---|
926 | social conventions instead. This perception is demonstrably false and
|
---|
927 | easily disproven. In the next section, we show how to implement forms
|
---|
928 | of privacy that are far stronger than those provided in nearly any
|
---|
929 | other object-oriented language.
|
---|
930 |
|
---|
931 | =head2 File-Scoped Lexicals
|
---|
932 |
|
---|
933 | A lexical variable is visible only through the end of its static scope.
|
---|
934 | That means that the only code able to access that variable is code
|
---|
935 | residing textually below the my() operator through the end of its block
|
---|
936 | if it has one, or through the end of the current file if it doesn't.
|
---|
937 |
|
---|
938 | Starting again with our simplest example given at the start of this
|
---|
939 | document, we replace our() variables with my() versions.
|
---|
940 |
|
---|
941 | package Some_Class;
|
---|
942 | my($CData1, $CData2); # file scope, not in any package
|
---|
943 | sub CData1 {
|
---|
944 | shift; # XXX: ignore calling class/object
|
---|
945 | $CData1 = shift if @_;
|
---|
946 | return $CData1;
|
---|
947 | }
|
---|
948 | sub CData2 {
|
---|
949 | shift; # XXX: ignore calling class/object
|
---|
950 | $CData2 = shift if @_;
|
---|
951 | return $CData2;
|
---|
952 | }
|
---|
953 |
|
---|
954 | So much for that old $Some_Class::CData1 package variable and its brethren!
|
---|
955 | Those are gone now, replaced with lexicals. No one outside the
|
---|
956 | scope can reach in and alter the class state without resorting to the
|
---|
957 | documented interface. Not even subclasses or superclasses of
|
---|
958 | this one have unmediated access to $CData1. They have to invoke the &CData1
|
---|
959 | method against Some_Class or an instance thereof, just like anybody else.
|
---|
960 |
|
---|
961 | To be scrupulously honest, that last statement assumes you haven't packed
|
---|
962 | several classes together into the same file scope, nor strewn your class
|
---|
963 | implementation across several different files. Accessibility of those
|
---|
964 | variables is based uniquely on the static file scope. It has nothing to
|
---|
965 | do with the package. That means that code in a different file but
|
---|
966 | the same package (class) could not access those variables, yet code in the
|
---|
967 | same file but a different package (class) could. There are sound reasons
|
---|
968 | why we usually suggest a one-to-one mapping between files and packages
|
---|
969 | and modules and classes. You don't have to stick to this suggestion if
|
---|
970 | you really know what you're doing, but you're apt to confuse yourself
|
---|
971 | otherwise, especially at first.
|
---|
972 |
|
---|
973 | If you'd like to aggregate your class attributes into one lexically scoped,
|
---|
974 | composite structure, you're perfectly free to do so.
|
---|
975 |
|
---|
976 | package Some_Class;
|
---|
977 | my %ClassData = (
|
---|
978 | CData1 => "",
|
---|
979 | CData2 => "",
|
---|
980 | );
|
---|
981 | sub CData1 {
|
---|
982 | shift; # XXX: ignore calling class/object
|
---|
983 | $ClassData{CData1} = shift if @_;
|
---|
984 | return $ClassData{CData1};
|
---|
985 | }
|
---|
986 | sub CData2 {
|
---|
987 | shift; # XXX: ignore calling class/object
|
---|
988 | $ClassData{CData2} = shift if @_;
|
---|
989 | return $ClassData{CData2};
|
---|
990 | }
|
---|
991 |
|
---|
992 | To make this more scalable as other class attributes are added, we can
|
---|
993 | again register closures into the package symbol table to create accessor
|
---|
994 | methods for them.
|
---|
995 |
|
---|
996 | package Some_Class;
|
---|
997 | my %ClassData = (
|
---|
998 | CData1 => "",
|
---|
999 | CData2 => "",
|
---|
1000 | );
|
---|
1001 | for my $datum (keys %ClassData) {
|
---|
1002 | no strict "refs";
|
---|
1003 | *$datum = sub {
|
---|
1004 | shift; # XXX: ignore calling class/object
|
---|
1005 | $ClassData{$datum} = shift if @_;
|
---|
1006 | return $ClassData{$datum};
|
---|
1007 | };
|
---|
1008 | }
|
---|
1009 |
|
---|
1010 | Requiring even your own class to use accessor methods like anybody else is
|
---|
1011 | probably a good thing. But demanding and expecting that everyone else,
|
---|
1012 | be they subclass or superclass, friend or foe, will all come to your
|
---|
1013 | object through mediation is more than just a good idea. It's absolutely
|
---|
1014 | critical to the model. Let there be in your mind no such thing as
|
---|
1015 | "public" data, nor even "protected" data, which is a seductive but
|
---|
1016 | ultimately destructive notion. Both will come back to bite at you.
|
---|
1017 | That's because as soon as you take that first step out of the solid
|
---|
1018 | position in which all state is considered completely private, save from the
|
---|
1019 | perspective of its own accessor methods, you have violated the envelope.
|
---|
1020 | And, having pierced that encapsulating envelope, you shall doubtless
|
---|
1021 | someday pay the price when future changes in the implementation break
|
---|
1022 | unrelated code. Considering that avoiding this infelicitous outcome was
|
---|
1023 | precisely why you consented to suffer the slings and arrows of obsequious
|
---|
1024 | abstraction by turning to object orientation in the first place, such
|
---|
1025 | breakage seems unfortunate in the extreme.
|
---|
1026 |
|
---|
1027 | =head2 More Inheritance Concerns
|
---|
1028 |
|
---|
1029 | Suppose that Some_Class were used as a base class from which to derive
|
---|
1030 | Another_Class. If you invoke a &CData method on the derived class or
|
---|
1031 | on an object of that class, what do you get? Would the derived class
|
---|
1032 | have its own state, or would it piggyback on its base class's versions
|
---|
1033 | of the class attributes?
|
---|
1034 |
|
---|
1035 | The answer is that under the scheme outlined above, the derived class
|
---|
1036 | would B<not> have its own state data. As before, whether you consider
|
---|
1037 | this a good thing or a bad one depends on the semantics of the classes
|
---|
1038 | involved.
|
---|
1039 |
|
---|
1040 | The cleanest, sanest, simplest way to address per-class state in a
|
---|
1041 | lexical is for the derived class to override its base class's version
|
---|
1042 | of the method that accesses the class attributes. Since the actual method
|
---|
1043 | called is the one in the object's derived class if this exists, you
|
---|
1044 | automatically get per-class state this way. Any urge to provide an
|
---|
1045 | unadvertised method to sneak out a reference to the %ClassData hash
|
---|
1046 | should be strenuously resisted.
|
---|
1047 |
|
---|
1048 | As with any other overridden method, the implementation in the
|
---|
1049 | derived class always has the option of invoking its base class's
|
---|
1050 | version of the method in addition to its own. Here's an example:
|
---|
1051 |
|
---|
1052 | package Another_Class;
|
---|
1053 | @ISA = qw(Some_Class);
|
---|
1054 |
|
---|
1055 | my %ClassData = (
|
---|
1056 | CData1 => "",
|
---|
1057 | );
|
---|
1058 |
|
---|
1059 | sub CData1 {
|
---|
1060 | my($self, $newvalue) = @_;
|
---|
1061 | if (@_ > 1) {
|
---|
1062 | # set locally first
|
---|
1063 | $ClassData{CData1} = $newvalue;
|
---|
1064 |
|
---|
1065 | # then pass the buck up to the first
|
---|
1066 | # overridden version, if there is one
|
---|
1067 | if ($self->can("SUPER::CData1")) {
|
---|
1068 | $self->SUPER::CData1($newvalue);
|
---|
1069 | }
|
---|
1070 | }
|
---|
1071 | return $ClassData{CData1};
|
---|
1072 | }
|
---|
1073 |
|
---|
1074 | Those dabbling in multiple inheritance might be concerned
|
---|
1075 | about there being more than one override.
|
---|
1076 |
|
---|
1077 | for my $parent (@ISA) {
|
---|
1078 | my $methname = $parent . "::CData1";
|
---|
1079 | if ($self->can($methname)) {
|
---|
1080 | $self->$methname($newvalue);
|
---|
1081 | }
|
---|
1082 | }
|
---|
1083 |
|
---|
1084 | Because the &UNIVERSAL::can method returns a reference
|
---|
1085 | to the function directly, you can use this directly
|
---|
1086 | for a significant performance improvement:
|
---|
1087 |
|
---|
1088 | for my $parent (@ISA) {
|
---|
1089 | if (my $coderef = $self->can($parent . "::CData1")) {
|
---|
1090 | $self->$coderef($newvalue);
|
---|
1091 | }
|
---|
1092 | }
|
---|
1093 |
|
---|
1094 | If you override C<UNIVERSAL::can> in your own classes, be sure to return the
|
---|
1095 | reference appropriately.
|
---|
1096 |
|
---|
1097 | =head2 Locking the Door and Throwing Away the Key
|
---|
1098 |
|
---|
1099 | As currently implemented, any code within the same scope as the
|
---|
1100 | file-scoped lexical %ClassData can alter that hash directly. Is that
|
---|
1101 | ok? Is it acceptable or even desirable to allow other parts of the
|
---|
1102 | implementation of this class to access class attributes directly?
|
---|
1103 |
|
---|
1104 | That depends on how careful you want to be. Think back to the Cosmos
|
---|
1105 | class. If the &supernova method had directly altered $Cosmos::Stars or
|
---|
1106 | C<$Cosmos::Cosmos{stars}>, then we wouldn't have been able to reuse the
|
---|
1107 | class when it came to inventing a Multiverse. So letting even the class
|
---|
1108 | itself access its own class attributes without the mediating intervention of
|
---|
1109 | properly designed accessor methods is probably not a good idea after all.
|
---|
1110 |
|
---|
1111 | Restricting access to class attributes from the class itself is usually
|
---|
1112 | not enforceable even in strongly object-oriented languages. But in Perl,
|
---|
1113 | you can.
|
---|
1114 |
|
---|
1115 | Here's one way:
|
---|
1116 |
|
---|
1117 | package Some_Class;
|
---|
1118 |
|
---|
1119 | { # scope for hiding $CData1
|
---|
1120 | my $CData1;
|
---|
1121 | sub CData1 {
|
---|
1122 | shift; # XXX: unused
|
---|
1123 | $CData1 = shift if @_;
|
---|
1124 | return $CData1;
|
---|
1125 | }
|
---|
1126 | }
|
---|
1127 |
|
---|
1128 | { # scope for hiding $CData2
|
---|
1129 | my $CData2;
|
---|
1130 | sub CData2 {
|
---|
1131 | shift; # XXX: unused
|
---|
1132 | $CData2 = shift if @_;
|
---|
1133 | return $CData2;
|
---|
1134 | }
|
---|
1135 | }
|
---|
1136 |
|
---|
1137 | No one--absolutely no one--is allowed to read or write the class
|
---|
1138 | attributes without the mediation of the managing accessor method, since
|
---|
1139 | only that method has access to the lexical variable it's managing.
|
---|
1140 | This use of mediated access to class attributes is a form of privacy far
|
---|
1141 | stronger than most OO languages provide.
|
---|
1142 |
|
---|
1143 | The repetition of code used to create per-datum accessor methods chafes
|
---|
1144 | at our Laziness, so we'll again use closures to create similar
|
---|
1145 | methods.
|
---|
1146 |
|
---|
1147 | package Some_Class;
|
---|
1148 |
|
---|
1149 | { # scope for ultra-private meta-object for class attributes
|
---|
1150 | my %ClassData = (
|
---|
1151 | CData1 => "",
|
---|
1152 | CData2 => "",
|
---|
1153 | );
|
---|
1154 |
|
---|
1155 | for my $datum (keys %ClassData ) {
|
---|
1156 | no strict "refs";
|
---|
1157 | *$datum = sub {
|
---|
1158 | use strict "refs";
|
---|
1159 | my ($self, $newvalue) = @_;
|
---|
1160 | $ClassData{$datum} = $newvalue if @_ > 1;
|
---|
1161 | return $ClassData{$datum};
|
---|
1162 | }
|
---|
1163 | }
|
---|
1164 |
|
---|
1165 | }
|
---|
1166 |
|
---|
1167 | The closure above can be modified to take inheritance into account using
|
---|
1168 | the &UNIVERSAL::can method and SUPER as shown previously.
|
---|
1169 |
|
---|
1170 | =head2 Translucency Revisited
|
---|
1171 |
|
---|
1172 | The Vermin class demonstrates translucency using a package variable,
|
---|
1173 | eponymously named %Vermin, as its meta-object. If you prefer to
|
---|
1174 | use absolutely no package variables beyond those necessary to appease
|
---|
1175 | inheritance or possibly the Exporter, this strategy is closed to you.
|
---|
1176 | That's too bad, because translucent attributes are an appealing
|
---|
1177 | technique, so it would be valuable to devise an implementation using
|
---|
1178 | only lexicals.
|
---|
1179 |
|
---|
1180 | There's a second reason why you might wish to avoid the eponymous
|
---|
1181 | package hash. If you use class names with double-colons in them, you
|
---|
1182 | would end up poking around somewhere you might not have meant to poke.
|
---|
1183 |
|
---|
1184 | package Vermin;
|
---|
1185 | $class = "Vermin";
|
---|
1186 | $class->{PopCount}++;
|
---|
1187 | # accesses $Vermin::Vermin{PopCount}
|
---|
1188 |
|
---|
1189 | package Vermin::Noxious;
|
---|
1190 | $class = "Vermin::Noxious";
|
---|
1191 | $class->{PopCount}++;
|
---|
1192 | # accesses $Vermin::Noxious{PopCount}
|
---|
1193 |
|
---|
1194 | In the first case, because the class name had no double-colons, we got
|
---|
1195 | the hash in the current package. But in the second case, instead of
|
---|
1196 | getting some hash in the current package, we got the hash %Noxious in
|
---|
1197 | the Vermin package. (The noxious vermin just invaded another package and
|
---|
1198 | sprayed their data around it. :-) Perl doesn't support relative packages
|
---|
1199 | in its naming conventions, so any double-colons trigger a fully-qualified
|
---|
1200 | lookup instead of just looking in the current package.
|
---|
1201 |
|
---|
1202 | In practice, it is unlikely that the Vermin class had an existing
|
---|
1203 | package variable named %Noxious that you just blew away. If you're
|
---|
1204 | still mistrustful, you could always stake out your own territory
|
---|
1205 | where you know the rules, such as using Eponymous::Vermin::Noxious or
|
---|
1206 | Hieronymus::Vermin::Boschious or Leave_Me_Alone::Vermin::Noxious as class
|
---|
1207 | names instead. Sure, it's in theory possible that someone else has
|
---|
1208 | a class named Eponymous::Vermin with its own %Noxious hash, but this
|
---|
1209 | kind of thing is always true. There's no arbiter of package names.
|
---|
1210 | It's always the case that globals like @Cwd::ISA would collide if more
|
---|
1211 | than one class uses the same Cwd package.
|
---|
1212 |
|
---|
1213 | If this still leaves you with an uncomfortable twinge of paranoia,
|
---|
1214 | we have another solution for you. There's nothing that says that you
|
---|
1215 | have to have a package variable to hold a class meta-object, either for
|
---|
1216 | monadic classes or for translucent attributes. Just code up the methods
|
---|
1217 | so that they access a lexical instead.
|
---|
1218 |
|
---|
1219 | Here's another implementation of the Vermin class with semantics identical
|
---|
1220 | to those given previously, but this time using no package variables.
|
---|
1221 |
|
---|
1222 | package Vermin;
|
---|
1223 |
|
---|
1224 |
|
---|
1225 | # Here's the class meta-object, eponymously named.
|
---|
1226 | # It holds all class data, and also all instance data
|
---|
1227 | # so the latter can be used for both initialization
|
---|
1228 | # and translucency. it's a template.
|
---|
1229 | my %ClassData = (
|
---|
1230 | PopCount => 0, # capital for class attributes
|
---|
1231 | color => "beige", # small for instance attributes
|
---|
1232 | );
|
---|
1233 |
|
---|
1234 | # constructor method
|
---|
1235 | # invoked as class method or object method
|
---|
1236 | sub spawn {
|
---|
1237 | my $obclass = shift;
|
---|
1238 | my $class = ref($obclass) || $obclass;
|
---|
1239 | my $self = {};
|
---|
1240 | bless($self, $class);
|
---|
1241 | $ClassData{PopCount}++;
|
---|
1242 | # init fields from invoking object, or omit if
|
---|
1243 | # invoking object is the class to provide translucency
|
---|
1244 | %$self = %$obclass if ref $obclass;
|
---|
1245 | return $self;
|
---|
1246 | }
|
---|
1247 |
|
---|
1248 | # translucent accessor for "color" attribute
|
---|
1249 | # invoked as class method or object method
|
---|
1250 | sub color {
|
---|
1251 | my $self = shift;
|
---|
1252 |
|
---|
1253 | # handle class invocation
|
---|
1254 | unless (ref $self) {
|
---|
1255 | $ClassData{color} = shift if @_;
|
---|
1256 | return $ClassData{color}
|
---|
1257 | }
|
---|
1258 |
|
---|
1259 | # handle object invocation
|
---|
1260 | $self->{color} = shift if @_;
|
---|
1261 | if (defined $self->{color}) { # not exists!
|
---|
1262 | return $self->{color};
|
---|
1263 | } else {
|
---|
1264 | return $ClassData{color};
|
---|
1265 | }
|
---|
1266 | }
|
---|
1267 |
|
---|
1268 | # class attribute accessor for "PopCount" attribute
|
---|
1269 | # invoked as class method or object method
|
---|
1270 | sub population {
|
---|
1271 | return $ClassData{PopCount};
|
---|
1272 | }
|
---|
1273 |
|
---|
1274 | # instance destructor; invoked only as object method
|
---|
1275 | sub DESTROY {
|
---|
1276 | $ClassData{PopCount}--;
|
---|
1277 | }
|
---|
1278 |
|
---|
1279 | # detect whether an object attribute is translucent
|
---|
1280 | # (typically?) invoked only as object method
|
---|
1281 | sub is_translucent {
|
---|
1282 | my($self, $attr) = @_;
|
---|
1283 | $self = \%ClassData if !ref $self;
|
---|
1284 | return !defined $self->{$attr};
|
---|
1285 | }
|
---|
1286 |
|
---|
1287 | # test for presence of attribute in class
|
---|
1288 | # invoked as class method or object method
|
---|
1289 | sub has_attribute {
|
---|
1290 | my($self, $attr) = @_;
|
---|
1291 | return exists $ClassData{$attr};
|
---|
1292 | }
|
---|
1293 |
|
---|
1294 | =head1 NOTES
|
---|
1295 |
|
---|
1296 | Inheritance is a powerful but subtle device, best used only after careful
|
---|
1297 | forethought and design. Aggregation instead of inheritance is often a
|
---|
1298 | better approach.
|
---|
1299 |
|
---|
1300 | You can't use file-scoped lexicals in conjunction with the SelfLoader
|
---|
1301 | or the AutoLoader, because they alter the lexical scope in which the
|
---|
1302 | module's methods wind up getting compiled.
|
---|
1303 |
|
---|
1304 | The usual mealy-mouthed package-munging doubtless applies to setting
|
---|
1305 | up names of object attributes. For example, C<< $self->{ObData1} >>
|
---|
1306 | should probably be C<< $self->{ __PACKAGE__ . "_ObData1" } >>, but that
|
---|
1307 | would just confuse the examples.
|
---|
1308 |
|
---|
1309 | =head1 SEE ALSO
|
---|
1310 |
|
---|
1311 | L<perltoot>, L<perlobj>, L<perlmod>, and L<perlbot>.
|
---|
1312 |
|
---|
1313 | The Tie::SecureHash and Class::Data::Inheritable modules from CPAN are
|
---|
1314 | worth checking out.
|
---|
1315 |
|
---|
1316 | =head1 AUTHOR AND COPYRIGHT
|
---|
1317 |
|
---|
1318 | Copyright (c) 1999 Tom Christiansen.
|
---|
1319 | All rights reserved.
|
---|
1320 |
|
---|
1321 | This documentation is free; you can redistribute it and/or modify it
|
---|
1322 | under the same terms as Perl itself.
|
---|
1323 |
|
---|
1324 | Irrespective of its distribution, all code examples in this file
|
---|
1325 | are hereby placed into the public domain. You are permitted and
|
---|
1326 | encouraged to use this code in your own programs for fun
|
---|
1327 | or for profit as you see fit. A simple comment in the code giving
|
---|
1328 | credit would be courteous but is not required.
|
---|
1329 |
|
---|
1330 | =head1 ACKNOWLEDGEMENTS
|
---|
1331 |
|
---|
1332 | Russ Allbery, Jon Orwant, Randy Ray, Larry Rosler, Nat Torkington,
|
---|
1333 | and Stephen Warren all contributed suggestions and corrections to this
|
---|
1334 | piece. Thanks especially to Damian Conway for his ideas and feedback,
|
---|
1335 | and without whose indirect prodding I might never have taken the time
|
---|
1336 | to show others how much Perl has to offer in the way of objects once
|
---|
1337 | you start thinking outside the tiny little box that today's "popular"
|
---|
1338 | object-oriented languages enforce.
|
---|
1339 |
|
---|
1340 | =head1 HISTORY
|
---|
1341 |
|
---|
1342 | Last edit: Sun Feb 4 20:50:28 EST 2001
|
---|