Codebase list libclass-container-perl / 8f5f461
[svn-inject] Installing original source of libclass-container-perl Ansgar Burchardt 13 years ago
12 changed file(s) with 1986 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
+16
-0
Build.PL less more
0 use Module::Build;
1
2 my $b = Module::Build->new
3 (
4 module_name => 'Class::Container',
5 requires => {
6 'Params::Validate' => '0.23',
7 'Carp' => 0,
8 },
9 recommends => { 'Scalar::Util' => 0 },
10 license => 'perl',
11 create_readme => 1,
12 sign => 1,
13 );
14
15 $b->create_build_script;
+217
-0
Changes less more
0 Revision history for Perl extension Class::Framework.
1
2 0.12 Sun Jan 23 21:02:35 CST 2005
3
4 - Fixed a bug in the container() method, which was only returning
5 valid results for delayed objects, not auto-created ones. [Spotted
6 by Sebastian Willert]
7
8 0.11 Wed Mar 3 21:34:51 CST 2004
9
10 - Fixed a bug in the code that detects whether Scalar::Util is
11 loadable. [Spotted by Michael Alan Dorman]
12
13 0.10 Thu Mar 6 16:06:47 CST 2003
14
15 - The dump_parameters() method will now output the default values (if
16 any) of parameters that haven't been explicitly set.
17
18 0.09 Mon Feb 10 13:12:40 CST 2003
19
20 - Use Carp::croak() instead of die() in most places when throwing a
21 fatal error.
22
23 - Fixed a problem in dump_parameters() in which attributes from
24 superclasses weren't getting dumped.
25
26 - The valid_params() method now always returns a hashref, possibly
27 empty (when initialization hasn't happened yet), instead of
28 sometimes returning undef.
29
30 - Added experimental support for "decorator" classes, via the
31 decorates() method.
32
33 - Fixed the credits in the AUTHOR section to better reflect reality.
34
35 - Added a Module::Build-style Build.PL script for installation.
36
37 0.08 Thu Aug 29 17:11:20 EST 2002
38
39 - Added the dump_parameters() method, which returns a hash reference
40 containing a set of parameters that should be sufficient to
41 re-create the given object using its class's C<new()> method (under
42 normal/simple circumstances).
43
44 0.07 Tue Jul 23 00:34:34 PDT 2002
45
46 - Fix a bug in passing contained objects rather than using the
47 defaultly created one. [found by Ilya Martynov <ilya@martynov.org>]
48
49 - Calling container() when Scalar::Util is not installed now triggers
50 a fatal error instead of returning undef
51
52 - Get rid off the %ALLOWED_CACHE memoization, since it wasn't working
53 properly. It could be done, but not as easily, so maybe it's a
54 future project. [consistent prodding by Dave Rolsky]
55
56 - Replace guts of get_contained_object_spec() and validation_spec()
57 with an _iterate_ISA() internal method. This fixes a bug in
58 validation_spec() in which subclasses weren't overriding superclass
59 validation_spec()s.
60
61 - Make valid_params() a standard get/set accessor method.
62
63 - Document that valid_params() should only be called as a class
64 method, not object method.
65
66 - Improve the output of the show_containers() method.
67
68 - Calling contained_objects() twice on the same package wasn't
69 properly clearing previous entries.
70
71 0.06 Wed Jul 17 17:06:10 EST 2002
72
73 - Memoize the get_contained_object_spec(), validation_spec(), and
74 allowed_params() methods. This can give a big speed boost when
75 methods are called repeatedly, for example when using factory
76 methods. All memoization caches are cleared when valid_params() or
77 contained_objects() is called. The only known pitfall in the
78 caching is that a class that dynamically changes its @ISA will
79 probably mess things up. Idea by Dave Rolsky.
80
81 - Use 'scalar validate_with()' inside new(), which may be faster.
82 Idea by Dave Rolsky.
83
84 - short-circuit create_contained_objects() if there are no contained
85 objects to create. Idea by Dave Rolsky.
86
87 - return a reference from create_contained_objects() rather than a
88 list of key/value pairs. This lets us pass it directly to validation
89 routines.
90
91 - Use the qr// format for regexes in the all_specs() method.
92
93 - Improve the docs for allowed_params() - it's a class method (not an
94 instance method), and it accepts a list of arguments that can
95 affect the return value.
96
97 - Don't copy as many hashes internally. Pass by reference.
98
99 - Fixed some POD formatting problems.
100
101 - Now requires Params::Validate version 0.23
102
103 0.05 Thu Jun 27 16:53:41 EST 2002
104
105 - Fixed a problem in create_contained_objects() in which a 'foo_class'
106 parameter wouldn't get properly passsed to all the contained objects
107 that needed to see it.
108
109 - Added a documentation section "Scenario" explaining the main benefits
110 of using the module.
111
112 - Improved the output of show_containers(), notably the names of
113 delayed classes
114
115 - Merge $self->{container}{delayed} into $self->{container}{contained},
116 with a 'delayed' property. This allows simplification of the rest of
117 the code in several places, notably the show_containers() routine.
118
119 - Simplify show_containers() a little, and make it more accurate on
120 contained objects' classes
121
122 - Fixed a doc error in the first example
123
124 - Added a bit in the first doc paragraph, saying that any of the
125 Mason objects can be replaced by a subclass.
126
127 - Added an internal comment about the strategy inside the
128 allowed_params method.
129
130 - Simplified the allowed_params method internally.
131
132 - Got rid of special-casing to check for circular containment
133 relationships. This seemed to have been added for HTML::Mason, but
134 all Mason tests (as well as all Class::Container tests) still pass
135 when I remove it.
136
137 0.04 Wed Jun 26 19:15:26 EST 2002
138
139 - Add the show_containers() method, which should be a godsend during
140 debugging.
141
142 - Convert contained_objects() string specs to hashes upon input, rather
143 than checking them every time they're used later in the code.
144
145 - Change " if (%args)" to " if (keys %args)", which is more officially
146 correct (though both would work in this particular case).
147
148 0.03 Fri Jun 21 17:44:37 EST 2002
149
150 - Subclasses can now override contained_objects settings of their
151 superclass (previously it was backwards).
152
153 - Let call_method() accept arbitrary additional parameters, don't
154 force them into a hash.
155
156 - Added contained_class() method.
157
158 - Use new contained_class() method inside call_method().
159
160 - delayed_object_class() shouldn't be settable, it'll mess up the
161 parameters accepted.
162
163 - The 'container' parameter shouldn't be shared among containers the way
164 other parameters are.
165
166 - Made create_delayed_object() a little more efficient by not shifting
167 things off @_ - just pass @_ to the next new() method.
168
169 - Don't check for $contained_class->can('allowed_params'), check for
170 $contained_class->isa(__PACKAGE__).
171
172 - Clarified a few error messages.
173
174 - Clarified documentation and removed a couple of doc errors.
175
176
177 0.02 Wed Jun 19 10:52:48 AEST 2002
178 - Made Scalar::Util a little more optional - the container() method
179 is just a no-op if it's not around.
180
181 - Use Params::Validate 0.18 new validate_with() method to set a
182 meaningful subroutine name in error messages
183
184 - Added the delayed_object_class() method
185
186 - Documented how delayed objects are declared and created [Dave
187 Rolsky]
188
189 - Added some tests for the above stuff
190
191 - Various documentation spruce-ups
192
193 0.01_05 Fri May 10 15:29:46 AEST 2002
194 - If a container has two contained classes that both need to see a
195 parameter of the same name, it will now be passed to both. Previously
196 it was passed to one of them, randomly.
197
198 - Added 2 tests for the above.
199
200 - Added 4 tests to make sure class names can be properly overridden.
201
202 - Got rid of _make_contained_object() method.
203
204 - Changed the (undocumented) get_contained_objects() method to
205 get_contained_object_spec().
206
207 - Added the container() method, to get a reference to the thingy that
208 created you. Uses weak references if Scalar::Util is available.
209
210 - Consolidated all Container metadata in $self->{container} (subject to
211 change to {_container} or something).
212
213 - Added call_method() method.
214
215 0.01 Wed Mar 20 19:33:40 2002
216 - original version, based on HTML::Mason::Container
+21
-0
INSTALL less more
0 Installation instructions for Class::Container
1
2 To install this module, follow the standard steps for installing most
3 Perl modules:
4
5 perl Makefile.PL
6 make
7 make test
8 make install
9
10 Or you may use the newer Module::Build-style installation script:
11
12 perl Build.PL
13 ./Build
14 ./Build test
15 ./Build install
16
17 Or you may use the CPAN.pm module, which will automatically execute
18 these steps for you.
19
20 -Ken
+12
-0
MANIFEST less more
0 Build.PL
1 Changes
2 INSTALL
3 lib/Class/Container.pm
4 Makefile.PL
5 MANIFEST This list of files
6 META.yml
7 README
8 t/01-basic.t
9 t/02-decorator.t
10 t/classes.pl
11 SIGNATURE Added here by Module::Build
+21
-0
META.yml less more
0 --- #YAML:1.0
1 name: Class-Container
2 version: 0.12
3 author:
4 - |-
5 Originally by Ken Williams <ken@mathforum.org> and Dave Rolsky
6 <autarch@urth.org> for the HTML::Mason project. Important feedback
7 contributed by Jonathan Swartz <swartz@pobox.com>. Extended by Ken
8 Williams for the AI::Categorizer project.
9 abstract: Glues object frameworks together transparently
10 license: perl
11 requires:
12 Carp: 0
13 Params::Validate: 0.23
14 recommends:
15 Scalar::Util: 0
16 provides:
17 Class::Container:
18 file: lib/Class/Container.pm
19 version: 0.12
20 generated_by: Module::Build version 0.26
+37
-0
Makefile.PL less more
0
1 use ExtUtils::MakeMaker;
2
3 unless (eval "use Scalar::Util; 1") {
4 warn("You seem not to have the Scalar::Util module installed.\n" .
5 "Its installation is recommended (but not required) for Class::Container - see the README.\n");
6 sleep 4;
7 }
8
9 my $module = 'Class::Container';
10 my ($file, $dir);
11 ($file = "lib/$module.pm") =~ s{::}{/}g;
12 ($dir = $module) =~ s/::/-/g;
13
14 WriteMakefile
15 (
16 'NAME' => $module,
17 'VERSION_FROM' => $file, # finds $VERSION
18 'dist' => { COMPRESS=>"gzip",
19 SUFFIX=>"gz",
20 PREOP=>('rm -f README; '.
21 "pod2text -80 < $file > README; ".
22 "cp -f README $dir-\$(VERSION); "
23 ),
24 },
25 'PREREQ_PM' => {
26 Params::Validate => '0.23',
27 },
28 'PL_FILES' => {},
29 ($] >= 5.005 ? ## Add these new keywords supported since 5.005
30 (ABSTRACT_FROM => $file, # retrieve abstract from module
31 AUTHOR => 'Ken Williams <ken@mathforum.org>') :
32 ()
33 ),
34 NO_META => 1,
35 );
36
+321
-0
README less more
0 NAME
1 Class::Container - Glues object frameworks together transparently
2
3 SYNOPSIS
4 package Car;
5 use Class::Container;
6 @ISA = qw(Class::Container);
7
8 __PACKAGE__->valid_params
9 (
10 paint => {default => 'burgundy'},
11 style => {default => 'coupe'},
12 windshield => {isa => 'Glass'},
13 radio => {isa => 'Audio::Device'},
14 );
15
16 __PACKAGE__->contained_objects
17 (
18 windshield => 'Glass::Shatterproof',
19 wheel => { class => 'Vehicle::Wheel',
20 delayed => 1 },
21 radio => 'Audio::MP3',
22 );
23
24 sub new {
25 my $package = shift;
26
27 # 'windshield' and 'radio' objects are created automatically by
28 # SUPER::new()
29 my $self = $package->SUPER::new(@_);
30
31 $self->{right_wheel} = $self->create_delayed_object('wheel');
32 ... do any more initialization here ...
33 return $self;
34 }
35
36 DESCRIPTION
37 This class facilitates building frameworks of several classes that
38 inter-operate. It was first designed and built for "HTML::Mason", in
39 which the Compiler, Lexer, Interpreter, Resolver, Component, Buffer, and
40 several other objects must create each other transparently, passing the
41 appropriate parameters to the right class, possibly substituting other
42 subclasses for any of these objects.
43
44 The main features of "Class::Container" are:
45
46 * Explicit declaration of containment relationships (aggregation,
47 factory creation, etc.)
48
49 * Declaration of constructor parameters accepted by each member in a
50 class framework
51
52 * Transparent passing of constructor parameters to the class that
53 needs them
54
55 * Ability to create one (automatic) or many (manual) contained objects
56 automatically and transparently
57
58 Scenario
59 Suppose you've got a class called "Parent", which contains an object of
60 the class "Child", which in turn contains an object of the class
61 "GrandChild". Each class creates the object that it contains. Each class
62 also accepts a set of named parameters in its "new()" method. Without
63 using "Class::Container", "Parent" will have to know all the parameters
64 that "Child" takes, and "Child" will have to know all the parameters
65 that "GrandChild" takes. And some of the parameters accepted by "Parent"
66 will really control aspects of "Child" or "GrandChild". Likewise, some
67 of the parameters accepted by "Child" will really control aspects of
68 "GrandChild". So, what happens when you decide you want to use a
69 "GrandDaughter" class instead of the generic "GrandChild"? "Parent" and
70 "Child" must be modified accordingly, so that any additional parameters
71 taken by "GrandDaughter" can be accommodated. This is a pain - the kind
72 of pain that object-oriented programming was supposed to shield us from.
73
74 Now, how can "Class::Container" help? Using "Class::Container", each
75 class ("Parent", "Child", and "GrandChild") will declare what arguments
76 they take, and declare their relationships to the other classes
77 ("Parent" creates/contains a "Child", and "Child" creates/contains a
78 "GrandChild"). Then, when you create a "Parent" object, you can pass
79 "Parent->new()" all the parameters for all three classes, and they will
80 trickle down to the right places. Furthermore, "Parent" and "Child"
81 won't have to know anything about the parameters of its contained
82 objects. And finally, if you replace "GrandChild" with "GrandDaughter",
83 no changes to "Parent" or "Child" will likely be necessary.
84
85 METHODS
86 new()
87 Any class that inherits from "Class::Container" should also inherit its
88 "new()" method. You can do this simply by omitting it in your class, or
89 by calling "SUPER::new(@_)" as indicated in the SYNOPSIS. The "new()"
90 method ensures that the proper parameters and objects are passed to the
91 proper constructor methods.
92
93 At the moment, the only possible constructor method is "new()". If you
94 need to create other constructor methods, they should call "new()"
95 internally.
96
97 __PACKAGE__->contained_objects()
98 This class method is used to register what other objects, if any, a
99 given class creates. It is called with a hash whose keys are the
100 parameter names that the contained class's constructor accepts, and
101 whose values are the default class to create an object of.
102
103 For example, consider the "HTML::Mason::Compiler" class, which uses the
104 following code:
105
106 __PACKAGE__->contained_objects( lexer => 'HTML::Mason::Lexer' );
107
108 This defines the relationship between the "HTML::Mason::Compiler" class
109 and the class it creates to go in its "lexer" slot. The
110 "HTML::Mason::Compiler" class "has a" "lexer". The
111 "HTML::Mason::Compiler->new()" method will accept a "lexer" parameter
112 and, if no such parameter is given, an object of the
113 "HTML::Mason::Lexer" class should be constructed.
114
115 We implement a bit of magic here, so that if
116 "HTML::Mason::Compiler->new()" is called with a "lexer_class" parameter,
117 it will load the indicated class (presumably a subclass of
118 "HTML::Mason::Lexer"), instantiate a new object of that class, and use
119 it for the Compiler's "lexer" object. We're also smart enough to notice
120 if parameters given to "HTML::Mason::Compiler->new()" actually should go
121 to the "lexer" contained object, and it will make sure that they get
122 passed along.
123
124 Furthermore, an object may be declared as "delayed", which means that an
125 object *won't* be created when its containing class is constructed.
126 Instead, these objects will be created "on demand", potentially more
127 than once. The constructors will still enjoy the automatic passing of
128 parameters to the correct class. See the "create_delayed_object()" for
129 more.
130
131 To declare an object as "delayed", call this method like this:
132
133 __PACKAGE__->contained_objects( train => { class => 'Big::Train',
134 delayed => 1 } );
135
136 __PACKAGE__->valid_params(...)
137 Specifies the parameters accepted by this class's "new()" method as a
138 set of key/value pairs. Any parameters accepted by a superclass/subclass
139 will also be accepted, as well as any parameters accepted by contained
140 objects. This method is a get/set accessor method, so it returns a
141 reference to a hash of these key/value pairs. As a special case, if you
142 wish to set the valid params to an empty set and you previously set it
143 to a non-empty set, you may call "__PACKAGE__->valid_params(undef)".
144
145 "valid_params()" is called with a hash that contains parameter names as
146 its keys and validation specifications as values. This validation
147 specification is largely the same as that used by the "Params::Validate"
148 module, because we use "Params::Validate" internally.
149
150 As an example, consider the following situation:
151
152 use Class::Container;
153 use Params::Validate qw(:types);
154 __PACKAGE__->valid_params
155 (
156 allow_globals => { type => ARRAYREF, parse => 'list', default => [] },
157 default_escape_flags => { type => SCALAR, parse => 'string', default => '' },
158 lexer => { isa => 'HTML::Mason::Lexer' },
159 preprocess => { type => CODEREF, parse => 'code', optional => 1 },
160 postprocess_perl => { type => CODEREF, parse => 'code', optional => 1 },
161 postprocess_text => { type => CODEREF, parse => 'code', optional => 1 },
162 );
163
164 __PACKAGE__->contained_objects( lexer => 'HTML::Mason::Lexer' );
165
166 The "type", "default", and "optional" parameters are part of the
167 validation specification used by "Params::Validate". The various
168 constants used, "ARRAYREF", "SCALAR", etc. are all exported by
169 "Params::Validate". This means that any of these six parameter names,
170 plus the "lexer_class" parameter (because of the "contained_objects()"
171 specification given earlier), are valid arguments to the Compiler's
172 "new()" method.
173
174 Note that there are also some "parse" attributes declared. These have
175 nothing to do with "Class::Container" or "Params::Validate" - any extra
176 entries like this are simply ignored, so you are free to put extra
177 information in the specifications as long as it doesn't overlap with
178 what "Class::Container" or "Params::Validate" are looking for.
179
180 $self->create_delayed_object()
181 If a contained object was declared with "delayed => 1", use this method
182 to create an instance of the object. Note that this is an object method,
183 not a class method:
184
185 my $foo = $self->create_delayed_object('foo', ...); # YES!
186 my $foo = __PACKAGE__->create_delayed_object('foo', ...); # NO!
187
188 The first argument should be a key passed to the "contained_objects()"
189 method. Any additional arguments will be passed to the "new()" method of
190 the object being created, overriding any parameters previously passed to
191 the container class constructor. (Could I possibly be more alliterative?
192 Veni, vedi, vici.)
193
194 $self->delayed_object_params($name, [params])
195 Allows you to adjust the parameters that will be used to create any
196 delayed objects in the future. The first argument specifies the "name"
197 of the object, and any additional arguments are key-value pairs that
198 will become parameters to the delayed object.
199
200 When called with only a $name argument and no list of parameters to set,
201 returns a hash reference containing the parameters that will be passed
202 when creating objects of this type.
203
204 $self->delayed_object_class($name)
205 Returns the class that will be used when creating delayed objects of the
206 given name. Use this sparingly - in most situations you shouldn't care
207 what the class is.
208
209 __PACKAGE__->decorates()
210 Version 0.09 of Class::Container added [as yet experimental] support for
211 so-called "decorator" relationships, using the term as defined in
212 *Design Patterns* by Gamma, et al. (the Gang of Four book). To declare a
213 class as a decorator of another class, simply set @ISA to the class
214 which will be decorated, and call the decorator class's "decorates()"
215 method.
216
217 Internally, this will ensure that objects are instantiated as
218 decorators. This means that you can mix & match extra add-on
219 functionality classes much more easily.
220
221 In the current implementation, if only a single decoration is used on an
222 object, it will be instantiated as a simple subclass, thus avoiding a
223 layer of indirection.
224
225 $self->validation_spec()
226 Returns a hash reference suitable for passing to the "Params::Validate"
227 "validate" function. Does *not* include any arguments that can be passed
228 to contained objects.
229
230 $class->allowed_params(\%args)
231 Returns a hash reference of every parameter this class will accept,
232 *including* parameters it will pass on to its own contained objects. The
233 keys are the parameter names, and the values are their corresponding
234 specifications from their "valid_params()" definitions. If a parameter
235 is used by both the current object and one of its contained objects, the
236 specification returned will be from the container class, not the
237 contained.
238
239 Because the parameters accepted by "new()" can vary based on the
240 parameters *passed* to "new()", you can pass any parameters to the
241 "allowed_params()" method too, ensuring that the hash you get back is
242 accurate.
243
244 $self->container()
245 Returns the object that created you. This is remembered by storing a
246 reference to that object, so we use the "Scalar::Utils" "weakref()"
247 function to avoid persistent circular references that would cause memory
248 leaks. If you don't have "Scalar::Utils" installed, we don't make these
249 references in the first place, and calling "container()" will result in
250 a fatal error.
251
252 If you weren't created by another object via "Class::Container",
253 "container()" returns "undef".
254
255 In most cases you shouldn't care what object created you, so use this
256 method sparingly.
257
258 $object->show_containers
259 $package->show_containers
260 This method returns a string meant to describe the containment
261 relationships among classes. You should not depend on the specific
262 formatting of the string, because I may change things in a future
263 release to make it prettier.
264
265 For example, the HTML::Mason code returns the following when you do
266 "$interp->show_containers":
267
268 HTML::Mason::Interp=HASH(0x238944)
269 resolver -> HTML::Mason::Resolver::File
270 compiler -> HTML::Mason::Compiler::ToObject
271 lexer -> HTML::Mason::Lexer
272 request -> HTML::Mason::Request (delayed)
273 buffer -> HTML::Mason::Buffer (delayed)
274
275 Currently, containment is shown by indentation, so the Interp object
276 contains a resolver and a compiler, and a delayed request (or several
277 delayed requests). The compiler contains a lexer, and each request
278 contains a delayed buffer (or several delayed buffers).
279
280 $object->dump_parameters
281 Returns a hash reference containing a set of parameters that should be
282 sufficient to re-create the given object using its class's "new()"
283 method. This is done by fetching the current value for each declared
284 parameter (i.e. looking in $object for hash entries of the same name),
285 then recursing through all contained objects and doing the same.
286
287 A few words of caution here. First, the dumped parameters represent the
288 *current* state of the object, not the state when it was originally
289 created.
290
291 Second, a class's declared parameters may not correspond exactly to its
292 data members, so it might not be possible to recover the former from the
293 latter. If it's possible but requires some manual fudging, you can
294 override this method in your class, something like so:
295
296 sub dump_parameters {
297 my $self = shift;
298 my $dump = $self->SUPER::dump_parameters();
299
300 # Perform fudgery
301 $dump->{incoming} = $self->{_private};
302 delete $dump->{superfluous};
303 return $dump;
304 }
305
306 SEE ALSO
307 Params::Validate
308
309 AUTHOR
310 Originally by Ken Williams <ken@mathforum.org> and Dave Rolsky
311 <autarch@urth.org> for the HTML::Mason project. Important feedback
312 contributed by Jonathan Swartz <swartz@pobox.com>. Extended by Ken
313 Williams for the AI::Categorizer project.
314
315 Currently maintained by Ken Williams.
316
317 COPYRIGHT
318 This program is free software; you can redistribute it and/or modify it
319 under the same terms as Perl itself.
320
+34
-0
SIGNATURE less more
0 This file contains message digests of all files listed in MANIFEST,
1 signed via the Module::Signature module, version 0.38.
2
3 To verify the content in this distribution, first make sure you have
4 Module::Signature installed, then type:
5
6 % cpansign -v
7
8 It would check each file's integrity, as well as the signature's
9 validity. If "==> Signature verified OK! <==" is not displayed,
10 the distribution may already have been compromised, and you should
11 not run its Makefile.PL or Build.PL.
12
13 -----BEGIN PGP SIGNED MESSAGE-----
14 Hash: SHA1
15
16 SHA1 3b225b4d443775932c127fe00d5dddca58820aa6 Build.PL
17 SHA1 8cd28fa1763a93ffc196226642df8c584a2adc70 Changes
18 SHA1 1b386906514c738a00fcd4b1b7ba74ac1925c227 INSTALL
19 SHA1 6e250a09fdb471a3dcd7b9f267d4585dc2e5de18 MANIFEST
20 SHA1 976fabe5ba08d4f96ec5d764a30e3f37d46f4019 META.yml
21 SHA1 48dcc0a806041eaf9d020b5305d0c4bb32898f51 Makefile.PL
22 SHA1 336c070360a737f094645d80d4c82d5fd02ae973 README
23 SHA1 4286abb1ee51dcfa9868ccb754ec63b4ff684ad2 lib/Class/Container.pm
24 SHA1 39edf6c1802d4be568c18968ea5389965a0a6ff1 t/01-basic.t
25 SHA1 8154cdf85123d748ae210fa86a58e5484cb79275 t/02-decorator.t
26 SHA1 56e282a6a8379f3a3a42d5f78cd1682ab1cfc68b t/classes.pl
27 -----BEGIN PGP SIGNATURE-----
28 Version: GnuPG v1.2.2 (Darwin)
29
30 iD8DBQFB9GYigrvMBLfvlHYRAry6AJ0R722RV5sESZlMjvcID/M6ms/7HwCdGHfI
31 DhsUAU9sOA7srQVl1uZMJ90=
32 =oCuW
33 -----END PGP SIGNATURE-----
+869
-0
lib/Class/Container.pm less more
0 package Class::Container;
1
2 $VERSION = '0.12';
3 $VERSION = eval $VERSION if $VERSION =~ /_/;
4
5 my $HAVE_WEAKEN;
6 BEGIN {
7 eval {
8 require Scalar::Util;
9 Scalar::Util->import('weaken');
10 $HAVE_WEAKEN = 1;
11 };
12
13 *weaken = sub {} unless defined &weaken;
14 }
15
16 use strict;
17 use Carp;
18
19 # The create_contained_objects() method lets one object
20 # (e.g. Compiler) transparently create another (e.g. Lexer) by passing
21 # creator parameters through to the created object.
22 #
23 # Any auto-created objects should be declared in a class's
24 # %CONTAINED_OBJECTS hash. The keys of this hash are objects which
25 # can be created and the values are the default classes to use.
26
27 # For instance, the key 'lexer' indicates that a 'lexer' parameter
28 # should be silently passed through, and a 'lexer_class' parameter
29 # will trigger the creation of an object whose class is specified by
30 # the value. If no value is present there, the value of 'lexer' in
31 # the %CONTAINED_OBJECTS hash is used. If no value is present there,
32 # no contained object is created.
33 #
34 # We return the list of parameters for the creator. If contained
35 # objects were auto-created, their creation parameters aren't included
36 # in the return value. This lets the creator be totally ignorant of
37 # the creation parameters of any objects it creates.
38
39 use Params::Validate qw(:all);
40 Params::Validate::validation_options( on_fail => sub { die @_ } );
41
42 my %VALID_PARAMS = ();
43 my %CONTAINED_OBJECTS = ();
44 my %VALID_CACHE = ();
45 my %CONTAINED_CACHE = ();
46 my %DECORATEES = ();
47
48 sub new
49 {
50 my $proto = shift;
51 my $class = ref($proto) || $proto;
52 my $self = bless scalar validate_with
53 (
54 params => $class->create_contained_objects(@_),
55 spec => $class->validation_spec,
56 called => "$class->new()",
57 ), $class;
58 if ($HAVE_WEAKEN) {
59 my $c = $self->get_contained_object_spec;
60 foreach my $name (keys %$c) {
61 next if $c->{$name}{delayed};
62 $self->{$name}{container}{container} = $self;
63 weaken $self->{$name}{container}{container};
64 }
65 }
66 return $self;
67 }
68
69 sub all_specs
70 {
71 require B::Deparse;
72 my %out;
73
74 foreach my $class (sort keys %VALID_PARAMS)
75 {
76 my $params = $VALID_PARAMS{$class};
77
78 foreach my $name (sort keys %$params)
79 {
80 my $spec = $params->{$name};
81 my ($type, $default);
82 if ($spec->{isa}) {
83 my $obj_class;
84
85 $type = 'object';
86
87 if (exists $CONTAINED_OBJECTS{$class}{$name}) {
88 $default = "$CONTAINED_OBJECTS{$class}{$name}{class}->new";
89 }
90 } else {
91 ($type, $default) = ($spec->{parse}, $spec->{default});
92 }
93
94 if (ref($default) eq 'CODE') {
95 $default = 'sub ' . B::Deparse->new()->coderef2text($default);
96 $default =~ s/\s+/ /g;
97 } elsif (ref($default) eq 'ARRAY') {
98 $default = '[' . join(', ', map "'$_'", @$default) . ']';
99 } elsif (ref($default) eq 'Regexp') {
100 $type = 'regex';
101 $default =~ s,^\(\?(\w*)-\w*:(.*)\),/$2/$1,;
102 $default = "qr$default";
103 }
104 unless ($type) {
105 # Guess from the validation spec
106 $type = ($spec->{type} & ARRAYREF ? 'list' :
107 $spec->{type} & SCALAR ? 'string' :
108 $spec->{type} & CODEREF ? 'code' :
109 $spec->{type} & HASHREF ? 'hash' :
110 undef); # Oh well
111 }
112
113 my $descr = $spec->{descr} || '(No description available)';
114 $out{$class}{valid_params}{$name} = { type => $type,
115 pv_type => $spec->{type},
116 default => $default,
117 descr => $descr,
118 required => defined $default || $spec->{optional} ? 0 : 1,
119 public => exists $spec->{public} ? $spec->{public} : 1,
120 };
121 }
122
123 $out{$class}{contained_objects} = {};
124 next unless exists $CONTAINED_OBJECTS{$class};
125 my $contains = $CONTAINED_OBJECTS{$class};
126
127 foreach my $name (sort keys %$contains)
128 {
129 $out{$class}{contained_objects}{$name}
130 = {map {$_, $contains->{$name}{$_}} qw(class delayed descr)};
131 }
132 }
133
134 return %out;
135 }
136
137 sub dump_parameters {
138 my $self = shift;
139 my $class = ref($self) || $self;
140
141 my %params;
142 foreach my $param (keys %{ $class->validation_spec }) {
143 next if $param eq 'container';
144 my $spec = $class->validation_spec->{$param};
145 if (ref($self) and defined $self->{$param}) {
146 $params{$param} = $self->{$param};
147 } else {
148 $params{$param} = $spec->{default} if exists $spec->{default};
149 }
150 }
151
152 foreach my $name (keys %{ $class->get_contained_object_spec }) {
153 next unless ref($self);
154 my $contained = ($self->{container}{contained}{$name}{delayed} ?
155 $self->delayed_object_class($name) :
156 $params{$name});
157
158 my $subparams = UNIVERSAL::isa($contained, __PACKAGE__) ? $contained->dump_parameters : {};
159
160 my $more = $self->{container}{contained}{$name}{args} || {};
161 $subparams->{$_} = $more->{$_} foreach keys %$more;
162
163 @params{ keys %$subparams } = values %$subparams;
164 delete $params{$name};
165 }
166 return \%params;
167 }
168
169 sub show_containers {
170 my $self = shift;
171 my $name = shift;
172 my %args = (indent => '', @_);
173
174 $name = defined($name) ? "$name -> " : "";
175
176 my $out = "$args{indent}$name$self";
177 $out .= " (delayed)" if $args{delayed};
178 $out .= "\n";
179 return $out unless $self->isa(__PACKAGE__);
180
181 my $specs = ref($self) ? $self->{container}{contained} : $self->get_contained_object_spec;
182
183 while (my ($name, $spec) = each %$specs) {
184 my $class = $args{args}{"${name}_class"} || $spec->{class};
185 $self->_load_module($class);
186
187 if ($class->isa(__PACKAGE__)) {
188 $out .= $class->show_containers($name,
189 indent => "$args{indent} ",
190 args => $spec->{args},
191 delayed => $spec->{delayed});
192 } else {
193 $out .= "$args{indent} $name -> $class\n";
194 }
195 }
196
197 return $out;
198 }
199
200 sub _expire_caches {
201 %VALID_CACHE = %CONTAINED_CACHE = ();
202 }
203
204 sub valid_params {
205 my $class = shift;
206 if (@_) {
207 $class->_expire_caches;
208 $VALID_PARAMS{$class} = @_ == 1 && !defined($_[0]) ? {} : {@_};
209 }
210 return $VALID_PARAMS{$class} ||= {};
211 }
212
213 sub contained_objects
214 {
215 my $class = shift;
216 $class->_expire_caches;
217 $CONTAINED_OBJECTS{$class} = {};
218 while (@_) {
219 my ($name, $spec) = (shift, shift);
220 $CONTAINED_OBJECTS{$class}{$name} = ref($spec) ? $spec : { class => $spec };
221 }
222 }
223
224 sub _decorator_AUTOLOAD {
225 my $self = shift;
226 no strict 'vars';
227 my ($method) = $AUTOLOAD =~ /([^:]+)$/;
228 return if $method eq 'DESTROY';
229 die qq{Can't locate object method "$method" via package $self} unless ref($self);
230 my $subr = $self->{_decorates}->can($method)
231 or die qq{Can't locate object method "$method" via package } . ref($self);
232 unshift @_, $self->{_decorates};
233 goto $subr;
234 }
235
236 sub _decorator_CAN {
237 my ($self, $method) = @_;
238 return $self->SUPER::can($method) if $self->SUPER::can($method);
239 if (ref $self) {
240 return $self->{_decorates}->can($method) if $self->{_decorates};
241 return undef;
242 } else {
243 return $DECORATEES{$self}->can($method);
244 }
245 }
246
247 sub decorates {
248 my ($class, $super) = @_;
249
250 no strict 'refs';
251 $super ||= ${$class . '::ISA'}[0];
252
253 # Pass through unknown method invocations
254 *{$class . '::AUTOLOAD'} = \&_decorator_AUTOLOAD;
255 *{$class . '::can'} = \&_decorator_CAN;
256
257 $DECORATEES{$class} = $super;
258 $VALID_PARAMS{$class}{_decorates} = { isa => $super, optional => 1 };
259 }
260
261 sub container {
262 my $self = shift;
263 die "The ", ref($self), "->container() method requires installation of Scalar::Util" unless $HAVE_WEAKEN;
264 return $self->{container}{container};
265 }
266
267 sub call_method {
268 my ($self, $name, $method, @args) = @_;
269
270 my $class = $self->contained_class($name)
271 or die "Unknown contained item '$name'";
272
273 $self->_load_module($class);
274 return $class->$method( %{ $self->{container}{contained}{$name}{args} }, @args );
275 }
276
277 # Accepts a list of key-value pairs as parameters, representing all
278 # parameters taken by this object and its descendants. Returns a list
279 # of key-value pairs representing *only* this object's parameters.
280 sub create_contained_objects
281 {
282 # Typically $self doesn't exist yet, $_[0] is a string classname
283 my $class = shift;
284
285 my $c = $class->get_contained_object_spec;
286 return {@_, container => {}} unless %$c or $DECORATEES{$class};
287
288 my %args = @_;
289
290 if ($DECORATEES{$class}) {
291 # Fix format
292 $args{decorate_class} = [$args{decorate_class}]
293 if $args{decorate_class} and !ref($args{decorate_class});
294
295 # Figure out which class to decorate
296 my $decorate;
297 if (my $c = $args{decorate_class}) {
298 $decorate = @$c ? shift @$c : undef;
299 delete $args{decorate_class} unless @$c;
300 }
301 $c->{_decorates} = { class => $decorate } if $decorate;
302 }
303
304 # This one is special, don't pass to descendants
305 my $container_stuff = delete($args{container}) || {};
306
307 keys %$c; # Reset the iterator - why can't I do this in get_contained_object_spec??
308 my %contained_args;
309 my %to_create;
310
311 while (my ($name, $spec) = each %$c) {
312 # Figure out exactly which class to make an object of
313 my ($contained_class, $c_args) = $class->_get_contained_args($name, \%args);
314 @contained_args{ keys %$c_args } = (); # Populate with keys
315 $to_create{$name} = { class => $contained_class,
316 args => $c_args };
317 }
318
319 while (my ($name, $spec) = each %$c) {
320 # This delete() needs to be outside the previous loop, because
321 # multiple contained objects might need to see it
322 delete $args{"${name}_class"};
323
324 if ($spec->{delayed}) {
325 $container_stuff->{contained}{$name} = $to_create{$name};
326 $container_stuff->{contained}{$name}{delayed} = 1;
327 } else {
328 $args{$name} ||= $to_create{$name}{class}->new(%{$to_create{$name}{args}});
329 $container_stuff->{contained}{$name}{class} = ref $args{$name};
330 }
331 }
332
333 # Delete things that we're not going to use - things that are in
334 # our contained object specs but not in ours.
335 my $my_spec = $class->validation_spec;
336 delete @args{ grep {!exists $my_spec->{$_}} keys %contained_args };
337 delete $c->{_decorates} if $DECORATEES{$class};
338
339 $args{container} = $container_stuff;
340 return \%args;
341 }
342
343 sub create_delayed_object
344 {
345 my ($self, $name) = (shift, shift);
346 croak "Unknown delayed item '$name'" unless $self->{container}{contained}{$name}{delayed};
347
348 if ($HAVE_WEAKEN) {
349 push @_, container => {container => $self};
350 weaken $_[-1]->{container};
351 }
352 return $self->call_method($name, 'new', @_);
353 }
354
355 sub delayed_object_class
356 {
357 my $self = shift;
358 my $name = shift;
359 croak "Unknown delayed item '$name'"
360 unless $self->{container}{contained}{$name}{delayed};
361
362 return $self->{container}{contained}{$name}{class};
363 }
364
365 sub contained_class
366 {
367 my ($self, $name) = @_;
368 croak "Unknown contained item '$name'"
369 unless my $spec = $self->{container}{contained}{$name};
370 return $spec->{class};
371 }
372
373 sub delayed_object_params
374 {
375 my ($self, $name) = (shift, shift);
376 croak "Unknown delayed object '$name'"
377 unless $self->{container}{contained}{$name}{delayed};
378
379 if (@_ == 1) {
380 return $self->{container}{contained}{$name}{args}{$_[0]};
381 }
382
383 my %args = @_;
384
385 if (keys %args)
386 {
387 @{ $self->{container}{contained}{$name}{args} }{ keys %args } = values %args;
388 }
389
390 return %{ $self->{container}{contained}{$name}{args} };
391 }
392
393 # Everything the specified contained object will accept, including
394 # parameters it will pass on to its own contained objects.
395 sub _get_contained_args
396 {
397 my ($class, $name, $args) = @_;
398
399 my $spec = $class->get_contained_object_spec->{$name}
400 or croak "Unknown contained object '$name'";
401
402 my $contained_class = $args->{"${name}_class"} || $spec->{class};
403 croak "Invalid class name '$contained_class'"
404 unless $contained_class =~ /^[\w:]+$/;
405
406 $class->_load_module($contained_class);
407 return ($contained_class, {}) unless $contained_class->isa(__PACKAGE__);
408
409 my $allowed = $contained_class->allowed_params($args);
410
411 my %contained_args;
412 foreach (keys %$allowed) {
413 $contained_args{$_} = $args->{$_} if exists $args->{$_};
414 }
415 return ($contained_class, \%contained_args);
416 }
417
418 sub _load_module {
419 my ($self, $module) = @_;
420
421 unless ( eval { $module->can('new') } )
422 {
423 no strict 'refs';
424 eval "use $module";
425 croak $@ if $@;
426 }
427 }
428
429 sub allowed_params
430 {
431 my $class = shift;
432 my $args = ref($_[0]) ? shift : {@_};
433
434 # Strategy: the allowed_params of this class consists of the
435 # validation_spec of this class, merged with the allowed_params of
436 # all contained classes. The specific contained classes may be
437 # affected by arguments passed in, like 'interp' or
438 # 'interp_class'. A parameter like 'interp' doesn't add anything
439 # to our allowed_params (because it's already created) but
440 # 'interp_class' does.
441
442 my $c = $class->get_contained_object_spec;
443 my %p = %{ $class->validation_spec };
444
445 foreach my $name (keys %$c)
446 {
447 # Can accept a 'foo' parameter - should already be in the validation_spec.
448 # Also, its creation parameters should already have been extracted from $args,
449 # so don't extract any parameters.
450 next if exists $args->{$name};
451
452 # Figure out what class to use for this contained item
453 my $contained_class;
454 if ( exists $args->{"${name}_class"} ) {
455 $contained_class = $args->{"${name}_class"};
456 $p{"${name}_class"} = { type => SCALAR }; # Add to spec
457 } else {
458 $contained_class = $c->{$name}{class};
459 }
460
461 # We have to make sure it is loaded before we try calling allowed_params()
462 $class->_load_module($contained_class);
463 next unless $contained_class->can('allowed_params');
464
465 my $subparams = $contained_class->allowed_params($args);
466
467 foreach (keys %$subparams) {
468 $p{$_} ||= $subparams->{$_};
469 }
470 }
471
472 return \%p;
473 }
474
475 sub _iterate_ISA {
476 my ($class, $look_in, $cache_in, $add) = @_;
477
478 return $cache_in->{$class} if $cache_in->{$class};
479
480 my %out;
481
482 no strict 'refs';
483 foreach my $superclass (@{ "${class}::ISA" }) {
484 next unless $superclass->isa(__PACKAGE__);
485 my $superparams = $superclass->_iterate_ISA($look_in, $cache_in, $add);
486 @out{keys %$superparams} = values %$superparams;
487 }
488 if (my $x = $look_in->{$class}) {
489 @out{keys %$x} = values %$x;
490 }
491
492 @out{keys %$add} = values %$add if $add;
493
494 return $cache_in->{$class} = \%out;
495 }
496
497 sub get_contained_object_spec {
498 return (ref($_[0]) || $_[0])->_iterate_ISA(\%CONTAINED_OBJECTS, \%CONTAINED_CACHE);
499 }
500
501 sub validation_spec {
502 return (ref($_[0]) || $_[0])->_iterate_ISA(\%VALID_PARAMS, \%VALID_CACHE, { container => {type => HASHREF} });
503 }
504
505 1;
506
507 __END__
508
509 =head1 NAME
510
511 Class::Container - Glues object frameworks together transparently
512
513 =head1 SYNOPSIS
514
515 package Car;
516 use Class::Container;
517 @ISA = qw(Class::Container);
518
519 __PACKAGE__->valid_params
520 (
521 paint => {default => 'burgundy'},
522 style => {default => 'coupe'},
523 windshield => {isa => 'Glass'},
524 radio => {isa => 'Audio::Device'},
525 );
526
527 __PACKAGE__->contained_objects
528 (
529 windshield => 'Glass::Shatterproof',
530 wheel => { class => 'Vehicle::Wheel',
531 delayed => 1 },
532 radio => 'Audio::MP3',
533 );
534
535 sub new {
536 my $package = shift;
537
538 # 'windshield' and 'radio' objects are created automatically by
539 # SUPER::new()
540 my $self = $package->SUPER::new(@_);
541
542 $self->{right_wheel} = $self->create_delayed_object('wheel');
543 ... do any more initialization here ...
544 return $self;
545 }
546
547 =head1 DESCRIPTION
548
549 This class facilitates building frameworks of several classes that
550 inter-operate. It was first designed and built for C<HTML::Mason>, in
551 which the Compiler, Lexer, Interpreter, Resolver, Component, Buffer,
552 and several other objects must create each other transparently,
553 passing the appropriate parameters to the right class, possibly
554 substituting other subclasses for any of these objects.
555
556 The main features of C<Class::Container> are:
557
558 =over 4
559
560 =item *
561
562 Explicit declaration of containment relationships (aggregation,
563 factory creation, etc.)
564
565 =item *
566
567 Declaration of constructor parameters accepted by each member in a
568 class framework
569
570 =item *
571
572 Transparent passing of constructor parameters to the class
573 that needs them
574
575 =item *
576
577 Ability to create one (automatic) or many (manual) contained
578 objects automatically and transparently
579
580 =back
581
582 =head2 Scenario
583
584 Suppose you've got a class called C<Parent>, which contains an object of
585 the class C<Child>, which in turn contains an object of the class
586 C<GrandChild>. Each class creates the object that it contains.
587 Each class also accepts a set of named parameters in its
588 C<new()> method. Without using C<Class::Container>, C<Parent> will
589 have to know all the parameters that C<Child> takes, and C<Child> will
590 have to know all the parameters that C<GrandChild> takes. And some of
591 the parameters accepted by C<Parent> will really control aspects of
592 C<Child> or C<GrandChild>. Likewise, some of the parameters accepted
593 by C<Child> will really control aspects of C<GrandChild>. So, what
594 happens when you decide you want to use a C<GrandDaughter> class
595 instead of the generic C<GrandChild>? C<Parent> and C<Child> must be
596 modified accordingly, so that any additional parameters taken by
597 C<GrandDaughter> can be accommodated. This is a pain - the kind of
598 pain that object-oriented programming was supposed to shield us from.
599
600 Now, how can C<Class::Container> help? Using C<Class::Container>,
601 each class (C<Parent>, C<Child>, and C<GrandChild>) will declare what
602 arguments they take, and declare their relationships to the other
603 classes (C<Parent> creates/contains a C<Child>, and C<Child>
604 creates/contains a C<GrandChild>). Then, when you create a C<Parent>
605 object, you can pass C<< Parent->new() >> all the parameters for all
606 three classes, and they will trickle down to the right places.
607 Furthermore, C<Parent> and C<Child> won't have to know anything about
608 the parameters of its contained objects. And finally, if you replace
609 C<GrandChild> with C<GrandDaughter>, no changes to C<Parent> or
610 C<Child> will likely be necessary.
611
612 =head1 METHODS
613
614 =head2 new()
615
616 Any class that inherits from C<Class::Container> should also inherit
617 its C<new()> method. You can do this simply by omitting it in your
618 class, or by calling C<SUPER::new(@_)> as indicated in the SYNOPSIS.
619 The C<new()> method ensures that the proper parameters and objects are
620 passed to the proper constructor methods.
621
622 At the moment, the only possible constructor method is C<new()>. If
623 you need to create other constructor methods, they should call
624 C<new()> internally.
625
626 =head2 __PACKAGE__->contained_objects()
627
628 This class method is used to register what other objects, if any, a given
629 class creates. It is called with a hash whose keys are the parameter
630 names that the contained class's constructor accepts, and whose values
631 are the default class to create an object of.
632
633 For example, consider the C<HTML::Mason::Compiler> class, which uses
634 the following code:
635
636 __PACKAGE__->contained_objects( lexer => 'HTML::Mason::Lexer' );
637
638 This defines the relationship between the C<HTML::Mason::Compiler>
639 class and the class it creates to go in its C<lexer> slot. The
640 C<HTML::Mason::Compiler> class "has a" C<lexer>. The C<<
641 HTML::Mason::Compiler->new() >> method will accept a C<lexer>
642 parameter and, if no such parameter is given, an object of the
643 C<HTML::Mason::Lexer> class should be constructed.
644
645 We implement a bit of magic here, so that if C<<
646 HTML::Mason::Compiler->new() >> is called with a C<lexer_class>
647 parameter, it will load the indicated class (presumably a subclass of
648 C<HTML::Mason::Lexer>), instantiate a new object of that class, and
649 use it for the Compiler's C<lexer> object. We're also smart enough to
650 notice if parameters given to C<< HTML::Mason::Compiler->new() >>
651 actually should go to the C<lexer> contained object, and it will make
652 sure that they get passed along.
653
654 Furthermore, an object may be declared as "delayed", which means that
655 an object I<won't> be created when its containing class is constructed.
656 Instead, these objects will be created "on demand", potentially more
657 than once. The constructors will still enjoy the automatic passing of
658 parameters to the correct class. See the C<create_delayed_object()>
659 for more.
660
661 To declare an object as "delayed", call this method like this:
662
663 __PACKAGE__->contained_objects( train => { class => 'Big::Train',
664 delayed => 1 } );
665
666 =head2 __PACKAGE__->valid_params(...)
667
668 Specifies the parameters accepted by this class's C<new()> method as a
669 set of key/value pairs. Any parameters accepted by a
670 superclass/subclass will also be accepted, as well as any parameters
671 accepted by contained objects. This method is a get/set accessor
672 method, so it returns a reference to a hash of these key/value pairs.
673 As a special case, if you wish to set the valid params to an empty set
674 and you previously set it to a non-empty set, you may call
675 C<< __PACKAGE__->valid_params(undef) >>.
676
677 C<valid_params()> is called with a hash that contains parameter names
678 as its keys and validation specifications as values. This validation
679 specification is largely the same as that used by the
680 C<Params::Validate> module, because we use C<Params::Validate>
681 internally.
682
683 As an example, consider the following situation:
684
685 use Class::Container;
686 use Params::Validate qw(:types);
687 __PACKAGE__->valid_params
688 (
689 allow_globals => { type => ARRAYREF, parse => 'list', default => [] },
690 default_escape_flags => { type => SCALAR, parse => 'string', default => '' },
691 lexer => { isa => 'HTML::Mason::Lexer' },
692 preprocess => { type => CODEREF, parse => 'code', optional => 1 },
693 postprocess_perl => { type => CODEREF, parse => 'code', optional => 1 },
694 postprocess_text => { type => CODEREF, parse => 'code', optional => 1 },
695 );
696
697 __PACKAGE__->contained_objects( lexer => 'HTML::Mason::Lexer' );
698
699 The C<type>, C<default>, and C<optional> parameters are part of the
700 validation specification used by C<Params::Validate>. The various
701 constants used, C<ARRAYREF>, C<SCALAR>, etc. are all exported by
702 C<Params::Validate>. This means that any of these six parameter
703 names, plus the C<lexer_class> parameter (because of the
704 C<contained_objects()> specification given earlier), are valid
705 arguments to the Compiler's C<new()> method.
706
707 Note that there are also some C<parse> attributes declared. These
708 have nothing to do with C<Class::Container> or C<Params::Validate> -
709 any extra entries like this are simply ignored, so you are free to put
710 extra information in the specifications as long as it doesn't overlap
711 with what C<Class::Container> or C<Params::Validate> are looking for.
712
713 =head2 $self->create_delayed_object()
714
715 If a contained object was declared with C<< delayed => 1 >>, use this
716 method to create an instance of the object. Note that this is an
717 object method, not a class method:
718
719 my $foo = $self->create_delayed_object('foo', ...); # YES!
720 my $foo = __PACKAGE__->create_delayed_object('foo', ...); # NO!
721
722 The first argument should be a key passed to the
723 C<contained_objects()> method. Any additional arguments will be
724 passed to the C<new()> method of the object being created, overriding
725 any parameters previously passed to the container class constructor.
726 (Could I possibly be more alliterative? Veni, vedi, vici.)
727
728 =head2 $self->delayed_object_params($name, [params])
729
730 Allows you to adjust the parameters that will be used to create any
731 delayed objects in the future. The first argument specifies the
732 "name" of the object, and any additional arguments are key-value pairs
733 that will become parameters to the delayed object.
734
735 When called with only a C<$name> argument and no list of parameters to
736 set, returns a hash reference containing the parameters that will be
737 passed when creating objects of this type.
738
739 =head2 $self->delayed_object_class($name)
740
741 Returns the class that will be used when creating delayed objects of
742 the given name. Use this sparingly - in most situations you shouldn't
743 care what the class is.
744
745 =head2 __PACKAGE__->decorates()
746
747 Version 0.09 of Class::Container added [as yet experimental] support
748 for so-called "decorator" relationships, using the term as defined in
749 I<Design Patterns> by Gamma, et al. (the Gang of Four book). To
750 declare a class as a decorator of another class, simply set C<@ISA> to
751 the class which will be decorated, and call the decorator class's
752 C<decorates()> method.
753
754 Internally, this will ensure that objects are instantiated as
755 decorators. This means that you can mix & match extra add-on
756 functionality classes much more easily.
757
758 In the current implementation, if only a single decoration is used on
759 an object, it will be instantiated as a simple subclass, thus avoiding
760 a layer of indirection.
761
762 =head2 $self->validation_spec()
763
764 Returns a hash reference suitable for passing to the
765 C<Params::Validate> C<validate> function. Does I<not> include any
766 arguments that can be passed to contained objects.
767
768 =head2 $class->allowed_params(\%args)
769
770 Returns a hash reference of every parameter this class will accept,
771 I<including> parameters it will pass on to its own contained objects.
772 The keys are the parameter names, and the values are their
773 corresponding specifications from their C<valid_params()> definitions.
774 If a parameter is used by both the current object and one of its
775 contained objects, the specification returned will be from the
776 container class, not the contained.
777
778 Because the parameters accepted by C<new()> can vary based on the
779 parameters I<passed> to C<new()>, you can pass any parameters to the
780 C<allowed_params()> method too, ensuring that the hash you get back is
781 accurate.
782
783 =head2 $self->container()
784
785 Returns the object that created you. This is remembered by storing a
786 reference to that object, so we use the C<Scalar::Utils> C<weakref()>
787 function to avoid persistent circular references that would cause
788 memory leaks. If you don't have C<Scalar::Utils> installed, we don't
789 make these references in the first place, and calling C<container()>
790 will result in a fatal error.
791
792 If you weren't created by another object via C<Class::Container>,
793 C<container()> returns C<undef>.
794
795 In most cases you shouldn't care what object created you, so use this
796 method sparingly.
797
798 =head2 $object->show_containers
799
800 =head2 $package->show_containers
801
802 This method returns a string meant to describe the containment
803 relationships among classes. You should not depend on the specific
804 formatting of the string, because I may change things in a future
805 release to make it prettier.
806
807 For example, the HTML::Mason code returns the following when you do
808 C<< $interp->show_containers >>:
809
810 HTML::Mason::Interp=HASH(0x238944)
811 resolver -> HTML::Mason::Resolver::File
812 compiler -> HTML::Mason::Compiler::ToObject
813 lexer -> HTML::Mason::Lexer
814 request -> HTML::Mason::Request (delayed)
815 buffer -> HTML::Mason::Buffer (delayed)
816
817 Currently, containment is shown by indentation, so the Interp object
818 contains a resolver and a compiler, and a delayed request (or several
819 delayed requests). The compiler contains a lexer, and each request
820 contains a delayed buffer (or several delayed buffers).
821
822 =head2 $object->dump_parameters
823
824 Returns a hash reference containing a set of parameters that should be
825 sufficient to re-create the given object using its class's C<new()>
826 method. This is done by fetching the current value for each declared
827 parameter (i.e. looking in C<$object> for hash entries of the same
828 name), then recursing through all contained objects and doing the
829 same.
830
831 A few words of caution here. First, the dumped parameters represent
832 the I<current> state of the object, not the state when it was
833 originally created.
834
835 Second, a class's declared parameters may not correspond exactly to
836 its data members, so it might not be possible to recover the former
837 from the latter. If it's possible but requires some manual fudging,
838 you can override this method in your class, something like so:
839
840 sub dump_parameters {
841 my $self = shift;
842 my $dump = $self->SUPER::dump_parameters();
843
844 # Perform fudgery
845 $dump->{incoming} = $self->{_private};
846 delete $dump->{superfluous};
847 return $dump;
848 }
849
850 =head1 SEE ALSO
851
852 L<Params::Validate>
853
854 =head1 AUTHOR
855
856 Originally by Ken Williams <ken@mathforum.org> and Dave Rolsky
857 <autarch@urth.org> for the HTML::Mason project. Important feedback
858 contributed by Jonathan Swartz <swartz@pobox.com>. Extended by Ken
859 Williams for the AI::Categorizer project.
860
861 Currently maintained by Ken Williams.
862
863 =head1 COPYRIGHT
864
865 This program is free software; you can redistribute it and/or modify
866 it under the same terms as Perl itself.
867
868 =cut
+287
-0
t/01-basic.t less more
0 #!/usr/bin/perl -w
1
2 # Note - I create a bunch of classes in these tests and then change
3 # their valid_params() and contained_objects() lists several times.
4 # This isn't really supported behavior of this module, but it's
5 # necessary to do it in the tests.
6
7 use strict;
8
9 use Test;
10
11 use Class::Container;
12 use Params::Validate qw(:types);
13 use File::Spec;
14 require File::Spec->catfile('t', 'classes.pl');
15
16 my $HAVE_WEAKEN = 0 + exists $INC{'Scalar/Util.pm'};
17
18 plan tests => 67 + 1*$HAVE_WEAKEN;
19
20 use Carp; $SIG{__DIE__} = \&Carp::confess;
21
22 eval {new Daughter(hair => 'long')};
23 ok $@, '', "Try making an object";
24
25 eval {new Parent()};
26 ok $@, '/mood/', "Should fail, missing required parameter";
27
28 my %args = (parent_val => 7,
29 mood => 'bubbly');
30
31 eval {new Parent(%args)};
32 ok $@, '', "Try creating top-level object";
33
34 my $mood = eval {Parent->new(%args)->{son}->{mood}};
35 ok $mood, 'bubbly';
36 ok $@, '', "Make sure sub-objects are created with proper values";
37
38 if ($HAVE_WEAKEN) {
39 my $p = Parent->new(%args);
40 ok $p->{son}->container, $p, "Container of son should be parent";
41 }
42
43 eval {my $p = new Parent(%args);
44 $p->create_delayed_object('daughter')};
45 ok $@, '', "Create a delayed object";
46
47 my $d = eval {Parent->new(%args)->create_delayed_object('daughter', hair => 'short')};
48 ok $@, '', "Create a delayed object with parameters";
49 ok $d->{hair}, 'short', "Make sure parameters are propogated to delayed object";
50
51 eval {new Daughter(foo => 'invalid')};
52 ok $@, '/Daughter/', "Make sure error messages contain the name of the class";
53
54 # Make sure we can override class names
55 {
56 ok my $p = eval {new Parent(mood => 'foo', parent_val => 1,
57 daughter_class => 'StepDaughter',
58 toy_class => 'Ball',
59 other_toys_class => 'Streamer',
60 son_class => 'StepSon')};
61 warn $@ if $@;
62
63 my $d = eval {$p->create_delayed_object('daughter')};
64 ok $@, '';
65
66 ok ref($d), 'StepDaughter';
67 ok ref($p->{son}), 'StepSon';
68
69 # Note - if one of these fails and the other succeeds, then we're
70 # not properly passing 'toy_class' to both son & daughter classes.
71 ok ref($d->{toy}), 'Ball';
72 ok ref($p->{son}{toy}), 'Ball';
73
74 ok $d->delayed_object_class('other_toys'), 'Streamer';
75 ok $p->{son}->delayed_object_class('other_toys'), 'Streamer';
76
77 # Special 'container' parameter shouldn't be shared among objects
78 ok ($p->{container} ne $p->{son}{container});
79
80 # Check some of the formatting of show_containers()
81 my $string = $p->show_containers;
82 ok $string, '/\n son -> StepSon/', $string;
83 }
84
85
86 {
87 # Check that subclass contained_objects override superclass
88
89 local @Superclass::ISA = qw(Class::Container);
90 local @Subclass::ISA = qw(Superclass);
91 'Superclass'->valid_params( foo => {isa => 'Foo'} );
92 'Subclass'->valid_params( foo => {isa => 'Bar'} );
93 'Superclass'->contained_objects( foo => 'Foo' );
94 'Subclass'->contained_objects( foo => 'Bar' );
95 local @Bar::ISA = qw(Foo);
96 sub Foo::new { bless {}, 'Foo' }
97 sub Bar::new { bless {}, 'Bar' }
98
99 my $child = 'Subclass'->new;
100 ok ref($child->{foo}), 'Bar', 'Subclass contained_object should override superclass';
101
102 my $spec = 'Subclass'->validation_spec;
103 ok $spec->{foo}{isa}, 'Bar';
104 }
105
106 {
107 local @Top::ISA = qw(Class::Container);
108 'Top'->valid_params( document => {isa => 'Document'} );
109 'Top'->contained_objects( document => 'Document',
110 collection => {class => 'Collection', delayed => 1} );
111
112 local @Collection::ISA = qw(Class::Container);
113 'Collection'->contained_objects( document => {class => 'Document', delayed => 1} );
114
115 local @Document::ISA = qw(Class::Container);
116 local @Document2::ISA = qw(Document);
117
118 my $k = new Top;
119 print $k->show_containers;
120 ok $k->contained_class('document'), 'Document';
121 my $collection = $k->create_delayed_object('collection');
122 ok ref($collection), 'Collection';
123 ok $collection->contained_class('document'), 'Document';
124
125 my $string = $k->show_containers;
126 ok $string, '/ collection -> Collection \(delayed\)/';
127 ok $string, '/ document -> Document \(delayed\)/';
128
129 my $k2 = new Top(document_class => 'Document2');
130 print $k2->show_containers;
131 ok $k2->contained_class('document'), 'Document2';
132 my $collection2 = $k2->create_delayed_object('collection');
133 ok ref($collection2), 'Collection';
134 ok $collection2->contained_class('document'), 'Document2';
135
136 my $string2 = $k2->show_containers;
137 ok $string2, '/ collection -> Collection \(delayed\)/';
138 ok $string2, '/ document -> Document2 \(delayed\)/';
139 }
140
141 {
142 local @Top::ISA = qw(Class::Container);
143 'Top'->valid_params( document => {isa => 'Document1'} );
144 'Top'->contained_objects( document => 'Document1' );
145
146 my $contained = 'Top'->get_contained_object_spec;
147 ok $contained->{document};
148 ok !$contained->{collection}; # Shouldn't have anything left over from the last block
149
150 local @Document1::ISA = qw(Class::Container);
151 'Document1'->valid_params( doc1 => {type => SCALAR} );
152
153 local @Document2::ISA = qw(Class::Container);
154 'Document2'->valid_params( doc2 => {type => SCALAR} );
155
156 my $allowed = 'Top'->allowed_params();
157 ok $allowed->{doc1};
158 ok !$allowed->{doc2};
159
160 $allowed = 'Top'->allowed_params( document_class => 'Document2' );
161 ok $allowed->{doc2};
162 ok !$allowed->{doc1};
163 }
164
165 {
166 local @Top::ISA = qw(Class::Container);
167 'Top'->_expire_caches;
168 'Top'->valid_params( document => {isa => 'Document1'} );
169 'Top'->contained_objects( document => 'Document1' );
170
171 local @Document1::ISA = qw(Class::Container);
172 'Document1'->valid_params();
173 local @Document2::ISA = qw(Document1);
174 'Document2'->valid_params();
175
176 my $t = new Top( document => bless {}, 'Document2' );
177 ok $t;
178 ok ref($t->{document}), 'Document2';
179 }
180
181 {
182 local @Top::ISA = qw(Class::Container);
183 'Top'->valid_params( document => {isa => 'Document'} );
184 'Top'->contained_objects( document => 'Document' );
185
186 local @Document::ISA = qw(Class::Container);
187 'Document'->valid_params( sub => {isa => 'Class::Container'} );
188 'Document'->contained_objects( sub => 'Sub1' );
189
190 local @Sub1::ISA = qw(Class::Container);
191 'Sub1'->valid_params( bar => {type => SCALAR} );
192 'Sub1'->contained_objects();
193
194 local @Sub2::ISA = qw(Class::Container);
195 'Sub2'->valid_params( foo => {type => SCALAR} );
196 'Sub2'->contained_objects();
197
198 my $allowed = 'Top'->allowed_params();
199 ok $allowed->{document};
200 ok $allowed->{bar};
201 ok !$allowed->{foo};
202
203 $allowed = 'Top'->allowed_params(sub_class => 'Sub2');
204 ok $allowed->{document};
205 ok !$allowed->{bar};
206 ok $allowed->{foo};
207 }
208
209 {
210 local @Top::ISA = qw(Class::Container);
211 Top->valid_params(foo => {type => SCALAR});
212 Top->contained_objects();
213
214 ok 'Top'->valid_params;
215 ok 'Top'->valid_params->{foo}{type}, SCALAR;
216 }
217
218 {
219 local @Top::ISA = qw(Class::Container);
220 Top->valid_params(foo => {type => SCALAR}, child => {isa => 'Child'});
221 Top->contained_objects(child => 'Child');
222
223 local @Child::ISA = qw(Class::Container);
224 Child->valid_params(bar => {type => SCALAR}, grand_child => {isa => 'GrandChild'});
225 Child->contained_objects(grand_child => 'GrandChild');
226
227 local @GrandChild::ISA = qw(Class::Container);
228 GrandChild->valid_params(baz => {type => SCALAR}, boo => {default => 5});
229 GrandChild->contained_objects();
230
231 local @GrandSibling::ISA = qw(GrandChild);
232
233 my $dump = GrandSibling->new(baz => 'BAZ')->dump_parameters;
234 ok keys(%$dump), 2;
235 ok $dump->{baz}, 'BAZ', "Sibling has baz=BAZ";
236 ok $dump->{boo}, 5, "Sibling has boo=5";
237
238 $dump = Child->new(bar => 'BAR', baz => 'BAZ')->dump_parameters;
239 ok keys(%$dump), 3;
240 ok $dump->{bar}, 'BAR';
241 ok $dump->{baz}, 'BAZ';
242
243 $dump = Child->new(bar => 'BAR', baz => 'BAZ', grand_child_class => 'GrandChild')->dump_parameters;
244 ok keys(%$dump), 3;
245 ok $dump->{bar}, 'BAR';
246 ok $dump->{baz}, 'BAZ';
247
248 $dump = Top->new(foo => 'FOO', bar => 'BAR', baz => 'BAZ')->dump_parameters;
249 ok keys(%$dump), 4;
250 ok $dump->{foo}, 'FOO';
251 ok $dump->{bar}, 'BAR';
252 ok $dump->{baz}, 'BAZ';
253
254
255 # Test default values in a delayed object
256 Top->valid_params(undef);
257 Top->contained_objects(child => {class => 'Child', delayed => 1});
258
259 Child->valid_params(bar => {default => 4});
260 Child->contained_objects();
261
262 $dump = Top->new()->dump_parameters;
263 ok keys(%$dump), 1;
264 ok $dump->{bar}, 4;
265
266 $dump = Top->new(bar => 6)->dump_parameters;
267 ok keys(%$dump), 1;
268 ok $dump->{bar}, 6;
269 }
270
271 {
272 # Make sure a later call to valid_params() clears the param list
273 local @Top::ISA = qw(Class::Container);
274 Top->valid_params(undef);
275 Top->contained_objects();
276
277 ok eval{ new Top };
278 }
279
280 {
281 # Make sure valid_params() gives sensible null output
282 local @Nonexistent::ISA = qw(Class::Container);
283 my $params = Nonexistent->valid_params;
284 ok ref($params), 'HASH';
285 ok keys(%$params), 0;
286 }
+84
-0
t/02-decorator.t less more
0 use strict;
1
2 use Test;
3 BEGIN { plan tests => 24 }
4
5 use Class::Container;
6 use Params::Validate qw(:types);
7 use File::Spec;
8 require File::Spec->catfile('t', 'classes.pl');
9
10
11
12 # Decorator stuff
13 {
14 local @Top::ISA = qw(Class::Container);
15 Top->valid_params(undef);
16 Top->contained_objects();
17 sub Top::foo { "foo" }
18
19 local @Decorator::ISA = qw(Top);
20 Decorator->decorates;
21 sub Decorator::bar { "bar" }
22
23 local @OtherDec::ISA = qw(Top);
24 OtherDec->decorates;
25 sub OtherDec::baz { "baz" }
26
27 # Make sure a simple 1-level decorator works
28 {
29 my $d = new Decorator;
30 ok $d;
31
32 ok $d->foo, 'foo';
33 ok $d->bar, 'bar';
34
35 # Should be using simple subclassing since it's just 1 level (no interface for this)
36 ok !$d->{_decorates};
37
38 # Make sure can() is correct
39 # Test.pm will run subrefs (don't want that), so make them booleans
40 ok !!$d->can('foo');
41 ok !!$d->can('bar');
42 ok !$d->can('baz');
43 }
44
45 # Try a 2-level decorator
46 {
47 my $d = new Decorator(decorate_class => 'OtherDec');
48 ok $d;
49
50 ok !!$d->can('foo');
51 ok !!$d->can('bar');
52 ok !!$d->can('baz');
53
54 ok $d->foo, 'foo';
55 ok $d->bar, 'bar';
56 ok $d->baz, 'baz';
57
58 # Make sure it's using decoration containment at top level, and subclassing below.
59 ok $d->{_decorates};
60 ok ref($d->{_decorates}), 'OtherDec';
61 ok !$d->{_decorates}{_decorates};
62 }
63
64 # Make sure arguments are passed correctly
65 Top->valid_params( one => { type => SCALAR } );
66 Decorator->valid_params( two => { type => SCALAR } );
67 Top->decorates;
68 Decorator->decorates;
69 OtherDec->decorates;
70 my $d = Decorator->new( one => 1, two => 2 );
71 ok $d;
72
73 $d = OtherDec->new( decorate_class => 'Decorator', one => 1, two => 2 );
74 ok $d;
75 ok $d->{one}, 1;
76 ok $d->{_decorates}{two}, 2;
77
78 $d = Decorator->new( decorate_class => 'OtherDec', one => 1, two => 2 );
79 ok $d;
80 ok $d->{one}, 1;
81 ok $d->{two}, 2;
82 }
83
+67
-0
t/classes.pl less more
0 use strict;
1
2 use Params::Validate qw(:types);
3 my $SCALAR = SCALAR; # So we don't have to keep importing it below
4
5 # Create some boilerplate classes
6 {
7 no strict 'refs';
8 foreach my $class (qw(Parent Boy Toy Daughter)) {
9 push @{$class.'::ISA'}, 'Class::Container';
10 }
11 }
12
13 # Define the relationships
14 {
15 package Parent;
16 push @Parent::ISA, 'Foo'; # Make sure it works with non-container superclasses
17 # Has one son and several daughters
18 __PACKAGE__->valid_params( parent_val => { type => $SCALAR },
19 son => {isa => 'Son'},
20 );
21 __PACKAGE__->contained_objects( son => 'Son',
22 daughter => {delayed => 1,
23 class => 'Daughter'});
24 }
25
26 {
27 package Boy;
28 __PACKAGE__->valid_params( eyes => { default => 'brown', type => $SCALAR },
29 toy => {isa => 'Toy'});
30 __PACKAGE__->contained_objects( toy => 'Slingshot',
31 other_toys => {class => 'Toy', delayed => 1},
32 );
33 }
34
35 {
36 package Son;
37 push @Son::ISA, 'Boy';
38 __PACKAGE__->valid_params( mood => { type => $SCALAR } );
39 }
40
41 {
42 package Slingshot;
43 push @Slingshot::ISA, 'Toy';
44 __PACKAGE__->valid_params( weapon => { default => 'rock', type => $SCALAR } );
45 }
46
47 {
48 package Daughter;
49 __PACKAGE__->valid_params( hair => { default => 'short' } );
50 }
51
52 {
53 package StepDaughter;
54 push @StepDaughter::ISA, 'Daughter';
55 __PACKAGE__->valid_params( toy => {isa => 'Toy'} );
56 __PACKAGE__->contained_objects( toy => { class => 'Toy'},
57 other_toys => {class => 'Toy', delayed => 1},
58 );
59 }
60 {
61 push @StepSon::ISA, 'Son';
62 push @Ball::ISA, 'Toy';
63 push @Streamer::ISA, 'Toy';
64 }
65
66 1;