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