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