Commit | Line | Data |
19799a22 |
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 |
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 |
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 |
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 |
187 | symbol symbol table, like method names or package variables. In other |
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 |
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 |
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 |
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 |
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 |
656 | attribute, in which case C<$object-E<gt>attribute()> returns that value. |
657 | But if no value has been set, then C<$object-E<gt>attribute()> returns |
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 |
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 |
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 |
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 |
1160 | The Vermin class demonstrates translucency using a package variable, |
1161 | eponymously named %Vermin, as its meta-object. If you prefer to |
19799a22 |
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 |
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 |
1297 | up names of object attributes. For example, C<$self-E<gt>{ObData1}> |
1298 | should probably be C<$self-E<gt>{ __PACKAGE__ . "_ObData1" }>, but that |
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 |