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