1PERLTOOC(1)            Perl Programmers Reference Guide            PERLTOOC(1)
2
3
4

NAME

6       perltooc - Tom's OO Tutorial for Class Data in Perl
7

DESCRIPTION

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

Class Data in a Can

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

Class Data as Package Variables

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

Class Data as Lexical Variables

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

NOTES

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

SEE ALSO

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

ACKNOWLEDGEMENTS

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

HISTORY

1324       Last edit: Sun Feb  4 20:50:28 EST 2001
1325
1326
1327
1328perl v5.10.1                      2009-02-12                       PERLTOOC(1)
Impressum