Commit | Line | Data |
---|---|---|
19799a22 GS |
1 | =head1 NAME |
2 | ||
890a53b9 | 3 | perltooc - Tom's OO Tutorial for Class Data in Perl |
19799a22 GS |
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 | ||
13a2d996 | 15 | =over 4 |
19799a22 GS |
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 | ||
8257a158 MS |
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 | ||
19799a22 GS |
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 | |
87275199 | 123 | will be new in 5.6, and will work for package globals just like C<my> |
19799a22 GS |
124 | works for scoped lexicals.) |
125 | ||
126 | package Some_Class; | |
127 | use strict; | |
87275199 | 128 | our($CData1, $CData2); # our() is new to perl5.6 |
19799a22 GS |
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; | |
87275199 | 160 | our %ClassData = ( # our() is new to perl5.6 |
19799a22 GS |
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 | |
106325ad | 196 | symbol table, like method names or package variables. In other |
19799a22 GS |
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 | |
87275199 | 299 | our %Some_Class = ( # our() is new to perl5.6 |
19799a22 GS |
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 | ||
87275199 | 351 | our %Some_Class = ( # our() is new to perl5.6 |
19799a22 GS |
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; | |
87275199 | 385 | our($CData1, $CData2); # our() is new to perl5.6 |
19799a22 GS |
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 | ||
87275199 | 436 | our %Some_Class = ( # our() is new to perl5.6 |
19799a22 GS |
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. | |
c801bddb | 627 | It has state, behavior, and identity, the three crucial components |
19799a22 GS |
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, | |
d1be9408 | 649 | or that a constructor be named new(), or that a constructor be |
19799a22 GS |
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 | |
c47ff5f1 GS |
665 | attribute, in which case C<< $object->attribute() >> returns that value. |
666 | But if no value has been set, then C<< $object->attribute() >> returns | |
19799a22 GS |
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 | |
c801bddb | 695 | meta-object's value for that attribute, and these objects do not have |
19799a22 GS |
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 | |
87275199 | 750 | will propagate neither up to the parent nor down to any existing child objects. |
19799a22 GS |
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 | ||
87275199 | 769 | our %Vermin = ( # our() is new to perl5.6 |
19799a22 GS |
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 if $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 unenforcible | |
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 | =head2 Locking the Door and Throwing Away the Key | |
1095 | ||
1096 | As currently implemented, any code within the same scope as the | |
1097 | file-scoped lexical %ClassData can alter that hash directly. Is that | |
1098 | ok? Is it acceptable or even desirable to allow other parts of the | |
1099 | implementation of this class to access class attributes directly? | |
1100 | ||
1101 | That depends on how careful you want to be. Think back to the Cosmos | |
1102 | class. If the &supernova method had directly altered $Cosmos::Stars or | |
1103 | C<$Cosmos::Cosmos{stars}>, then we wouldn't have been able to reuse the | |
1104 | class when it came to inventing a Multiverse. So letting even the class | |
1105 | itself access its own class attributes without the mediating intervention of | |
1106 | properly designed accessor methods is probably not a good idea after all. | |
1107 | ||
1108 | Restricting access to class attributes from the class itself is usually | |
1109 | not enforcible even in strongly object-oriented languages. But in Perl, | |
1110 | you can. | |
1111 | ||
1112 | Here's one way: | |
1113 | ||
1114 | package Some_Class; | |
1115 | ||
1116 | { # scope for hiding $CData1 | |
1117 | my $CData1; | |
1118 | sub CData1 { | |
1119 | shift; # XXX: unused | |
1120 | $CData1 = shift if @_; | |
1121 | return $CData1; | |
1122 | } | |
1123 | } | |
1124 | ||
1125 | { # scope for hiding $CData2 | |
1126 | my $CData2; | |
1127 | sub CData2 { | |
1128 | shift; # XXX: unused | |
1129 | $CData2 = shift if @_; | |
1130 | return $CData2; | |
1131 | } | |
1132 | } | |
1133 | ||
1134 | No one--absolutely no one--is allowed to read or write the class | |
1135 | attributes without the mediation of the managing accessor method, since | |
1136 | only that method has access to the lexical variable it's managing. | |
87275199 | 1137 | This use of mediated access to class attributes is a form of privacy far |
19799a22 GS |
1138 | stronger than most OO languages provide. |
1139 | ||
1140 | The repetition of code used to create per-datum accessor methods chafes | |
1141 | at our Laziness, so we'll again use closures to create similar | |
1142 | methods. | |
1143 | ||
1144 | package Some_Class; | |
1145 | ||
1146 | { # scope for ultra-private meta-object for class attributes | |
1147 | my %ClassData = ( | |
1148 | CData1 => "", | |
1149 | CData2 => "", | |
1150 | ); | |
1151 | ||
1152 | for my $datum (keys %ClassData ) { | |
1153 | no strict "refs"; | |
1154 | *$datum = sub { | |
1155 | use strict "refs"; | |
1156 | my ($self, $newvalue) = @_; | |
1157 | $ClassData{$datum} = $newvalue if @_ > 1; | |
1158 | return $ClassData{$datum}; | |
1159 | } | |
1160 | } | |
1161 | ||
1162 | } | |
1163 | ||
1164 | The closure above can be modified to take inheritance into account using | |
1165 | the &UNIVERSAL::can method and SUPER as shown previously. | |
1166 | ||
1167 | =head2 Translucency Revisited | |
1168 | ||
87275199 GS |
1169 | The Vermin class demonstrates translucency using a package variable, |
1170 | eponymously named %Vermin, as its meta-object. If you prefer to | |
19799a22 GS |
1171 | use absolutely no package variables beyond those necessary to appease |
1172 | inheritance or possibly the Exporter, this strategy is closed to you. | |
1173 | That's too bad, because translucent attributes are an appealing | |
1174 | technique, so it would be valuable to devise an implementation using | |
1175 | only lexicals. | |
1176 | ||
1177 | There's a second reason why you might wish to avoid the eponymous | |
1178 | package hash. If you use class names with double-colons in them, you | |
1179 | would end up poking around somewhere you might not have meant to poke. | |
1180 | ||
1181 | package Vermin; | |
1182 | $class = "Vermin"; | |
1183 | $class->{PopCount}++; | |
1184 | # accesses $Vermin::Vermin{PopCount} | |
1185 | ||
1186 | package Vermin::Noxious; | |
1187 | $class = "Vermin::Noxious"; | |
1188 | $class->{PopCount}++; | |
1189 | # accesses $Vermin::Noxious{PopCount} | |
1190 | ||
1191 | In the first case, because the class name had no double-colons, we got | |
1192 | the hash in the current package. But in the second case, instead of | |
1193 | getting some hash in the current package, we got the hash %Noxious in | |
1194 | the Vermin package. (The noxious vermin just invaded another package and | |
1195 | sprayed their data around it. :-) Perl doesn't support relative packages | |
1196 | in its naming conventions, so any double-colons trigger a fully-qualified | |
1197 | lookup instead of just looking in the current package. | |
1198 | ||
1199 | In practice, it is unlikely that the Vermin class had an existing | |
1200 | package variable named %Noxious that you just blew away. If you're | |
1201 | still mistrustful, you could always stake out your own territory | |
1202 | where you know the rules, such as using Eponymous::Vermin::Noxious or | |
1203 | Hieronymus::Vermin::Boschious or Leave_Me_Alone::Vermin::Noxious as class | |
1204 | names instead. Sure, it's in theory possible that someone else has | |
1205 | a class named Eponymous::Vermin with its own %Noxious hash, but this | |
1206 | kind of thing is always true. There's no arbiter of package names. | |
1207 | It's always the case that globals like @Cwd::ISA would collide if more | |
1208 | than one class uses the same Cwd package. | |
1209 | ||
1210 | If this still leaves you with an uncomfortable twinge of paranoia, | |
1211 | we have another solution for you. There's nothing that says that you | |
1212 | have to have a package variable to hold a class meta-object, either for | |
1213 | monadic classes or for translucent attributes. Just code up the methods | |
1214 | so that they access a lexical instead. | |
1215 | ||
1216 | Here's another implementation of the Vermin class with semantics identical | |
1217 | to those given previously, but this time using no package variables. | |
1218 | ||
1219 | package Vermin; | |
1220 | ||
1221 | ||
1222 | # Here's the class meta-object, eponymously named. | |
1223 | # It holds all class data, and also all instance data | |
1224 | # so the latter can be used for both initialization | |
1225 | # and translucency. it's a template. | |
1226 | my %ClassData = ( | |
1227 | PopCount => 0, # capital for class attributes | |
1228 | color => "beige", # small for instance attributes | |
1229 | ); | |
1230 | ||
1231 | # constructor method | |
1232 | # invoked as class method or object method | |
1233 | sub spawn { | |
1234 | my $obclass = shift; | |
1235 | my $class = ref($obclass) || $obclass; | |
1236 | my $self = {}; | |
1237 | bless($self, $class); | |
1238 | $ClassData{PopCount}++; | |
1239 | # init fields from invoking object, or omit if | |
1240 | # invoking object is the class to provide translucency | |
1241 | %$self = %$obclass if ref $obclass; | |
1242 | return $self; | |
1243 | } | |
1244 | ||
1245 | # translucent accessor for "color" attribute | |
1246 | # invoked as class method or object method | |
1247 | sub color { | |
1248 | my $self = shift; | |
1249 | ||
1250 | # handle class invocation | |
1251 | unless (ref $self) { | |
1252 | $ClassData{color} = shift if @_; | |
1253 | return $ClassData{color} | |
1254 | } | |
1255 | ||
1256 | # handle object invocation | |
1257 | $self->{color} = shift if @_; | |
1258 | if (defined $self->{color}) { # not exists! | |
1259 | return $self->{color}; | |
1260 | } else { | |
1261 | return $ClassData{color}; | |
1262 | } | |
1263 | } | |
1264 | ||
1265 | # class attribute accessor for "PopCount" attribute | |
1266 | # invoked as class method or object method | |
1267 | sub population { | |
1268 | return $ClassData{PopCount}; | |
1269 | } | |
1270 | ||
1271 | # instance destructor; invoked only as object method | |
1272 | sub DESTROY { | |
1273 | $ClassData{PopCount}--; | |
1274 | } | |
1275 | ||
1276 | # detect whether an object attribute is translucent | |
1277 | # (typically?) invoked only as object method | |
1278 | sub is_translucent { | |
1279 | my($self, $attr) = @_; | |
1280 | $self = \%ClassData if !ref $self; | |
1281 | return !defined $self->{$attr}; | |
1282 | } | |
1283 | ||
1284 | # test for presence of attribute in class | |
1285 | # invoked as class method or object method | |
1286 | sub has_attribute { | |
1287 | my($self, $attr) = @_; | |
1288 | return exists $ClassData{$attr}; | |
1289 | } | |
1290 | ||
1291 | =head1 NOTES | |
1292 | ||
1293 | Inheritance is a powerful but subtle device, best used only after careful | |
1294 | forethought and design. Aggregation instead of inheritance is often a | |
1295 | better approach. | |
1296 | ||
19799a22 GS |
1297 | You can't use file-scoped lexicals in conjunction with the SelfLoader |
1298 | or the AutoLoader, because they alter the lexical scope in which the | |
1299 | module's methods wind up getting compiled. | |
1300 | ||
1301 | The usual mealy-mouthed package-mungeing doubtless applies to setting | |
c47ff5f1 GS |
1302 | up names of object attributes. For example, C<< $self->{ObData1} >> |
1303 | should probably be C<< $self->{ __PACKAGE__ . "_ObData1" } >>, but that | |
19799a22 GS |
1304 | would just confuse the examples. |
1305 | ||
1306 | =head1 SEE ALSO | |
1307 | ||
1308 | L<perltoot>, L<perlobj>, L<perlmod>, and L<perlbot>. | |
1309 | ||
8257a158 MS |
1310 | The Tie::SecureHash and Class::Data::Inheritable modules from CPAN are |
1311 | worth checking out. | |
19799a22 GS |
1312 | |
1313 | =head1 AUTHOR AND COPYRIGHT | |
1314 | ||
1315 | Copyright (c) 1999 Tom Christiansen. | |
1316 | All rights reserved. | |
1317 | ||
5a7beb56 JH |
1318 | This documentation is free; you can redistribute it and/or modify it |
1319 | under the same terms as Perl itself. | |
19799a22 GS |
1320 | |
1321 | Irrespective of its distribution, all code examples in this file | |
1322 | are hereby placed into the public domain. You are permitted and | |
1323 | encouraged to use this code in your own programs for fun | |
1324 | or for profit as you see fit. A simple comment in the code giving | |
1325 | credit would be courteous but is not required. | |
1326 | ||
1327 | =head1 ACKNOWLEDGEMENTS | |
1328 | ||
5a7beb56 | 1329 | Russ Allbery, Jon Orwant, Randy Ray, Larry Rosler, Nat Torkington, |
19799a22 GS |
1330 | and Stephen Warren all contributed suggestions and corrections to this |
1331 | piece. Thanks especially to Damian Conway for his ideas and feedback, | |
1332 | and without whose indirect prodding I might never have taken the time | |
1333 | to show others how much Perl has to offer in the way of objects once | |
1334 | you start thinking outside the tiny little box that today's "popular" | |
1335 | object-oriented languages enforce. | |
1336 | ||
1337 | =head1 HISTORY | |
1338 | ||
8257a158 | 1339 | Last edit: Sun Feb 4 20:50:28 EST 2001 |