File Coverage

blib/lib/Class/Container.pm
Criterion Covered Total %
statement 205 251 81.7
branch 79 136 58.1
condition 30 49 61.2
subroutine 29 31 93.5
pod 12 17 70.6
total 355 484 73.3


line stmt bran cond sub pod time code
1             package Class::Container;
2              
3             $VERSION = '0.12';
4             $VERSION = eval $VERSION if $VERSION =~ /_/;
5              
6             my $HAVE_WEAKEN;
7             BEGIN {
8 2     2   24   eval {
9 2         31     require Scalar::Util;
10 2         47     Scalar::Util->import('weaken');
11 2         21     $HAVE_WEAKEN = 1;
12               };
13               
14 2 50       26   *weaken = sub {} unless defined &weaken;
  0         0  
15             }
16              
17 2     2   30 use strict;
  2         17  
  2         31  
18 2     2   28 use Carp;
  2         73  
  2         34  
19              
20             # The create_contained_objects() method lets one object
21             # (e.g. Compiler) transparently create another (e.g. Lexer) by passing
22             # creator parameters through to the created object.
23             #
24             # Any auto-created objects should be declared in a class's
25             # %CONTAINED_OBJECTS hash. The keys of this hash are objects which
26             # can be created and the values are the default classes to use.
27              
28             # For instance, the key 'lexer' indicates that a 'lexer' parameter
29             # should be silently passed through, and a 'lexer_class' parameter
30             # will trigger the creation of an object whose class is specified by
31             # the value. If no value is present there, the value of 'lexer' in
32             # the %CONTAINED_OBJECTS hash is used. If no value is present there,
33             # no contained object is created.
34             #
35             # We return the list of parameters for the creator. If contained
36             # objects were auto-created, their creation parameters aren't included
37             # in the return value. This lets the creator be totally ignorant of
38             # the creation parameters of any objects it creates.
39              
40 2     2   51 use Params::Validate qw(:all);
  2         20  
  2         44  
