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