home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Inheritable.pm < prev    next >
Encoding:
Perl POD Document  |  2000-04-17  |  3.6 KB  |  144 lines
  1. package Class::Data::Inheritable;
  2.  
  3. use strict qw(vars subs);
  4. use vars qw($VERSION);
  5. $VERSION = '0.02';
  6.  
  7. =pod
  8.  
  9. =head1 NAME
  10.  
  11. Class::Data::Inheritable - Inheritable, overridable class data
  12.  
  13. =head1 SYNOPSIS
  14.  
  15.   package Stuff;
  16.   use base qw(Class::Data::Inheritable);
  17.  
  18.   # Set up DataFile as inheritable class data.
  19.   Stuff->mk_classdata('DataFile');
  20.  
  21.   # Declare the location of the data file for this class.
  22.   Stuff->DataFile('/etc/stuff/data');
  23.   
  24.  
  25. =head1 DESCRIPTION
  26.  
  27. Class::Data::Inheritable is for creating accessor/mutators to class
  28. data.  That is, if you want to store something about your class as a
  29. whole (instead of about a single object).  This data is then inherited
  30. by your subclasses and can be overriden.
  31.  
  32. For example:
  33.  
  34.   Pere::Ubu->mk_classdata('Suitcase');
  35.  
  36. will generate the method Suitcase() in the class Pere::Ubu.
  37.  
  38. This new method can be used to get and set a piece of class data.
  39.  
  40.   Pere::Ubu->Suitcase('Red');
  41.   $suitcase = Pere::Ubu->Suitcase;
  42.  
  43. The interesting part happens when a class inherits from Pere::Ubu:
  44.  
  45.   package Raygun;
  46.   use base qw(Pere::Ubu);
  47.   
  48.   # Raygun's suitcase is Red.
  49.   $suitcase = Raygun->Suitcase;
  50.  
  51. Raygun inherits its Suitcase class data from Pere::Ubu.
  52.  
  53. Inheritance of class data works analgous to method inheritance.  As
  54. long as Raygun does not "override" its inherited class data (by using
  55. Suitcase() to set a new value) it will continue to use whatever is set
  56. in Pere::Ubu and inherit further changes:
  57.  
  58.   # Both Raygun's and Pere::Ubu's suitcases are now Blue
  59.   Pere::Ubu->Suitcase('Blue');
  60.  
  61. However, should Raygun decide to set its own Suitcase() it has now
  62. "overridden" Pere::Ubu and is on its own, just like if it had
  63. overriden a method:
  64.  
  65.   # Raygun has an orange suitcase, Pere::Ubu's is still Blue.
  66.   Raygun->Suitcase('Orange');
  67.  
  68. Now that Raygun has overridden Pere::Ubu futher changes by Pere::Ubu
  69. no longer effect Raygun.
  70.  
  71.   # Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite.
  72.   Pere::Ubu->Suitcase('Samsonite');
  73.  
  74.  
  75. =head1 Methods
  76.  
  77. =over 4
  78.  
  79. =item B<mk_classdata>
  80.  
  81.   Class->mk_classdata($data_accessor_name);
  82.  
  83. This is a class method used to declare new class data accessors.  A
  84. new accessor will be created in the Class using the name from
  85. $data_accessor_name.  
  86.  
  87. To facilitate overriding, mk_classdata creates an alias to the
  88. accessor, _field_accessor().  So Suitcase() would have an alias
  89. _Suitcase_accessor() that does the exact same thing as Suitcase().
  90. This is useful if you want to alter the behavior of a single accessor
  91. yet still get the benefits of inheritable class data.  For example.
  92.  
  93.   sub Suitcase {
  94.       my($self) = shift;
  95.       warn "Fashion tragedy" if @_ and $_[0] eq 'Plaid';
  96.  
  97.       $self->_Suitcase_accessor(@_);
  98.   }
  99.  
  100. =cut
  101.  
  102. sub mk_classdata {
  103.     my ($declaredclass, $attribute, $data) = @_;
  104.  
  105.     my $accessor = sub {
  106.         my $wantclass = ref($_[0]) || $_[0];
  107.  
  108.         return $wantclass->mk_classdata($attribute)->(@_)
  109.           if @_>1 && $wantclass ne $declaredclass;
  110.  
  111.         $data = $_[1] if @_>1;
  112.         return $data;
  113.     };
  114.  
  115.     my $alias = "_${attribute}_accessor";
  116.     *{$declaredclass.'::'.$attribute} = $accessor;
  117.     *{$declaredclass.'::'.$alias}     = $accessor;
  118. }
  119.  
  120. =pod
  121.  
  122. =head1 COPYRIGHT
  123.  
  124. Copyright (c) 2000, Damian Conway and Michael G Schwern. All
  125. Rights Reserved.  This module is free software. It may be used,
  126. redistributed and/or modified under the terms of the Perl Artistic
  127. License (see http://www.perl.com/perl/misc/Artistic.html)
  128.  
  129.  
  130. =head1 AUTHOR
  131.  
  132. Original code by Damian Conway.
  133.  
  134. Maintained by Michael G Schwern <schwern@pobox.com>
  135.  
  136.  
  137. =head1 SEE ALSO
  138.  
  139. L<perltootc> has a very elaborate discussion of class data in Perl.
  140.  
  141. =cut
  142.  
  143. 1;
  144.