home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _5a09ae1e3d063accda93796e62a53760 < prev    next >
Text File  |  2000-03-23  |  62KB  |  1,290 lines

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