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