41             Params::Validate::validation_options( on_fail => sub { die @_ } );
42              
43             my %VALID_PARAMS = ();
44             my %CONTAINED_OBJECTS = ();
45             my %VALID_CACHE = ();
46             my %CONTAINED_CACHE = ();
47             my %DECORATEES = ();
48              
49             sub new
50             {
51 54     54 1 12118     my $proto = shift;
52 54   33     733     my $class = ref($proto) || $proto;
53 54         999     my $self = bless scalar validate_with
54                   (
55                    params => $class->create_contained_objects(@_),
56                    spec => $class->validation_spec,
57                    called => "$class->new()",
58                   ), $class;
59 51 50       4523     if ($HAVE_WEAKEN) {
60 51         546       my $c = $self->get_contained_object_spec;
61 51         592       foreach my $name (keys %$c) {
62 40 100       525 next if $c->{$name}{delayed};
63 21         211 $self->{$name}{container}{container} = $self;
64 21         286 weaken $self->{$name}{container}{container};
65                   }
66                 }
67 51         705     return $self;
68             }
69              
70             sub all_specs
71             {
72 0     0 0 0     require B::Deparse;
73 0         0     my %out;
74              
75 0         0     foreach my $class (sort keys %VALID_PARAMS)
76                 {
77 0         0 my $params = $VALID_PARAMS{$class};
78              
79 0         0 foreach my $name (sort keys %$params)
80             {
81 0         0 my $spec = $params->{$name};
82 0         0 my ($type, $default);
83 0 0       0 if ($spec->{isa}) {
84 0         0 my $obj_class;
85              
86 0         0 $type = 'object';
87              
88 0 0       0 if (exists $CONTAINED_OBJECTS{$class}{$name}) {
89 0         0 $default = "$CONTAINED_OBJECTS{$class}{$name}{class}->new";
90             }
91             } else {
92 0         0 ($type, $default) = ($spec->{parse}, $spec->{default});
93             }
94              
95 0 0       0 if (ref($default) eq 'CODE') {
    0          
    0          
96 0         0 $default = 'sub ' . B::Deparse->new()->coderef2text($default);
97 0         0 $default =~ s/\s+/ /g;
98             } elsif (ref($default) eq 'ARRAY') {
99 0         0 $default = '[' . join(', ', map "'$_'", @$default) . ']';
100             } elsif (ref($default) eq 'Regexp') {
101 0         0 $type = 'regex';
102 0         0 $default =~ s,^\(\?(\w*)-\w*:(.*)\),/$2/$1,;
103 0         0 $default = "qr$default";
104             }
105 0 0       0 unless ($type) {
106             # Guess from the validation spec
107 0 0       0 $type = ($spec->{type} & ARRAYREF ? 'list' :
    0          
    0          
    0          
108             $spec->{type} & SCALAR ? 'string' :
109             $spec->{type} & CODEREF ? 'code' :
110             $spec->{type} & HASHREF ? 'hash' :
111             undef);  # Oh well
112             }
113              
114 0   0     0 my $descr = $spec->{descr} || '(No description available)';
115 0 0 0     0 $out{$class}{valid_params}{$name} = { type => $type,
    0          
116             pv_type => $spec->{type},
117             default => $default,
118             descr => $descr,
119             required => defined $default || $spec->{optional} ? 0 : 1,
120             public => exists $spec->{public} ? $spec->{public} : 1,
121             };
122             }
123              
124 0         0 $out{$class}{contained_objects} = {};
125 0 0       0 next unless exists $CONTAINED_OBJECTS{$class};
126 0         0 my $contains = $CONTAINED_OBJECTS{$class};
127              
128 0         0 foreach my $name (sort keys %$contains)
129             {
130 0         0 $out{$class}{contained_objects}{$name} 
131 0         0 = {map {$_, $contains->{$name}{$_}} qw(class delayed descr)};
132             }
133                 }
134              
135 0         0     return %out;
136             }
137              
138             sub dump_parameters {
139 12     12 1 106   my $self = shift;
140 12   66     127   my $class = ref($self) || $self;
141               
142 12         99   my %params;
143 12         95   foreach my $param (keys %{ $class->validation_spec }) {
  12         198  
144 30 100       301     next if $param eq 'container';
145 18         199     my $spec = $class->validation_spec->{$param};
146 18 100 66     288     if (ref($self) and defined $self->{$param}) {
147 16         169       $params{$param} = $self->{$param};
148                 } else {
149 2 50       26       $params{$param} = $spec->{default} if exists $spec->{default};
150                 }
151               }
152               
153 12         130   foreach my $name (keys %{ $class->get_contained_object_spec }) {
  12         118  
154 6 50       63     next unless ref($self);
155 6 100       82     my $contained = ($self->{container}{contained}{$name}{delayed} ?
156             $self->delayed_object_class($name) :
157             $params{$name});
158                 
159 6 50       100     my $subparams = UNIVERSAL::isa($contained, __PACKAGE__) ? $contained->dump_parameters : {};
160                 
161 6   100     83     my $more = $self->{container}{contained}{$name}{args} || {};
162 6         48     $subparams->{$_} = $more->{$_} foreach keys %$more;
  6         64  
163                 
164 6         109     @params{ keys %$subparams } = values %$subparams;
165 6         77     delete $params{$name};
166               }
167 12         176   return \%params;
168             }
169              
170             sub show_containers {
171 23     23 1 293   my $self = shift;
172 23         198   my $name = shift;
173 23         280   my %args = (indent => '', @_);
174              
175 23 100       238   $name = defined($name) ? "$name -> " : "";
176              
177 23         236   my $out = "$args{indent}$name$self";
178 23 100       286   $out .= " (delayed)" if $args{delayed};
179 23         219   $out .= "\n";
180 23 50       338   return $out unless $self->isa(__PACKAGE__);
181              
182 23 100       244   my $specs = ref($self) ? $self->{container}{contained} : $self->get_contained_object_spec;
183              
184 23         274   while (my ($name, $spec) = each %$specs) {
185 18   66     253     my $class = $args{args}{"${name}_class"} || $spec->{class};
186 18         174     $self->_load_module($class);
187              
188 18 50       245     if ($class->isa(__PACKAGE__)) {
189 18         320       $out .= $class->show_containers($name,
190             indent => "$args{indent} ",
191             args => $spec->{args},
192             delayed => $spec->{delayed});
193                 } else {
194 0         0       $out .= "$args{indent} $name -> $class\n";
195                 }
196               }
197              
198 23         5045   return $out;
199             }
200              
201             sub _expire_caches {
202 58     58   963   %VALID_CACHE = %CONTAINED_CACHE = ();
203             }
204              
205             sub valid_params {
206 38     38 1 3695   my $class = shift;
207 38 100       429   if (@_) {
208 33         497     $class->_expire_caches;
209 33 100 66     459     $VALID_PARAMS{$class} = @_ == 1 && !defined($_[0]) ? {} : {@_};
210               }
211 38   100     467   return $VALID_PARAMS{$class} ||= {};
212             }
213              
214             sub contained_objects
215             {
216 24     24 1 487     my $class = shift;
217 24         314     $class->_expire_caches;
218 24         360     $CONTAINED_OBJECTS{$class} = {};
219 24         288     while (@_) {
220 24         230       my ($name, $spec) = (shift, shift);
221 24 100       355       $CONTAINED_OBJECTS{$class}{$name} = ref($spec) ? $spec : { class => $spec };
222                 }
223             }
224              
225             sub _decorator_AUTOLOAD {
226 9     9   128   my $self = shift;
227 2     2   136   no strict 'vars';
  2         23  
  2         48  
228 9         251   my ($method) = $AUTOLOAD =~ /([^:]+)$/;
229 9 100       102   return if $method eq 'DESTROY';
230 1 50       14   die qq{Can't locate object method "$method" via package $self} unless ref($self);
231 1 50       15   my $subr = $self->{_decorates}->can($method)
232                 or die qq{Can't locate object method "$method" via package } . ref($self);
233 1         12   unshift @_, $self->{_decorates};
234 1         14   goto $subr;
235             }
236              
237             sub _decorator_CAN {
238 11     11   2651   my ($self, $method) = @_;
239 11 100       319   return $self->SUPER::can($method) if $self->SUPER::can($method);
240 2 50       24   if (ref $self) {
241 2 100       28     return $self->{_decorates}->can($method) if $self->{_decorates};
242 1         14     return undef;
243               } else {
244 0         0     return $DECORATEES{$self}->can($method);
245               }
246             }
247              
248             sub decorates {
249 5     5 1 104   my ($class, $super) = @_;
250               
251 2     2   32   no strict 'refs';
  2         19  
  2         24  
252 5   33     49   $super ||= ${$class . '::ISA'}[0];
  5         55  
253               
254             # Pass through unknown method invocations
255 5         44   *{$class . '::AUTOLOAD'} = \&_decorator_AUTOLOAD;
  5         59  
256 5         46   *{$class . '::can'} = \&_decorator_CAN;
  5         55  
257               
258 5         46   $DECORATEES{$class} = $super;
259 5         67   $VALID_PARAMS{$class}{_decorates} = { isa => $super, optional => 1 };
260             }
261              
262             sub container {
263 1     1 1 30   my $self = shift;
264 1 50       11   die "The ", ref($self), "->container() method requires installation of Scalar::Util" unless $HAVE_WEAKEN;
265 1         16   return $self->{container}{container};
266             }
267              
268             sub call_method {
269 5     5 0 60   my ($self, $name, $method, @args) = @_;
270               
271 5 50       56   my $class = $self->contained_class($name)
272                 or die "Unknown contained item '$name'";
273              
274 5         57   $self->_load_module($class);
275 5         44   return $class->$method( %{ $self->{container}{contained}{$name}{args} }, @args );
  5         76  
276             }
277              
278             # Accepts a list of key-value pairs as parameters, representing all
279             # parameters taken by this object and its descendants. Returns a list
280             # of key-value pairs representing *only* this object's parameters.
281             sub create_contained_objects
282             {
283             # Typically $self doesn't exist yet, $_[0] is a string classname
284 54     54 0 509     my $class = shift;
285              
286 54         640     my $c = $class->get_contained_object_spec;
287 54 100 100     1034     return {@_, container => {}} unless %$c or $DECORATEES{$class};
288                 
289 35         712     my %args = @_;
290                 
291 35 100       510     if ($DECORATEES{$class}) {
292             # Fix format
293 8 100 66     106       $args{decorate_class} = [$args{decorate_class}]
294             if $args{decorate_class} and !ref($args{decorate_class});
295                   
296             # Figure out which class to decorate
297 8         67       my $decorate;
298 8 100       79       if (my $c = $args{decorate_class}) {
299 3 50       32 $decorate = @$c ? shift @$c : undef;
300 3 50       37 delete $args{decorate_class} unless @$c;
301                   }
302 8 100       132       $c->{_decorates} = { class => $decorate } if $decorate;
303                 }
304              
305             # This one is special, don't pass to descendants
306 35   100     502     my $container_stuff = delete($args{container}) || {};
307              
308 35         298     keys %$c; # Reset the iterator - why can't I do this in get_contained_object_spec??
309 35         410     my %contained_args;
310 35         281     my %to_create;
311                 
312 35         475     while (my ($name, $spec) = each %$c) {
313             # Figure out exactly which class to make an object of
314 47         677       my ($contained_class, $c_args) = $class->_get_contained_args($name, \%args);
315 47         546       @contained_args{ keys %$c_args } = (); # Populate with keys
316 47         831       $to_create{$name} = { class => $contained_class,
317             args => $c_args };
318                 }
319                 
320 35         441     while (my ($name, $spec) = each %$c) {
321             # This delete() needs to be outside the previous loop, because
322             # multiple contained objects might need to see it
323 46         664       delete $args{"${name}_class"};
324              
325 46 100       516       if ($spec->{delayed}) {
326 20         214 $container_stuff->{contained}{$name} = $to_create{$name};
327 20         253 $container_stuff->{contained}{$name}{delayed} = 1;
328                   } else {
329 26   100     300 $args{$name} ||= $to_create{$name}{class}->new(%{$to_create{$name}{args}});
  25         408  
330 25         573 $container_stuff->{contained}{$name}{class} = ref $args{$name};
331                   }
332                 }
333              
334             # Delete things that we're not going to use - things that are in
335             # our contained object specs but not in ours.
336 34         879     my $my_spec = $class->validation_spec;
337 34         386     delete @args{ grep {!exists $my_spec->{$_}} keys %contained_args };
  18         206  
338 34 100       354     delete $c->{_decorates} if $DECORATEES{$class};
339              
340 34         307     $args{container} = $container_stuff;
341 34         2413     return \%args;
342             }
343              
344             sub create_delayed_object
345             {
346 5     5 1 66   my ($self, $name) = (shift, shift);
347 5 50       62   croak "Unknown delayed item '$name'" unless $self->{container}{contained}{$name}{delayed};
348              
349 5 50       50   if ($HAVE_WEAKEN) {
350 5         63     push @_, container => {container => $self};
351 5         58     weaken $_[-1]->{container};
352               }
353 5         66   return $self->call_method($name, 'new', @_);
354             }
355              
356             sub delayed_object_class
357             {
358 4     4 1 1476     my $self = shift;
359 4         38     my $name = shift;
360 4 50       49     croak "Unknown delayed item '$name'"
361             unless $self->{container}{contained}{$name}{delayed};
362              
363 4         56     return $self->{container}{contained}{$name}{class};
364             }
365              
366             sub contained_class
367             {
368 9     9 0 661     my ($self, $name) = @_;
369 9 50       185     croak "Unknown contained item '$name'"
370             unless my $spec = $self->{container}{contained}{$name};
371 9         125     return $spec->{class};
372             }
373              
374             sub delayed_object_params
375             {
376 0     0 1 0     my ($self, $name) = (shift, shift);
377 0 0       0     croak "Unknown delayed object '$name'"
378             unless $self->{container}{contained}{$name}{delayed};
379              
380 0 0       0     if (@_ == 1) {
381 0         0 return $self->{container}{contained}{$name}{args}{$_[0]};
382                 }
383              
384 0         0     my %args = @_;
385              
386 0 0       0     if (keys %args)
387                 {
388 0         0 @{ $self->{container}{contained}{$name}{args} }{ keys %args } = values %args;
  0         0  
389                 }
390              
391 0         0     return %{ $self->{container}{contained}{$name}{args} };
  0         0  
392             }
393              
394             # Everything the specified contained object will accept, including
395             # parameters it will pass on to its own contained objects.
396             sub _get_contained_args
397             {
398 47     47   444     my ($class, $name, $args) = @_;
399                 
400 47 50       516     my $spec = $class->get_contained_object_spec->{$name}
401                   or croak "Unknown contained object '$name'";
402              
403 47   66     1117     my $contained_class = $args->{"${name}_class"} || $spec->{class};
404 47 50       856     croak "Invalid class name '$contained_class'"
405             unless $contained_class =~ /^[\w:]+$/;
406              
407 47         2944     $class->_load_module($contained_class);
408 47 100       850     return ($contained_class, {}) unless $contained_class->isa(__PACKAGE__);
409              
410 46         704     my $allowed = $contained_class->allowed_params($args);
411              
412 46         432     my %contained_args;
413 46         493     foreach (keys %$allowed) {
414 111 100       1393 $contained_args{$_} = $args->{$_} if exists $args->{$_};
415                 }
416 46         646     return ($contained_class, \%contained_args);
417             }
418              
419             sub _load_module {
420 95     95   2547     my ($self, $module) = @_;
421                 
422 95 50       853     unless ( eval { $module->can('new') } )
  95         1797  
423                 {
424 2     2   42 no strict 'refs';
  2         49  
  2         42  
425 0         0 eval "use $module";
426 0 0       0 croak $@ if $@;
427                 }
428             }
429              
430             sub allowed_params
431             {
432 75     75 1 1167     my $class = shift;
433 75 100       780     my $args = ref($_[0]) ? shift : {@_};
434                 
435             # Strategy: the allowed_params of this class consists of the
436             # validation_spec of this class, merged with the allowed_params of
437             # all contained classes. The specific contained classes may be
438             # affected by arguments passed in, like 'interp' or
439             # 'interp_class'. A parameter like 'interp' doesn't add anything
440             # to our allowed_params (because it's already created) but
441             # 'interp_class' does.
442              
443 75         894     my $c = $class->get_contained_object_spec;
444 75         643     my %p = %{ $class->validation_spec };
  75         818  
445                 
446 75         7843     foreach my $name (keys %$c)
447                 {
448             # Can accept a 'foo' parameter - should already be in the validation_spec.
449             # Also, its creation parameters should already have been extracted from $args,
450             # so don't extract any parameters.
451 25 50       350 next if exists $args->{$name};
452            
453             # Figure out what class to use for this contained item
454 25         198 my $contained_class;
455 25 100       258 if ( exists $args->{"${name}_class"} ) {
456 7         76 $contained_class = $args->{"${name}_class"};
457 7         92 $p{"${name}_class"} = { type => SCALAR }; # Add to spec
458             } else {
459 18         175 $contained_class = $c->{$name}{class};
460             }
461            
462             # We have to make sure it is loaded before we try calling allowed_params()
463 25         307 $class->_load_module($contained_class);
464 25 50       486 next unless $contained_class->can('allowed_params');
465            
466 25         327 my $subparams = $contained_class->allowed_params($args);
467            
468 25         312 foreach (keys %$subparams) {
469 42   66     622 $p{$_} ||= $subparams->{$_};
470             }
471                 }
472              
473 75         903     return \%p;
474             }
475              
476             sub _iterate_ISA {
477 528     528   5548   my ($class, $look_in, $cache_in, $add) = @_;
478              
479 528 100       7245   return $cache_in->{$class} if $cache_in->{$class};
480              
481 100         1013   my %out;
482               
483 2     2   41   no strict 'refs';
  2         22  
  2         37  
484 100         822   foreach my $superclass (@{ "${class}::ISA" }) {
  100         1109  
485 79 100       1493     next unless $superclass->isa(__PACKAGE__);
486 77         773     my $superparams = $superclass->_iterate_ISA($look_in, $cache_in, $add);
487 77         1312     @out{keys %$superparams} = values %$superparams;
488               }
489 100 100       1118   if (my $x = $look_in->{$class}) {
490 52         704     @out{keys %$x} = values %$x;
491               }
492               
493 100 100       1713   @out{keys %$add} = values %$add if $add;
494               
495 100         1327   return $cache_in->{$class} = \%out;
496             }
497              
498             sub get_contained_object_spec {
499 258   66 258 0 3794   return (ref($_[0]) || $_[0])->_iterate_ISA(\%CONTAINED_OBJECTS, \%CONTAINED_CACHE);
500             }
501              
502             sub validation_spec {
503 193   33 193 1 4088   return (ref($_[0]) || $_[0])->_iterate_ISA(\%VALID_PARAMS, \%VALID_CACHE, { container => {type => HASHREF} });
504             }
505              
506             1;
507              
508             __END__
509            
510             =head1 NAME
511            
512             Class::Container - Glues object frameworks together transparently
513            
514             =head1 SYNOPSIS
515            
516             package Car;
517             use Class::Container;
518             @ISA = qw(Class::Container);
519            
520             __PACKAGE__->valid_params
521             (
522             paint => {default => 'burgundy'},
523             style => {default => 'coupe'},
524             windshield => {isa => 'Glass'},
525             radio => {isa => 'Audio::Device'},
526             );
527            
528             __PACKAGE__->contained_objects
529             (
530             windshield => 'Glass::Shatterproof',
531             wheel => { class => 'Vehicle::Wheel',
532             delayed => 1 },
533             radio => 'Audio::MP3',
534             );
535            
536             sub new {
537             my $package = shift;
538            
539             # 'windshield' and 'radio' objects are created automatically by
540             # SUPER::new()
541             my $self = $package->SUPER::new(@_);
542            
543             $self->{right_wheel} = $self->create_delayed_object('wheel');
544             ... do any more initialization here ...
545             return $self;
546             }
547            
548             =head1 DESCRIPTION
549            
550             This class facilitates building frameworks of several classes that
551             inter-operate. It was first designed and built for C<HTML::Mason>, in
552             which the Compiler, Lexer, Interpreter, Resolver, Component, Buffer,
553             and several other objects must create each other transparently,
554             passing the appropriate parameters to the right class, possibly
555             substituting other subclasses for any of these objects.
556            
557             The main features of C<Class::Container> are:
558            
559             =over 4
560            
561             =item *
562            
563             Explicit declaration of containment relationships (aggregation,
564             factory creation, etc.)
565            
566             =item *
567            
568             Declaration of constructor parameters accepted by each member in a
569             class framework
570            
571             =item *
572            
573             Transparent passing of constructor parameters to the class
574             that needs them
575            
576             =item *
577            
578             Ability to create one (automatic) or many (manual) contained
579             objects automatically and transparently
580            
581             =back
582            
583             =head2 Scenario
584            
585             Suppose you've got a class called C<Parent>, which contains an object of
586             the class C<Child>, which in turn contains an object of the class
587             C<GrandChild>. Each class creates the object that it contains.
588             Each class also accepts a set of named parameters in its
589             C<new()> method. Without using C<Class::Container>, C<Parent> will
590             have to know all the parameters that C<Child> takes, and C<Child> will
591             have to know all the parameters that C<GrandChild> takes. And some of
592             the parameters accepted by C<Parent> will really control aspects of
593             C<Child> or C<GrandChild>. Likewise, some of the parameters accepted
594             by C<Child> will really control aspects of C<GrandChild>. So, what
595             happens when you decide you want to use a C<GrandDaughter> class
596             instead of the generic C<GrandChild>? C<Parent> and C<Child> must be
597             modified accordingly, so that any additional parameters taken by
598             C<GrandDaughter> can be accommodated. This is a pain - the kind of
599             pain that object-oriented programming was supposed to shield us from.
600            
601             Now, how can C<Class::Container> help? Using C<Class::Container>,
602             each class (C<Parent>, C<Child>, and C<GrandChild>) will declare what
603             arguments they take, and declare their relationships to the other
604             classes (C<Parent> creates/contains a C<Child>, and C<Child>
605             creates/contains a C<GrandChild>). Then, when you create a C<Parent>
606             object, you can pass C<< Parent->new() >> all the parameters for all
607             three classes, and they will trickle down to the right places.
608             Furthermore, C<Parent> and C<Child> won't have to know anything about
609             the parameters of its contained objects. And finally, if you replace
610             C<GrandChild> with C<GrandDaughter>, no changes to C<Parent> or
611             C<Child> will likely be necessary.
612            
613             =head1 METHODS
614            
615             =head2 new()
616            
617             Any class that inherits from C<Class::Container> should also inherit
618             its C<new()> method. You can do this simply by omitting it in your
619             class, or by calling C<SUPER::new(@_)> as indicated in the SYNOPSIS.
620             The C<new()> method ensures that the proper parameters and objects are
621             passed to the proper constructor methods.
622            
623             At the moment, the only possible constructor method is C<new()>. If
624             you need to create other constructor methods, they should call
625             C<new()> internally.
626            
627             =head2 __PACKAGE__->contained_objects()
628            
629             This class method is used to register what other objects, if any, a given
630             class creates. It is called with a hash whose keys are the parameter
631             names that the contained class's constructor accepts, and whose values
632             are the default class to create an object of.
633            
634             For example, consider the C<HTML::Mason::Compiler> class, which uses
635             the following code:
636            
637             __PACKAGE__->contained_objects( lexer => 'HTML::Mason::Lexer' );
638            
639             This defines the relationship between the C<HTML::Mason::Compiler>
640             class and the class it creates to go in its C<lexer> slot. The
641             C<HTML::Mason::Compiler> class "has a" C<lexer>. The C<<
642             HTML::Mason::Compiler->new() >> method will accept a C<lexer>
643             parameter and, if no such parameter is given, an object of the
644             C<HTML::Mason::Lexer> class should be constructed.
645            
646             We implement a bit of magic here, so that if C<<
647             HTML::Mason::Compiler->new() >> is called with a C<lexer_class>
648             parameter, it will load the indicated class (presumably a subclass of
649             C<HTML::Mason::Lexer>), instantiate a new object of that class, and
650             use it for the Compiler's C<lexer> object. We're also smart enough to
651             notice if parameters given to C<< HTML::Mason::Compiler->new() >>
652             actually should go to the C<lexer> contained object, and it will make
653             sure that they get passed along.
654            
655             Furthermore, an object may be declared as "delayed", which means that
656             an object I<won't> be created when its containing class is constructed.
657             Instead, these objects will be created "on demand", potentially more
658             than once. The constructors will still enjoy the automatic passing of
659             parameters to the correct class. See the C<create_delayed_object()>
660             for more.
661            
662             To declare an object as "delayed", call this method like this:
663            
664             __PACKAGE__->contained_objects( train => { class => 'Big::Train',
665             delayed => 1 } );
666            
667             =head2 __PACKAGE__->valid_params(...)
668            
669             Specifies the parameters accepted by this class's C<new()> method as a
670             set of key/value pairs. Any parameters accepted by a
671             superclass/subclass will also be accepted, as well as any parameters
672             accepted by contained objects. This method is a get/set accessor
673             method, so it returns a reference to a hash of these key/value pairs.
674             As a special case, if you wish to set the valid params to an empty set
675             and you previously set it to a non-empty set, you may call
676             C<< __PACKAGE__->valid_params(undef) >>.
677            
678             C<valid_params()> is called with a hash that contains parameter names
679             as its keys and validation specifications as values. This validation
680             specification is largely the same as that used by the
681             C<Params::Validate> module, because we use C<Params::Validate>
682             internally.
683            
684             As an example, consider the following situation:
685            
686             use Class::Container;
687             use Params::Validate qw(:types);
688             __PACKAGE__->valid_params
689             (
690             allow_globals => { type => ARRAYREF, parse => 'list', default => [] },
691             default_escape_flags => { type => SCALAR, parse => 'string', default => '' },
692             lexer => { isa => 'HTML::Mason::Lexer' },
693             preprocess => { type => CODEREF, parse => 'code', optional => 1 },
694             postprocess_perl => { type => CODEREF, parse => 'code', optional => 1 },
695             postprocess_text => { type => CODEREF, parse => 'code', optional => 1 },
696             );
697            
698             __PACKAGE__->contained_objects( lexer => 'HTML::Mason::Lexer' );
699            
700             The C<type>, C<default>, and C<optional> parameters are part of the
701             validation specification used by C<Params::Validate>. The various
702             constants used, C<ARRAYREF>, C<SCALAR>, etc. are all exported by
703             C<Params::Validate>. This means that any of these six parameter
704             names, plus the C<lexer_class> parameter (because of the
705             C<contained_objects()> specification given earlier), are valid
706             arguments to the Compiler's C<new()> method.
707            
708             Note that there are also some C<parse> attributes declared. These
709             have nothing to do with C<Class::Container> or C<Params::Validate> -
710             any extra entries like this are simply ignored, so you are free to put
711             extra information in the specifications as long as it doesn't overlap
712             with what C<Class::Container> or C<Params::Validate> are looking for.
713            
714             =head2 $self->create_delayed_object()
715            
716             If a contained object was declared with C<< delayed => 1 >>, use this
717             method to create an instance of the object. Note that this is an
718             object method, not a class method:
719            
720             my $foo = $self->create_delayed_object('foo', ...); # YES!
721             my $foo = __PACKAGE__->create_delayed_object('foo', ...); # NO!
722            
723             The first argument should be a key passed to the
724             C<contained_objects()> method. Any additional arguments will be
725             passed to the C<new()> method of the object being created, overriding
726             any parameters previously passed to the container class constructor.
727             (Could I possibly be more alliterative? Veni, vedi, vici.)
728            
729             =head2 $self->delayed_object_params($name, [params])
730            
731             Allows you to adjust the parameters that will be used to create any
732             delayed objects in the future. The first argument specifies the
733             "name" of the object, and any additional arguments are key-value pairs
734             that will become parameters to the delayed object.
735            
736             When called with only a C<$name> argument and no list of parameters to
737             set, returns a hash reference containing the parameters that will be
738             passed when creating objects of this type.
739            
740             =head2 $self->delayed_object_class($name)
741            
742             Returns the class that will be used when creating delayed objects of
743             the given name. Use this sparingly - in most situations you shouldn't
744             care what the class is.
745            
746             =head2 __PACKAGE__->decorates()
747            
748             Version 0.09 of Class::Container added [as yet experimental] support
749             for so-called "decorator" relationships, using the term as defined in
750             I<Design Patterns> by Gamma, et al. (the Gang of Four book). To
751             declare a class as a decorator of another class, simply set C<@ISA> to
752             the class which will be decorated, and call the decorator class's
753             C<decorates()> method.
754            
755             Internally, this will ensure that objects are instantiated as
756             decorators. This means that you can mix & match extra add-on
757             functionality classes much more easily.
758            
759             In the current implementation, if only a single decoration is used on
760             an object, it will be instantiated as a simple subclass, thus avoiding
761             a layer of indirection.
762            
763             =head2 $self->validation_spec()
764            
765             Returns a hash reference suitable for passing to the
766             C<Params::Validate> C<validate> function. Does I<not> include any
767             arguments that can be passed to contained objects.
768            
769             =head2 $class->allowed_params(\%args)
770            
771             Returns a hash reference of every parameter this class will accept,
772             I<including> parameters it will pass on to its own contained objects.
773             The keys are the parameter names, and the values are their
774             corresponding specifications from their C<valid_params()> definitions.
775             If a parameter is used by both the current object and one of its
776             contained objects, the specification returned will be from the
777             container class, not the contained.
778            
779             Because the parameters accepted by C<new()> can vary based on the
780             parameters I<passed> to C<new()>, you can pass any parameters to the
781             C<allowed_params()> method too, ensuring that the hash you get back is
782             accurate.
783            
784             =head2 $self->container()
785            
786             Returns the object that created you. This is remembered by storing a
787             reference to that object, so we use the C<Scalar::Utils> C<weakref()>
788             function to avoid persistent circular references that would cause
789             memory leaks. If you don't have C<Scalar::Utils> installed, we don't
790             make these references in the first place, and calling C<container()>
791             will result in a fatal error.
792            
793             If you weren't created by another object via C<Class::Container>,
794             C<container()> returns C<undef>.
795            
796             In most cases you shouldn't care what object created you, so use this
797             method sparingly.
798            
799             =head2 $object->show_containers
800            
801             =head2 $package->show_containers
802            
803             This method returns a string meant to describe the containment
804             relationships among classes. You should not depend on the specific
805             formatting of the string, because I may change things in a future
806             release to make it prettier.
807            
808             For example, the HTML::Mason code returns the following when you do
809             C<< $interp->show_containers >>:
810            
811             HTML::Mason::Interp=HASH(0x238944)
812             resolver -> HTML::Mason::Resolver::File
813             compiler -> HTML::Mason::Compiler::ToObject
814             lexer -> HTML::Mason::Lexer
815             request -> HTML::Mason::Request (delayed)
816             buffer -> HTML::Mason::Buffer (delayed)
817            
818             Currently, containment is shown by indentation, so the Interp object
819             contains a resolver and a compiler, and a delayed request (or several
820             delayed requests). The compiler contains a lexer, and each request
821             contains a delayed buffer (or several delayed buffers).
822            
823             =head2 $object->dump_parameters
824            
825             Returns a hash reference containing a set of parameters that should be
826             sufficient to re-create the given object using its class's C<new()>
827             method. This is done by fetching the current value for each declared
828             parameter (i.e. looking in C<$object> for hash entries of the same
829             name), then recursing through all contained objects and doing the
830             same.
831            
832             A few words of caution here. First, the dumped parameters represent
833             the I<current> state of the object, not the state when it was
834             originally created.
835            
836             Second, a class's declared parameters may not correspond exactly to
837             its data members, so it might not be possible to recover the former
838             from the latter. If it's possible but requires some manual fudging,
839             you can override this method in your class, something like so:
840            
841             sub dump_parameters {
842             my $self = shift;
843             my $dump = $self->SUPER::dump_parameters();
844            
845             # Perform fudgery
846             $dump->{incoming} = $self->{_private};
847             delete $dump->{superfluous};
848             return $dump;
849             }
850            
851             =head1 SEE ALSO
852            
853             L<Params::Validate>
854            
855             =head1 AUTHOR
856            
857             Originally by Ken Williams <ken@mathforum.org> and Dave Rolsky
858             <autarch@urth.org> for the HTML::Mason project. Important feedback
859             contributed by Jonathan Swartz <swartz@pobox.com>. Extended by Ken
860             Williams for the AI::Categorizer project.
861            
862             Currently maintained by Ken Williams.
863            
864             =head1 COPYRIGHT
865            
866             This program is free software; you can redistribute it and/or modify
867             it under the same terms as Perl itself.
868            
869             =cut
870