1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
package Class::MakeMethods::Emulator::Inheritable;
use strict;
use Class::MakeMethods::Template::ClassInherit;
use Class::MakeMethods::Emulator qw( namespace_capture namespace_release );
my $emulation_target = 'Class::Data::Inheritable';
sub import {
my $mm_class = shift;
if ( scalar @_ and $_[0] =~ /^-take_namespace/ and shift) {
namespace_capture(__PACKAGE__, $emulation_target);
} elsif ( scalar @_ and $_[0] =~ /^-release_namespace/ and shift) {
namespace_release(__PACKAGE__, $emulation_target);
}
# The fallback should really be to NEXT::import.
$mm_class->SUPER::import( @_ );
}
########################################################################
sub mk_classdata {
my $declaredclass = shift;
my $attribute = shift;
Class::MakeMethods::Template::ClassInherit->make(
-TargetClass => $declaredclass,
'scalar' => [ -interface => { '*'=>'get_set', '_*_accessor'=>'get_set' },
$attribute ],
);
if ( scalar @_ ) {
$declaredclass->$attribute( @_ );
}
}
########################################################################
1;
__END__
=head1 NAME
Class::MakeMethods::Emulator::Inheritable - Emulate Class::Inheritable
=head1 SYNOPSIS
package Stuff;
use base qw(Class::MakeMethods::Emulator::Inheritable);
# Set up DataFile as inheritable class data.
Stuff->mk_classdata('DataFile');
# Declare the location of the data file for this class.
Stuff->DataFile('/etc/stuff/data');
=head1 DESCRIPTION
This module is an adaptor that provides emulatation of Class::Data::Inheritable by invoking similar functionality provided by Class::MakeMethods::ClassInherit.
The public interface provided by Class::MakeMethods::Emulator::Inheritable is identical to that of Class::Data::Inheritable.
Class::Data::Inheritable is for creating accessor/mutators to class
data. That is, if you want to store something about your class as a
whole (instead of about a single object). This data is then inherited
by your subclasses and can be overridden.
=head1 USAGE
As specified by L<Class::Data::Inheritable>, clients should inherit from this module and then invoke the mk_classdata() method for each class method desired:
Class->mk_classdata($data_accessor_name);
This is a class method used to declare new class data accessors. A
new accessor will be created in the Class using the name from
$data_accessor_name.
Class->mk_classdata($data_accessor_name, $initial_value);
You may also pass a second argument to initialize the value.
To facilitate overriding, mk_classdata creates an alias to the
accessor, _field_accessor(). So Suitcase() would have an alias
_Suitcase_accessor() that does the exact same thing as Suitcase().
This is useful if you want to alter the behavior of a single accessor
yet still get the benefits of inheritable class data. For example.
sub Suitcase {
my($self) = shift;
warn "Fashion tragedy" if @_ and $_[0] eq 'Plaid';
$self->_Suitcase_accessor(@_);
}
=head1 COMPATIBILITY
Note that the internal implementation of Class::MakeMethods::ClassInherit does not match that of Class::Data::Inheritable. In particular, Class::Data::Inheritable installs new methods in subclasses when they first initialize their value, while
=head1 EXAMPLE
The example provided by L<Class::Data::Inheritable> is equally applicable to this emulator.
package Pere::Ubu;
use base qw(Class::MakeMethods::Emulator::Inheritable);
Pere::Ubu->mk_classdata('Suitcase');
will generate the method Suitcase() in the class Pere::Ubu.
This new method can be used to get and set a piece of class data.
Pere::Ubu->Suitcase('Red');
$suitcase = Pere::Ubu->Suitcase;
The interesting part happens when a class inherits from Pere::Ubu:
package Raygun;
use base qw(Pere::Ubu);
# Raygun's suitcase is Red.
$suitcase = Raygun->Suitcase;
Raygun inherits its Suitcase class data from Pere::Ubu.
Inheritance of class data works analgous to method inheritance. As
long as Raygun does not "override" its inherited class data (by using
Suitcase() to set a new value) it will continue to use whatever is set
in Pere::Ubu and inherit further changes:
# Both Raygun's and Pere::Ubu's suitcases are now Blue
Pere::Ubu->Suitcase('Blue');
However, should Raygun decide to set its own Suitcase() it has now
"overridden" Pere::Ubu and is on its own, just like if it had
overridden a method:
# Raygun has an orange suitcase, Pere::Ubu's is still Blue.
Raygun->Suitcase('Orange');
Now that Raygun has overridden Pere::Ubu further changes by Pere::Ubu
no longer effect Raygun.
# Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite.
Pere::Ubu->Suitcase('Samsonite');
=head1 SEE ALSO
See L<Class::MakeMethods> for general information about this distribution.
See L<Class::MakeMethods::Emulator> for more about this family of subclasses.
See L<Class::Data::Inheritable> for documentation of the original module.
See L<perltootc> for a discussion of class data in Perl.
See L<Class::MakeMethods::Standard::Inheritable> and L<Class::MakeMethods::Template::ClassInherit> for inheritable data methods.
=cut
|
