1 package Class::Data::Inheritable;
3 use strict qw(vars subs);
8 my ($declaredclass, $attribute, $data) = @_;
10 if( ref $declaredclass ) {
12 Carp::croak("mk_classdata() is a class method, not an object method");
16 my $wantclass = ref($_[0]) || $_[0];
18 return $wantclass->mk_classdata($attribute)->(@_)
19 if @_>1 && $wantclass ne $declaredclass;
21 $data = $_[1] if @_>1;
25 my $alias = "_${attribute}_accessor";
26 *{$declaredclass.'::'.$attribute} = $accessor;
27 *{$declaredclass.'::'.$alias} = $accessor;
36 Class::Data::Inheritable - Inheritable, overridable class data
41 use base qw(Class::Data::Inheritable);
43 # Set up DataFile as inheritable class data.
44 Stuff->mk_classdata('DataFile');
46 # Declare the location of the data file for this class.
47 Stuff->DataFile('/etc/stuff/data');
49 # Or, all in one shot:
50 Stuff->mk_classdata(DataFile => '/etc/stuff/data');
54 Class::Data::Inheritable is for creating accessor/mutators to class
55 data. That is, if you want to store something about your class as a
56 whole (instead of about a single object). This data is then inherited
57 by your subclasses and can be overriden.
61 Pere::Ubu->mk_classdata('Suitcase');
63 will generate the method Suitcase() in the class Pere::Ubu.
65 This new method can be used to get and set a piece of class data.
67 Pere::Ubu->Suitcase('Red');
68 $suitcase = Pere::Ubu->Suitcase;
70 The interesting part happens when a class inherits from Pere::Ubu:
73 use base qw(Pere::Ubu);
75 # Raygun's suitcase is Red.
76 $suitcase = Raygun->Suitcase;
78 Raygun inherits its Suitcase class data from Pere::Ubu.
80 Inheritance of class data works analogous to method inheritance. As
81 long as Raygun does not "override" its inherited class data (by using
82 Suitcase() to set a new value) it will continue to use whatever is set
83 in Pere::Ubu and inherit further changes:
85 # Both Raygun's and Pere::Ubu's suitcases are now Blue
86 Pere::Ubu->Suitcase('Blue');
88 However, should Raygun decide to set its own Suitcase() it has now
89 "overridden" Pere::Ubu and is on its own, just like if it had
92 # Raygun has an orange suitcase, Pere::Ubu's is still Blue.
93 Raygun->Suitcase('Orange');
95 Now that Raygun has overridden Pere::Ubu futher changes by Pere::Ubu
96 no longer effect Raygun.
98 # Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite.
99 Pere::Ubu->Suitcase('Samsonite');
105 Class->mk_classdata($data_accessor_name);
106 Class->mk_classdata($data_accessor_name => $value);
108 This is a class method used to declare new class data accessors.
109 A new accessor will be created in the Class using the name from
110 $data_accessor_name, and optionally initially setting it to the given
113 To facilitate overriding, mk_classdata creates an alias to the
114 accessor, _field_accessor(). So Suitcase() would have an alias
115 _Suitcase_accessor() that does the exact same thing as Suitcase().
116 This is useful if you want to alter the behavior of a single accessor
117 yet still get the benefits of inheritable class data. For example.
121 warn "Fashion tragedy" if @_ and $_[0] eq 'Plaid';
123 $self->_Suitcase_accessor(@_);
128 Original code by Damian Conway.
130 Maintained by Michael G Schwern until September 2005.
132 Now maintained by Tony Bowden.
134 =head1 BUGS and QUERIES
136 Please direct all correspondence regarding this module to:
137 bug-Class-Data-Inheritable@rt.cpan.org
139 =head1 COPYRIGHT and LICENSE
141 Copyright (c) 2000-2005, Damian Conway and Michael G Schwern.
144 This module is free software. It may be used, redistributed and/or
145 modified under the same terms as Perl itself.
149 L<perltooc> has a very elaborate discussion of class data in Perl.