Class-Container-0.12/0000755000076500007650000000000010175063042014005 5ustar kenken00000000000000Class-Container-0.12/Build.PL0000644000076500007650000000045010175063032015277 0ustar kenken00000000000000use Module::Build; my $b = Module::Build->new ( module_name => 'Class::Container', requires => { 'Params::Validate' => '0.23', 'Carp' => 0, }, recommends => { 'Scalar::Util' => 0 }, license => 'perl', create_readme => 1, sign => 1, ); $b->create_build_script; Class-Container-0.12/Changes0000644000076500007650000001652410175063032015307 0ustar kenken00000000000000Revision history for Perl extension Class::Framework. 0.12 Sun Jan 23 21:02:35 CST 2005 - Fixed a bug in the container() method, which was only returning valid results for delayed objects, not auto-created ones. [Spotted by Sebastian Willert] 0.11 Wed Mar 3 21:34:51 CST 2004 - Fixed a bug in the code that detects whether Scalar::Util is loadable. [Spotted by Michael Alan Dorman] 0.10 Thu Mar 6 16:06:47 CST 2003 - The dump_parameters() method will now output the default values (if any) of parameters that haven't been explicitly set. 0.09 Mon Feb 10 13:12:40 CST 2003 - Use Carp::croak() instead of die() in most places when throwing a fatal error. - Fixed a problem in dump_parameters() in which attributes from superclasses weren't getting dumped. - The valid_params() method now always returns a hashref, possibly empty (when initialization hasn't happened yet), instead of sometimes returning undef. - Added experimental support for "decorator" classes, via the decorates() method. - Fixed the credits in the AUTHOR section to better reflect reality. - Added a Module::Build-style Build.PL script for installation. 0.08 Thu Aug 29 17:11:20 EST 2002 - Added the dump_parameters() method, which returns a hash reference containing a set of parameters that should be sufficient to re-create the given object using its class's C method (under normal/simple circumstances). 0.07 Tue Jul 23 00:34:34 PDT 2002 - Fix a bug in passing contained objects rather than using the defaultly created one. [found by Ilya Martynov ] - Calling container() when Scalar::Util is not installed now triggers a fatal error instead of returning undef - Get rid off the %ALLOWED_CACHE memoization, since it wasn't working properly. It could be done, but not as easily, so maybe it's a future project. [consistent prodding by Dave Rolsky] - Replace guts of get_contained_object_spec() and validation_spec() with an _iterate_ISA() internal method. This fixes a bug in validation_spec() in which subclasses weren't overriding superclass validation_spec()s. - Make valid_params() a standard get/set accessor method. - Document that valid_params() should only be called as a class method, not object method. - Improve the output of the show_containers() method. - Calling contained_objects() twice on the same package wasn't properly clearing previous entries. 0.06 Wed Jul 17 17:06:10 EST 2002 - Memoize the get_contained_object_spec(), validation_spec(), and allowed_params() methods. This can give a big speed boost when methods are called repeatedly, for example when using factory methods. All memoization caches are cleared when valid_params() or contained_objects() is called. The only known pitfall in the caching is that a class that dynamically changes its @ISA will probably mess things up. Idea by Dave Rolsky. - Use 'scalar validate_with()' inside new(), which may be faster. Idea by Dave Rolsky. - short-circuit create_contained_objects() if there are no contained objects to create. Idea by Dave Rolsky. - return a reference from create_contained_objects() rather than a list of key/value pairs. This lets us pass it directly to validation routines. - Use the qr// format for regexes in the all_specs() method. - Improve the docs for allowed_params() - it's a class method (not an instance method), and it accepts a list of arguments that can affect the return value. - Don't copy as many hashes internally. Pass by reference. - Fixed some POD formatting problems. - Now requires Params::Validate version 0.23 0.05 Thu Jun 27 16:53:41 EST 2002 - Fixed a problem in create_contained_objects() in which a 'foo_class' parameter wouldn't get properly passsed to all the contained objects that needed to see it. - Added a documentation section "Scenario" explaining the main benefits of using the module. - Improved the output of show_containers(), notably the names of delayed classes - Merge $self->{container}{delayed} into $self->{container}{contained}, with a 'delayed' property. This allows simplification of the rest of the code in several places, notably the show_containers() routine. - Simplify show_containers() a little, and make it more accurate on contained objects' classes - Fixed a doc error in the first example - Added a bit in the first doc paragraph, saying that any of the Mason objects can be replaced by a subclass. - Added an internal comment about the strategy inside the allowed_params method. - Simplified the allowed_params method internally. - Got rid of special-casing to check for circular containment relationships. This seemed to have been added for HTML::Mason, but all Mason tests (as well as all Class::Container tests) still pass when I remove it. 0.04 Wed Jun 26 19:15:26 EST 2002 - Add the show_containers() method, which should be a godsend during debugging. - Convert contained_objects() string specs to hashes upon input, rather than checking them every time they're used later in the code. - Change " if (%args)" to " if (keys %args)", which is more officially correct (though both would work in this particular case). 0.03 Fri Jun 21 17:44:37 EST 2002 - Subclasses can now override contained_objects settings of their superclass (previously it was backwards). - Let call_method() accept arbitrary additional parameters, don't force them into a hash. - Added contained_class() method. - Use new contained_class() method inside call_method(). - delayed_object_class() shouldn't be settable, it'll mess up the parameters accepted. - The 'container' parameter shouldn't be shared among containers the way other parameters are. - Made create_delayed_object() a little more efficient by not shifting things off @_ - just pass @_ to the next new() method. - Don't check for $contained_class->can('allowed_params'), check for $contained_class->isa(__PACKAGE__). - Clarified a few error messages. - Clarified documentation and removed a couple of doc errors. 0.02 Wed Jun 19 10:52:48 AEST 2002 - Made Scalar::Util a little more optional - the container() method is just a no-op if it's not around. - Use Params::Validate 0.18 new validate_with() method to set a meaningful subroutine name in error messages - Added the delayed_object_class() method - Documented how delayed objects are declared and created [Dave Rolsky] - Added some tests for the above stuff - Various documentation spruce-ups 0.01_05 Fri May 10 15:29:46 AEST 2002 - If a container has two contained classes that both need to see a parameter of the same name, it will now be passed to both. Previously it was passed to one of them, randomly. - Added 2 tests for the above. - Added 4 tests to make sure class names can be properly overridden. - Got rid of _make_contained_object() method. - Changed the (undocumented) get_contained_objects() method to get_contained_object_spec(). - Added the container() method, to get a reference to the thingy that created you. Uses weak references if Scalar::Util is available. - Consolidated all Container metadata in $self->{container} (subject to change to {_container} or something). - Added call_method() method. 0.01 Wed Mar 20 19:33:40 2002 - original version, based on HTML::Mason::Container Class-Container-0.12/INSTALL0000644000076500007650000000064510175063032015042 0ustar kenken00000000000000 Installation instructions for Class::Container To install this module, follow the standard steps for installing most Perl modules: perl Makefile.PL make make test make install Or you may use the newer Module::Build-style installation script: perl Build.PL ./Build ./Build test ./Build install Or you may use the CPAN.pm module, which will automatically execute these steps for you. -Ken Class-Container-0.12/lib/0000755000076500007650000000000010175063032014552 5ustar kenken00000000000000Class-Container-0.12/lib/Class/0000755000076500007650000000000010175063032015617 5ustar kenken00000000000000Class-Container-0.12/lib/Class/Container.pm0000644000076500007650000007000410175063032020100 0ustar kenken00000000000000package Class::Container; $VERSION = '0.12'; $VERSION = eval $VERSION if $VERSION =~ /_/; my $HAVE_WEAKEN; BEGIN { eval { require Scalar::Util; Scalar::Util->import('weaken'); $HAVE_WEAKEN = 1; }; *weaken = sub {} unless defined &weaken; } use strict; use Carp; # The create_contained_objects() method lets one object # (e.g. Compiler) transparently create another (e.g. Lexer) by passing # creator parameters through to the created object. # # Any auto-created objects should be declared in a class's # %CONTAINED_OBJECTS hash. The keys of this hash are objects which # can be created and the values are the default classes to use. # For instance, the key 'lexer' indicates that a 'lexer' parameter # should be silently passed through, and a 'lexer_class' parameter # will trigger the creation of an object whose class is specified by # the value. If no value is present there, the value of 'lexer' in # the %CONTAINED_OBJECTS hash is used. If no value is present there, # no contained object is created. # # We return the list of parameters for the creator. If contained # objects were auto-created, their creation parameters aren't included # in the return value. This lets the creator be totally ignorant of # the creation parameters of any objects it creates. use Params::Validate qw(:all); Params::Validate::validation_options( on_fail => sub { die @_ } ); my %VALID_PARAMS = (); my %CONTAINED_OBJECTS = (); my %VALID_CACHE = (); my %CONTAINED_CACHE = (); my %DECORATEES = (); sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = bless scalar validate_with ( params => $class->create_contained_objects(@_), spec => $class->validation_spec, called => "$class->new()", ), $class; if ($HAVE_WEAKEN) { my $c = $self->get_contained_object_spec; foreach my $name (keys %$c) { next if $c->{$name}{delayed}; $self->{$name}{container}{container} = $self; weaken $self->{$name}{container}{container}; } } return $self; } sub all_specs { require B::Deparse; my %out; foreach my $class (sort keys %VALID_PARAMS) { my $params = $VALID_PARAMS{$class}; foreach my $name (sort keys %$params) { my $spec = $params->{$name}; my ($type, $default); if ($spec->{isa}) { my $obj_class; $type = 'object'; if (exists $CONTAINED_OBJECTS{$class}{$name}) { $default = "$CONTAINED_OBJECTS{$class}{$name}{class}->new"; } } else { ($type, $default) = ($spec->{parse}, $spec->{default}); } if (ref($default) eq 'CODE') { $default = 'sub ' . B::Deparse->new()->coderef2text($default); $default =~ s/\s+/ /g; } elsif (ref($default) eq 'ARRAY') { $default = '[' . join(', ', map "'$_'", @$default) . ']'; } elsif (ref($default) eq 'Regexp') { $type = 'regex'; $default =~ s,^\(\?(\w*)-\w*:(.*)\),/$2/$1,; $default = "qr$default"; } unless ($type) { # Guess from the validation spec $type = ($spec->{type} & ARRAYREF ? 'list' : $spec->{type} & SCALAR ? 'string' : $spec->{type} & CODEREF ? 'code' : $spec->{type} & HASHREF ? 'hash' : undef); # Oh well } my $descr = $spec->{descr} || '(No description available)'; $out{$class}{valid_params}{$name} = { type => $type, pv_type => $spec->{type}, default => $default, descr => $descr, required => defined $default || $spec->{optional} ? 0 : 1, public => exists $spec->{public} ? $spec->{public} : 1, }; } $out{$class}{contained_objects} = {}; next unless exists $CONTAINED_OBJECTS{$class}; my $contains = $CONTAINED_OBJECTS{$class}; foreach my $name (sort keys %$contains) { $out{$class}{contained_objects}{$name} = {map {$_, $contains->{$name}{$_}} qw(class delayed descr)}; } } return %out; } sub dump_parameters { my $self = shift; my $class = ref($self) || $self; my %params; foreach my $param (keys %{ $class->validation_spec }) { next if $param eq 'container'; my $spec = $class->validation_spec->{$param}; if (ref($self) and defined $self->{$param}) { $params{$param} = $self->{$param}; } else { $params{$param} = $spec->{default} if exists $spec->{default}; } } foreach my $name (keys %{ $class->get_contained_object_spec }) { next unless ref($self); my $contained = ($self->{container}{contained}{$name}{delayed} ? $self->delayed_object_class($name) : $params{$name}); my $subparams = UNIVERSAL::isa($contained, __PACKAGE__) ? $contained->dump_parameters : {}; my $more = $self->{container}{contained}{$name}{args} || {}; $subparams->{$_} = $more->{$_} foreach keys %$more; @params{ keys %$subparams } = values %$subparams; delete $params{$name}; } return \%params; } sub show_containers { my $self = shift; my $name = shift; my %args = (indent => '', @_); $name = defined($name) ? "$name -> " : ""; my $out = "$args{indent}$name$self"; $out .= " (delayed)" if $args{delayed}; $out .= "\n"; return $out unless $self->isa(__PACKAGE__); my $specs = ref($self) ? $self->{container}{contained} : $self->get_contained_object_spec; while (my ($name, $spec) = each %$specs) { my $class = $args{args}{"${name}_class"} || $spec->{class}; $self->_load_module($class); if ($class->isa(__PACKAGE__)) { $out .= $class->show_containers($name, indent => "$args{indent} ", args => $spec->{args}, delayed => $spec->{delayed}); } else { $out .= "$args{indent} $name -> $class\n"; } } return $out; } sub _expire_caches { %VALID_CACHE = %CONTAINED_CACHE = (); } sub valid_params { my $class = shift; if (@_) { $class->_expire_caches; $VALID_PARAMS{$class} = @_ == 1 && !defined($_[0]) ? {} : {@_}; } return $VALID_PARAMS{$class} ||= {}; } sub contained_objects { my $class = shift; $class->_expire_caches; $CONTAINED_OBJECTS{$class} = {}; while (@_) { my ($name, $spec) = (shift, shift); $CONTAINED_OBJECTS{$class}{$name} = ref($spec) ? $spec : { class => $spec }; } } sub _decorator_AUTOLOAD { my $self = shift; no strict 'vars'; my ($method) = $AUTOLOAD =~ /([^:]+)$/; return if $method eq 'DESTROY'; die qq{Can't locate object method "$method" via package $self} unless ref($self); my $subr = $self->{_decorates}->can($method) or die qq{Can't locate object method "$method" via package } . ref($self); unshift @_, $self->{_decorates}; goto $subr; } sub _decorator_CAN { my ($self, $method) = @_; return $self->SUPER::can($method) if $self->SUPER::can($method); if (ref $self) { return $self->{_decorates}->can($method) if $self->{_decorates}; return undef; } else { return $DECORATEES{$self}->can($method); } } sub decorates { my ($class, $super) = @_; no strict 'refs'; $super ||= ${$class . '::ISA'}[0]; # Pass through unknown method invocations *{$class . '::AUTOLOAD'} = \&_decorator_AUTOLOAD; *{$class . '::can'} = \&_decorator_CAN; $DECORATEES{$class} = $super; $VALID_PARAMS{$class}{_decorates} = { isa => $super, optional => 1 }; } sub container { my $self = shift; die "The ", ref($self), "->container() method requires installation of Scalar::Util" unless $HAVE_WEAKEN; return $self->{container}{container}; } sub call_method { my ($self, $name, $method, @args) = @_; my $class = $self->contained_class($name) or die "Unknown contained item '$name'"; $self->_load_module($class); return $class->$method( %{ $self->{container}{contained}{$name}{args} }, @args ); } # Accepts a list of key-value pairs as parameters, representing all # parameters taken by this object and its descendants. Returns a list # of key-value pairs representing *only* this object's parameters. sub create_contained_objects { # Typically $self doesn't exist yet, $_[0] is a string classname my $class = shift; my $c = $class->get_contained_object_spec; return {@_, container => {}} unless %$c or $DECORATEES{$class}; my %args = @_; if ($DECORATEES{$class}) { # Fix format $args{decorate_class} = [$args{decorate_class}] if $args{decorate_class} and !ref($args{decorate_class}); # Figure out which class to decorate my $decorate; if (my $c = $args{decorate_class}) { $decorate = @$c ? shift @$c : undef; delete $args{decorate_class} unless @$c; } $c->{_decorates} = { class => $decorate } if $decorate; } # This one is special, don't pass to descendants my $container_stuff = delete($args{container}) || {}; keys %$c; # Reset the iterator - why can't I do this in get_contained_object_spec?? my %contained_args; my %to_create; while (my ($name, $spec) = each %$c) { # Figure out exactly which class to make an object of my ($contained_class, $c_args) = $class->_get_contained_args($name, \%args); @contained_args{ keys %$c_args } = (); # Populate with keys $to_create{$name} = { class => $contained_class, args => $c_args }; } while (my ($name, $spec) = each %$c) { # This delete() needs to be outside the previous loop, because # multiple contained objects might need to see it delete $args{"${name}_class"}; if ($spec->{delayed}) { $container_stuff->{contained}{$name} = $to_create{$name}; $container_stuff->{contained}{$name}{delayed} = 1; } else { $args{$name} ||= $to_create{$name}{class}->new(%{$to_create{$name}{args}}); $container_stuff->{contained}{$name}{class} = ref $args{$name}; } } # Delete things that we're not going to use - things that are in # our contained object specs but not in ours. my $my_spec = $class->validation_spec; delete @args{ grep {!exists $my_spec->{$_}} keys %contained_args }; delete $c->{_decorates} if $DECORATEES{$class}; $args{container} = $container_stuff; return \%args; } sub create_delayed_object { my ($self, $name) = (shift, shift); croak "Unknown delayed item '$name'" unless $self->{container}{contained}{$name}{delayed}; if ($HAVE_WEAKEN) { push @_, container => {container => $self}; weaken $_[-1]->{container}; } return $self->call_method($name, 'new', @_); } sub delayed_object_class { my $self = shift; my $name = shift; croak "Unknown delayed item '$name'" unless $self->{container}{contained}{$name}{delayed}; return $self->{container}{contained}{$name}{class}; } sub contained_class { my ($self, $name) = @_; croak "Unknown contained item '$name'" unless my $spec = $self->{container}{contained}{$name}; return $spec->{class}; } sub delayed_object_params { my ($self, $name) = (shift, shift); croak "Unknown delayed object '$name'" unless $self->{container}{contained}{$name}{delayed}; if (@_ == 1) { return $self->{container}{contained}{$name}{args}{$_[0]}; } my %args = @_; if (keys %args) { @{ $self->{container}{contained}{$name}{args} }{ keys %args } = values %args; } return %{ $self->{container}{contained}{$name}{args} }; } # Everything the specified contained object will accept, including # parameters it will pass on to its own contained objects. sub _get_contained_args { my ($class, $name, $args) = @_; my $spec = $class->get_contained_object_spec->{$name} or croak "Unknown contained object '$name'"; my $contained_class = $args->{"${name}_class"} || $spec->{class}; croak "Invalid class name '$contained_class'" unless $contained_class =~ /^[\w:]+$/; $class->_load_module($contained_class); return ($contained_class, {}) unless $contained_class->isa(__PACKAGE__); my $allowed = $contained_class->allowed_params($args); my %contained_args; foreach (keys %$allowed) { $contained_args{$_} = $args->{$_} if exists $args->{$_}; } return ($contained_class, \%contained_args); } sub _load_module { my ($self, $module) = @_; unless ( eval { $module->can('new') } ) { no strict 'refs'; eval "use $module"; croak $@ if $@; } } sub allowed_params { my $class = shift; my $args = ref($_[0]) ? shift : {@_}; # Strategy: the allowed_params of this class consists of the # validation_spec of this class, merged with the allowed_params of # all contained classes. The specific contained classes may be # affected by arguments passed in, like 'interp' or # 'interp_class'. A parameter like 'interp' doesn't add anything # to our allowed_params (because it's already created) but # 'interp_class' does. my $c = $class->get_contained_object_spec; my %p = %{ $class->validation_spec }; foreach my $name (keys %$c) { # Can accept a 'foo' parameter - should already be in the validation_spec. # Also, its creation parameters should already have been extracted from $args, # so don't extract any parameters. next if exists $args->{$name}; # Figure out what class to use for this contained item my $contained_class; if ( exists $args->{"${name}_class"} ) { $contained_class = $args->{"${name}_class"}; $p{"${name}_class"} = { type => SCALAR }; # Add to spec } else { $contained_class = $c->{$name}{class}; } # We have to make sure it is loaded before we try calling allowed_params() $class->_load_module($contained_class); next unless $contained_class->can('allowed_params'); my $subparams = $contained_class->allowed_params($args); foreach (keys %$subparams) { $p{$_} ||= $subparams->{$_}; } } return \%p; } sub _iterate_ISA { my ($class, $look_in, $cache_in, $add) = @_; return $cache_in->{$class} if $cache_in->{$class}; my %out; no strict 'refs'; foreach my $superclass (@{ "${class}::ISA" }) { next unless $superclass->isa(__PACKAGE__); my $superparams = $superclass->_iterate_ISA($look_in, $cache_in, $add); @out{keys %$superparams} = values %$superparams; } if (my $x = $look_in->{$class}) { @out{keys %$x} = values %$x; } @out{keys %$add} = values %$add if $add; return $cache_in->{$class} = \%out; } sub get_contained_object_spec { return (ref($_[0]) || $_[0])->_iterate_ISA(\%CONTAINED_OBJECTS, \%CONTAINED_CACHE); } sub validation_spec { return (ref($_[0]) || $_[0])->_iterate_ISA(\%VALID_PARAMS, \%VALID_CACHE, { container => {type => HASHREF} }); } 1; __END__ =head1 NAME Class::Container - Glues object frameworks together transparently =head1 SYNOPSIS package Car; use Class::Container; @ISA = qw(Class::Container); __PACKAGE__->valid_params ( paint => {default => 'burgundy'}, style => {default => 'coupe'}, windshield => {isa => 'Glass'}, radio => {isa => 'Audio::Device'}, ); __PACKAGE__->contained_objects ( windshield => 'Glass::Shatterproof', wheel => { class => 'Vehicle::Wheel', delayed => 1 }, radio => 'Audio::MP3', ); sub new { my $package = shift; # 'windshield' and 'radio' objects are created automatically by # SUPER::new() my $self = $package->SUPER::new(@_); $self->{right_wheel} = $self->create_delayed_object('wheel'); ... do any more initialization here ... return $self; } =head1 DESCRIPTION This class facilitates building frameworks of several classes that inter-operate. It was first designed and built for C, in which the Compiler, Lexer, Interpreter, Resolver, Component, Buffer, and several other objects must create each other transparently, passing the appropriate parameters to the right class, possibly substituting other subclasses for any of these objects. The main features of C are: =over 4 =item * Explicit declaration of containment relationships (aggregation, factory creation, etc.) =item * Declaration of constructor parameters accepted by each member in a class framework =item * Transparent passing of constructor parameters to the class that needs them =item * Ability to create one (automatic) or many (manual) contained objects automatically and transparently =back =head2 Scenario Suppose you've got a class called C, which contains an object of the class C, which in turn contains an object of the class C. Each class creates the object that it contains. Each class also accepts a set of named parameters in its C method. Without using C, C will have to know all the parameters that C takes, and C will have to know all the parameters that C takes. And some of the parameters accepted by C will really control aspects of C or C. Likewise, some of the parameters accepted by C will really control aspects of C. So, what happens when you decide you want to use a C class instead of the generic C? C and C must be modified accordingly, so that any additional parameters taken by C can be accommodated. This is a pain - the kind of pain that object-oriented programming was supposed to shield us from. Now, how can C help? Using C, each class (C, C, and C) will declare what arguments they take, and declare their relationships to the other classes (C creates/contains a C, and C creates/contains a C). Then, when you create a C object, you can pass C<< Parent->new() >> all the parameters for all three classes, and they will trickle down to the right places. Furthermore, C and C won't have to know anything about the parameters of its contained objects. And finally, if you replace C with C, no changes to C or C will likely be necessary. =head1 METHODS =head2 new() Any class that inherits from C should also inherit its C method. You can do this simply by omitting it in your class, or by calling C as indicated in the SYNOPSIS. The C method ensures that the proper parameters and objects are passed to the proper constructor methods. At the moment, the only possible constructor method is C. If you need to create other constructor methods, they should call C internally. =head2 __PACKAGE__->contained_objects() This class method is used to register what other objects, if any, a given class creates. It is called with a hash whose keys are the parameter names that the contained class's constructor accepts, and whose values are the default class to create an object of. For example, consider the C class, which uses the following code: __PACKAGE__->contained_objects( lexer => 'HTML::Mason::Lexer' ); This defines the relationship between the C class and the class it creates to go in its C slot. The C class "has a" C. The C<< HTML::Mason::Compiler->new() >> method will accept a C parameter and, if no such parameter is given, an object of the C class should be constructed. We implement a bit of magic here, so that if C<< HTML::Mason::Compiler->new() >> is called with a C parameter, it will load the indicated class (presumably a subclass of C), instantiate a new object of that class, and use it for the Compiler's C object. We're also smart enough to notice if parameters given to C<< HTML::Mason::Compiler->new() >> actually should go to the C contained object, and it will make sure that they get passed along. Furthermore, an object may be declared as "delayed", which means that an object I be created when its containing class is constructed. Instead, these objects will be created "on demand", potentially more than once. The constructors will still enjoy the automatic passing of parameters to the correct class. See the C for more. To declare an object as "delayed", call this method like this: __PACKAGE__->contained_objects( train => { class => 'Big::Train', delayed => 1 } ); =head2 __PACKAGE__->valid_params(...) Specifies the parameters accepted by this class's C method as a set of key/value pairs. Any parameters accepted by a superclass/subclass will also be accepted, as well as any parameters accepted by contained objects. This method is a get/set accessor method, so it returns a reference to a hash of these key/value pairs. As a special case, if you wish to set the valid params to an empty set and you previously set it to a non-empty set, you may call C<< __PACKAGE__->valid_params(undef) >>. C is called with a hash that contains parameter names as its keys and validation specifications as values. This validation specification is largely the same as that used by the C module, because we use C internally. As an example, consider the following situation: use Class::Container; use Params::Validate qw(:types); __PACKAGE__->valid_params ( allow_globals => { type => ARRAYREF, parse => 'list', default => [] }, default_escape_flags => { type => SCALAR, parse => 'string', default => '' }, lexer => { isa => 'HTML::Mason::Lexer' }, preprocess => { type => CODEREF, parse => 'code', optional => 1 }, postprocess_perl => { type => CODEREF, parse => 'code', optional => 1 }, postprocess_text => { type => CODEREF, parse => 'code', optional => 1 }, ); __PACKAGE__->contained_objects( lexer => 'HTML::Mason::Lexer' ); The C, C, and C parameters are part of the validation specification used by C. The various constants used, C, C, etc. are all exported by C. This means that any of these six parameter names, plus the C parameter (because of the C specification given earlier), are valid arguments to the Compiler's C method. Note that there are also some C attributes declared. These have nothing to do with C or C - any extra entries like this are simply ignored, so you are free to put extra information in the specifications as long as it doesn't overlap with what C or C are looking for. =head2 $self->create_delayed_object() If a contained object was declared with C<< delayed => 1 >>, use this method to create an instance of the object. Note that this is an object method, not a class method: my $foo = $self->create_delayed_object('foo', ...); # YES! my $foo = __PACKAGE__->create_delayed_object('foo', ...); # NO! The first argument should be a key passed to the C method. Any additional arguments will be passed to the C method of the object being created, overriding any parameters previously passed to the container class constructor. (Could I possibly be more alliterative? Veni, vedi, vici.) =head2 $self->delayed_object_params($name, [params]) Allows you to adjust the parameters that will be used to create any delayed objects in the future. The first argument specifies the "name" of the object, and any additional arguments are key-value pairs that will become parameters to the delayed object. When called with only a C<$name> argument and no list of parameters to set, returns a hash reference containing the parameters that will be passed when creating objects of this type. =head2 $self->delayed_object_class($name) Returns the class that will be used when creating delayed objects of the given name. Use this sparingly - in most situations you shouldn't care what the class is. =head2 __PACKAGE__->decorates() Version 0.09 of Class::Container added [as yet experimental] support for so-called "decorator" relationships, using the term as defined in I by Gamma, et al. (the Gang of Four book). To declare a class as a decorator of another class, simply set C<@ISA> to the class which will be decorated, and call the decorator class's C method. Internally, this will ensure that objects are instantiated as decorators. This means that you can mix & match extra add-on functionality classes much more easily. In the current implementation, if only a single decoration is used on an object, it will be instantiated as a simple subclass, thus avoiding a layer of indirection. =head2 $self->validation_spec() Returns a hash reference suitable for passing to the C C function. Does I include any arguments that can be passed to contained objects. =head2 $class->allowed_params(\%args) Returns a hash reference of every parameter this class will accept, I parameters it will pass on to its own contained objects. The keys are the parameter names, and the values are their corresponding specifications from their C definitions. If a parameter is used by both the current object and one of its contained objects, the specification returned will be from the container class, not the contained. Because the parameters accepted by C can vary based on the parameters I to C, you can pass any parameters to the C method too, ensuring that the hash you get back is accurate. =head2 $self->container() Returns the object that created you. This is remembered by storing a reference to that object, so we use the C C function to avoid persistent circular references that would cause memory leaks. If you don't have C installed, we don't make these references in the first place, and calling C will result in a fatal error. If you weren't created by another object via C, C returns C. In most cases you shouldn't care what object created you, so use this method sparingly. =head2 $object->show_containers =head2 $package->show_containers This method returns a string meant to describe the containment relationships among classes. You should not depend on the specific formatting of the string, because I may change things in a future release to make it prettier. For example, the HTML::Mason code returns the following when you do C<< $interp->show_containers >>: HTML::Mason::Interp=HASH(0x238944) resolver -> HTML::Mason::Resolver::File compiler -> HTML::Mason::Compiler::ToObject lexer -> HTML::Mason::Lexer request -> HTML::Mason::Request (delayed) buffer -> HTML::Mason::Buffer (delayed) Currently, containment is shown by indentation, so the Interp object contains a resolver and a compiler, and a delayed request (or several delayed requests). The compiler contains a lexer, and each request contains a delayed buffer (or several delayed buffers). =head2 $object->dump_parameters Returns a hash reference containing a set of parameters that should be sufficient to re-create the given object using its class's C method. This is done by fetching the current value for each declared parameter (i.e. looking in C<$object> for hash entries of the same name), then recursing through all contained objects and doing the same. A few words of caution here. First, the dumped parameters represent the I state of the object, not the state when it was originally created. Second, a class's declared parameters may not correspond exactly to its data members, so it might not be possible to recover the former from the latter. If it's possible but requires some manual fudging, you can override this method in your class, something like so: sub dump_parameters { my $self = shift; my $dump = $self->SUPER::dump_parameters(); # Perform fudgery $dump->{incoming} = $self->{_private}; delete $dump->{superfluous}; return $dump; } =head1 SEE ALSO L =head1 AUTHOR Originally by Ken Williams and Dave Rolsky for the HTML::Mason project. Important feedback contributed by Jonathan Swartz . Extended by Ken Williams for the AI::Categorizer project. Currently maintained by Ken Williams. =head1 COPYRIGHT This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Class-Container-0.12/Makefile.PL0000644000076500007650000000200610175063032015754 0ustar kenken00000000000000 use ExtUtils::MakeMaker; unless (eval "use Scalar::Util; 1") { warn("You seem not to have the Scalar::Util module installed.\n" . "Its installation is recommended (but not required) for Class::Container - see the README.\n"); sleep 4; } my $module = 'Class::Container'; my ($file, $dir); ($file = "lib/$module.pm") =~ s{::}{/}g; ($dir = $module) =~ s/::/-/g; WriteMakefile ( 'NAME' => $module, 'VERSION_FROM' => $file, # finds $VERSION 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz", PREOP=>('rm -f README; '. "pod2text -80 < $file > README; ". "cp -f README $dir-\$(VERSION); " ), }, 'PREREQ_PM' => { Params::Validate => '0.23', }, 'PL_FILES' => {}, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => $file, # retrieve abstract from module AUTHOR => 'Ken Williams ') : () ), NO_META => 1, ); Class-Container-0.12/MANIFEST0000644000076500007650000000027610175063032015142 0ustar kenken00000000000000Build.PL Changes INSTALL lib/Class/Container.pm Makefile.PL MANIFEST This list of files META.yml README t/01-basic.t t/02-decorator.t t/classes.pl SIGNATURE Added here by Module::Build Class-Container-0.12/META.yml0000644000076500007650000000111610175063032015254 0ustar kenken00000000000000--- #YAML:1.0 name: Class-Container version: 0.12 author: - |- Originally by Ken Williams and Dave Rolsky for the HTML::Mason project. Important feedback contributed by Jonathan Swartz . Extended by Ken Williams for the AI::Categorizer project. abstract: Glues object frameworks together transparently license: perl requires: Carp: 0 Params::Validate: 0.23 recommends: Scalar::Util: 0 provides: Class::Container: file: lib/Class/Container.pm version: 0.12 generated_by: Module::Build version 0.26 Class-Container-0.12/README0000644000076500007650000003461010175063032014670 0ustar kenken00000000000000NAME Class::Container - Glues object frameworks together transparently SYNOPSIS package Car; use Class::Container; @ISA = qw(Class::Container); __PACKAGE__->valid_params ( paint => {default => 'burgundy'}, style => {default => 'coupe'}, windshield => {isa => 'Glass'}, radio => {isa => 'Audio::Device'}, ); __PACKAGE__->contained_objects ( windshield => 'Glass::Shatterproof', wheel => { class => 'Vehicle::Wheel', delayed => 1 }, radio => 'Audio::MP3', ); sub new { my $package = shift; # 'windshield' and 'radio' objects are created automatically by # SUPER::new() my $self = $package->SUPER::new(@_); $self->{right_wheel} = $self->create_delayed_object('wheel'); ... do any more initialization here ... return $self; } DESCRIPTION This class facilitates building frameworks of several classes that inter-operate. It was first designed and built for "HTML::Mason", in which the Compiler, Lexer, Interpreter, Resolver, Component, Buffer, and several other objects must create each other transparently, passing the appropriate parameters to the right class, possibly substituting other subclasses for any of these objects. The main features of "Class::Container" are: * Explicit declaration of containment relationships (aggregation, factory creation, etc.) * Declaration of constructor parameters accepted by each member in a class framework * Transparent passing of constructor parameters to the class that needs them * Ability to create one (automatic) or many (manual) contained objects automatically and transparently Scenario Suppose you've got a class called "Parent", which contains an object of the class "Child", which in turn contains an object of the class "GrandChild". Each class creates the object that it contains. Each class also accepts a set of named parameters in its "new()" method. Without using "Class::Container", "Parent" will have to know all the parameters that "Child" takes, and "Child" will have to know all the parameters that "GrandChild" takes. And some of the parameters accepted by "Parent" will really control aspects of "Child" or "GrandChild". Likewise, some of the parameters accepted by "Child" will really control aspects of "GrandChild". So, what happens when you decide you want to use a "GrandDaughter" class instead of the generic "GrandChild"? "Parent" and "Child" must be modified accordingly, so that any additional parameters taken by "GrandDaughter" can be accommodated. This is a pain - the kind of pain that object-oriented programming was supposed to shield us from. Now, how can "Class::Container" help? Using "Class::Container", each class ("Parent", "Child", and "GrandChild") will declare what arguments they take, and declare their relationships to the other classes ("Parent" creates/contains a "Child", and "Child" creates/contains a "GrandChild"). Then, when you create a "Parent" object, you can pass "Parent->new()" all the parameters for all three classes, and they will trickle down to the right places. Furthermore, "Parent" and "Child" won't have to know anything about the parameters of its contained objects. And finally, if you replace "GrandChild" with "GrandDaughter", no changes to "Parent" or "Child" will likely be necessary. METHODS new() Any class that inherits from "Class::Container" should also inherit its "new()" method. You can do this simply by omitting it in your class, or by calling "SUPER::new(@_)" as indicated in the SYNOPSIS. The "new()" method ensures that the proper parameters and objects are passed to the proper constructor methods. At the moment, the only possible constructor method is "new()". If you need to create other constructor methods, they should call "new()" internally. __PACKAGE__->contained_objects() This class method is used to register what other objects, if any, a given class creates. It is called with a hash whose keys are the parameter names that the contained class's constructor accepts, and whose values are the default class to create an object of. For example, consider the "HTML::Mason::Compiler" class, which uses the following code: __PACKAGE__->contained_objects( lexer => 'HTML::Mason::Lexer' ); This defines the relationship between the "HTML::Mason::Compiler" class and the class it creates to go in its "lexer" slot. The "HTML::Mason::Compiler" class "has a" "lexer". The "HTML::Mason::Compiler->new()" method will accept a "lexer" parameter and, if no such parameter is given, an object of the "HTML::Mason::Lexer" class should be constructed. We implement a bit of magic here, so that if "HTML::Mason::Compiler->new()" is called with a "lexer_class" parameter, it will load the indicated class (presumably a subclass of "HTML::Mason::Lexer"), instantiate a new object of that class, and use it for the Compiler's "lexer" object. We're also smart enough to notice if parameters given to "HTML::Mason::Compiler->new()" actually should go to the "lexer" contained object, and it will make sure that they get passed along. Furthermore, an object may be declared as "delayed", which means that an object *won't* be created when its containing class is constructed. Instead, these objects will be created "on demand", potentially more than once. The constructors will still enjoy the automatic passing of parameters to the correct class. See the "create_delayed_object()" for more. To declare an object as "delayed", call this method like this: __PACKAGE__->contained_objects( train => { class => 'Big::Train', delayed => 1 } ); __PACKAGE__->valid_params(...) Specifies the parameters accepted by this class's "new()" method as a set of key/value pairs. Any parameters accepted by a superclass/subclass will also be accepted, as well as any parameters accepted by contained objects. This method is a get/set accessor method, so it returns a reference to a hash of these key/value pairs. As a special case, if you wish to set the valid params to an empty set and you previously set it to a non-empty set, you may call "__PACKAGE__->valid_params(undef)". "valid_params()" is called with a hash that contains parameter names as its keys and validation specifications as values. This validation specification is largely the same as that used by the "Params::Validate" module, because we use "Params::Validate" internally. As an example, consider the following situation: use Class::Container; use Params::Validate qw(:types); __PACKAGE__->valid_params ( allow_globals => { type => ARRAYREF, parse => 'list', default => [] }, default_escape_flags => { type => SCALAR, parse => 'string', default => '' }, lexer => { isa => 'HTML::Mason::Lexer' }, preprocess => { type => CODEREF, parse => 'code', optional => 1 }, postprocess_perl => { type => CODEREF, parse => 'code', optional => 1 }, postprocess_text => { type => CODEREF, parse => 'code', optional => 1 }, ); __PACKAGE__->contained_objects( lexer => 'HTML::Mason::Lexer' ); The "type", "default", and "optional" parameters are part of the validation specification used by "Params::Validate". The various constants used, "ARRAYREF", "SCALAR", etc. are all exported by "Params::Validate". This means that any of these six parameter names, plus the "lexer_class" parameter (because of the "contained_objects()" specification given earlier), are valid arguments to the Compiler's "new()" method. Note that there are also some "parse" attributes declared. These have nothing to do with "Class::Container" or "Params::Validate" - any extra entries like this are simply ignored, so you are free to put extra information in the specifications as long as it doesn't overlap with what "Class::Container" or "Params::Validate" are looking for. $self->create_delayed_object() If a contained object was declared with "delayed => 1", use this method to create an instance of the object. Note that this is an object method, not a class method: my $foo = $self->create_delayed_object('foo', ...); # YES! my $foo = __PACKAGE__->create_delayed_object('foo', ...); # NO! The first argument should be a key passed to the "contained_objects()" method. Any additional arguments will be passed to the "new()" method of the object being created, overriding any parameters previously passed to the container class constructor. (Could I possibly be more alliterative? Veni, vedi, vici.) $self->delayed_object_params($name, [params]) Allows you to adjust the parameters that will be used to create any delayed objects in the future. The first argument specifies the "name" of the object, and any additional arguments are key-value pairs that will become parameters to the delayed object. When called with only a $name argument and no list of parameters to set, returns a hash reference containing the parameters that will be passed when creating objects of this type. $self->delayed_object_class($name) Returns the class that will be used when creating delayed objects of the given name. Use this sparingly - in most situations you shouldn't care what the class is. __PACKAGE__->decorates() Version 0.09 of Class::Container added [as yet experimental] support for so-called "decorator" relationships, using the term as defined in *Design Patterns* by Gamma, et al. (the Gang of Four book). To declare a class as a decorator of another class, simply set @ISA to the class which will be decorated, and call the decorator class's "decorates()" method. Internally, this will ensure that objects are instantiated as decorators. This means that you can mix & match extra add-on functionality classes much more easily. In the current implementation, if only a single decoration is used on an object, it will be instantiated as a simple subclass, thus avoiding a layer of indirection. $self->validation_spec() Returns a hash reference suitable for passing to the "Params::Validate" "validate" function. Does *not* include any arguments that can be passed to contained objects. $class->allowed_params(\%args) Returns a hash reference of every parameter this class will accept, *including* parameters it will pass on to its own contained objects. The keys are the parameter names, and the values are their corresponding specifications from their "valid_params()" definitions. If a parameter is used by both the current object and one of its contained objects, the specification returned will be from the container class, not the contained. Because the parameters accepted by "new()" can vary based on the parameters *passed* to "new()", you can pass any parameters to the "allowed_params()" method too, ensuring that the hash you get back is accurate. $self->container() Returns the object that created you. This is remembered by storing a reference to that object, so we use the "Scalar::Utils" "weakref()" function to avoid persistent circular references that would cause memory leaks. If you don't have "Scalar::Utils" installed, we don't make these references in the first place, and calling "container()" will result in a fatal error. If you weren't created by another object via "Class::Container", "container()" returns "undef". In most cases you shouldn't care what object created you, so use this method sparingly. $object->show_containers $package->show_containers This method returns a string meant to describe the containment relationships among classes. You should not depend on the specific formatting of the string, because I may change things in a future release to make it prettier. For example, the HTML::Mason code returns the following when you do "$interp->show_containers": HTML::Mason::Interp=HASH(0x238944) resolver -> HTML::Mason::Resolver::File compiler -> HTML::Mason::Compiler::ToObject lexer -> HTML::Mason::Lexer request -> HTML::Mason::Request (delayed) buffer -> HTML::Mason::Buffer (delayed) Currently, containment is shown by indentation, so the Interp object contains a resolver and a compiler, and a delayed request (or several delayed requests). The compiler contains a lexer, and each request contains a delayed buffer (or several delayed buffers). $object->dump_parameters Returns a hash reference containing a set of parameters that should be sufficient to re-create the given object using its class's "new()" method. This is done by fetching the current value for each declared parameter (i.e. looking in $object for hash entries of the same name), then recursing through all contained objects and doing the same. A few words of caution here. First, the dumped parameters represent the *current* state of the object, not the state when it was originally created. Second, a class's declared parameters may not correspond exactly to its data members, so it might not be possible to recover the former from the latter. If it's possible but requires some manual fudging, you can override this method in your class, something like so: sub dump_parameters { my $self = shift; my $dump = $self->SUPER::dump_parameters(); # Perform fudgery $dump->{incoming} = $self->{_private}; delete $dump->{superfluous}; return $dump; } SEE ALSO Params::Validate AUTHOR Originally by Ken Williams and Dave Rolsky for the HTML::Mason project. Important feedback contributed by Jonathan Swartz . Extended by Ken Williams for the AI::Categorizer project. Currently maintained by Ken Williams. COPYRIGHT This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Class-Container-0.12/SIGNATURE0000644000076500007650000000251310175063042015272 0ustar kenken00000000000000This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.38. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It would check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 3b225b4d443775932c127fe00d5dddca58820aa6 Build.PL SHA1 8cd28fa1763a93ffc196226642df8c584a2adc70 Changes SHA1 1b386906514c738a00fcd4b1b7ba74ac1925c227 INSTALL SHA1 6e250a09fdb471a3dcd7b9f267d4585dc2e5de18 MANIFEST SHA1 976fabe5ba08d4f96ec5d764a30e3f37d46f4019 META.yml SHA1 48dcc0a806041eaf9d020b5305d0c4bb32898f51 Makefile.PL SHA1 336c070360a737f094645d80d4c82d5fd02ae973 README SHA1 4286abb1ee51dcfa9868ccb754ec63b4ff684ad2 lib/Class/Container.pm SHA1 39edf6c1802d4be568c18968ea5389965a0a6ff1 t/01-basic.t SHA1 8154cdf85123d748ae210fa86a58e5484cb79275 t/02-decorator.t SHA1 56e282a6a8379f3a3a42d5f78cd1682ab1cfc68b t/classes.pl -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.2.2 (Darwin) iD8DBQFB9GYigrvMBLfvlHYRAry6AJ0R722RV5sESZlMjvcID/M6ms/7HwCdGHfI DhsUAU9sOA7srQVl1uZMJ90= =oCuW -----END PGP SIGNATURE----- Class-Container-0.12/t/0000755000076500007650000000000010175063032014247 5ustar kenken00000000000000Class-Container-0.12/t/01-basic.t0000644000076500007650000002110210175063032015727 0ustar kenken00000000000000#!/usr/bin/perl -w # Note - I create a bunch of classes in these tests and then change # their valid_params() and contained_objects() lists several times. # This isn't really supported behavior of this module, but it's # necessary to do it in the tests. use strict; use Test; use Class::Container; use Params::Validate qw(:types); use File::Spec; require File::Spec->catfile('t', 'classes.pl'); my $HAVE_WEAKEN = 0 + exists $INC{'Scalar/Util.pm'}; plan tests => 67 + 1*$HAVE_WEAKEN; use Carp; $SIG{__DIE__} = \&Carp::confess; eval {new Daughter(hair => 'long')}; ok $@, '', "Try making an object"; eval {new Parent()}; ok $@, '/mood/', "Should fail, missing required parameter"; my %args = (parent_val => 7, mood => 'bubbly'); eval {new Parent(%args)}; ok $@, '', "Try creating top-level object"; my $mood = eval {Parent->new(%args)->{son}->{mood}}; ok $mood, 'bubbly'; ok $@, '', "Make sure sub-objects are created with proper values"; if ($HAVE_WEAKEN) { my $p = Parent->new(%args); ok $p->{son}->container, $p, "Container of son should be parent"; } eval {my $p = new Parent(%args); $p->create_delayed_object('daughter')}; ok $@, '', "Create a delayed object"; my $d = eval {Parent->new(%args)->create_delayed_object('daughter', hair => 'short')}; ok $@, '', "Create a delayed object with parameters"; ok $d->{hair}, 'short', "Make sure parameters are propogated to delayed object"; eval {new Daughter(foo => 'invalid')}; ok $@, '/Daughter/', "Make sure error messages contain the name of the class"; # Make sure we can override class names { ok my $p = eval {new Parent(mood => 'foo', parent_val => 1, daughter_class => 'StepDaughter', toy_class => 'Ball', other_toys_class => 'Streamer', son_class => 'StepSon')}; warn $@ if $@; my $d = eval {$p->create_delayed_object('daughter')}; ok $@, ''; ok ref($d), 'StepDaughter'; ok ref($p->{son}), 'StepSon'; # Note - if one of these fails and the other succeeds, then we're # not properly passing 'toy_class' to both son & daughter classes. ok ref($d->{toy}), 'Ball'; ok ref($p->{son}{toy}), 'Ball'; ok $d->delayed_object_class('other_toys'), 'Streamer'; ok $p->{son}->delayed_object_class('other_toys'), 'Streamer'; # Special 'container' parameter shouldn't be shared among objects ok ($p->{container} ne $p->{son}{container}); # Check some of the formatting of show_containers() my $string = $p->show_containers; ok $string, '/\n son -> StepSon/', $string; } { # Check that subclass contained_objects override superclass local @Superclass::ISA = qw(Class::Container); local @Subclass::ISA = qw(Superclass); 'Superclass'->valid_params( foo => {isa => 'Foo'} ); 'Subclass'->valid_params( foo => {isa => 'Bar'} ); 'Superclass'->contained_objects( foo => 'Foo' ); 'Subclass'->contained_objects( foo => 'Bar' ); local @Bar::ISA = qw(Foo); sub Foo::new { bless {}, 'Foo' } sub Bar::new { bless {}, 'Bar' } my $child = 'Subclass'->new; ok ref($child->{foo}), 'Bar', 'Subclass contained_object should override superclass'; my $spec = 'Subclass'->validation_spec; ok $spec->{foo}{isa}, 'Bar'; } { local @Top::ISA = qw(Class::Container); 'Top'->valid_params( document => {isa => 'Document'} ); 'Top'->contained_objects( document => 'Document', collection => {class => 'Collection', delayed => 1} ); local @Collection::ISA = qw(Class::Container); 'Collection'->contained_objects( document => {class => 'Document', delayed => 1} ); local @Document::ISA = qw(Class::Container); local @Document2::ISA = qw(Document); my $k = new Top; print $k->show_containers; ok $k->contained_class('document'), 'Document'; my $collection = $k->create_delayed_object('collection'); ok ref($collection), 'Collection'; ok $collection->contained_class('document'), 'Document'; my $string = $k->show_containers; ok $string, '/ collection -> Collection \(delayed\)/'; ok $string, '/ document -> Document \(delayed\)/'; my $k2 = new Top(document_class => 'Document2'); print $k2->show_containers; ok $k2->contained_class('document'), 'Document2'; my $collection2 = $k2->create_delayed_object('collection'); ok ref($collection2), 'Collection'; ok $collection2->contained_class('document'), 'Document2'; my $string2 = $k2->show_containers; ok $string2, '/ collection -> Collection \(delayed\)/'; ok $string2, '/ document -> Document2 \(delayed\)/'; } { local @Top::ISA = qw(Class::Container); 'Top'->valid_params( document => {isa => 'Document1'} ); 'Top'->contained_objects( document => 'Document1' ); my $contained = 'Top'->get_contained_object_spec; ok $contained->{document}; ok !$contained->{collection}; # Shouldn't have anything left over from the last block local @Document1::ISA = qw(Class::Container); 'Document1'->valid_params( doc1 => {type => SCALAR} ); local @Document2::ISA = qw(Class::Container); 'Document2'->valid_params( doc2 => {type => SCALAR} ); my $allowed = 'Top'->allowed_params(); ok $allowed->{doc1}; ok !$allowed->{doc2}; $allowed = 'Top'->allowed_params( document_class => 'Document2' ); ok $allowed->{doc2}; ok !$allowed->{doc1}; } { local @Top::ISA = qw(Class::Container); 'Top'->_expire_caches; 'Top'->valid_params( document => {isa => 'Document1'} ); 'Top'->contained_objects( document => 'Document1' ); local @Document1::ISA = qw(Class::Container); 'Document1'->valid_params(); local @Document2::ISA = qw(Document1); 'Document2'->valid_params(); my $t = new Top( document => bless {}, 'Document2' ); ok $t; ok ref($t->{document}), 'Document2'; } { local @Top::ISA = qw(Class::Container); 'Top'->valid_params( document => {isa => 'Document'} ); 'Top'->contained_objects( document => 'Document' ); local @Document::ISA = qw(Class::Container); 'Document'->valid_params( sub => {isa => 'Class::Container'} ); 'Document'->contained_objects( sub => 'Sub1' ); local @Sub1::ISA = qw(Class::Container); 'Sub1'->valid_params( bar => {type => SCALAR} ); 'Sub1'->contained_objects(); local @Sub2::ISA = qw(Class::Container); 'Sub2'->valid_params( foo => {type => SCALAR} ); 'Sub2'->contained_objects(); my $allowed = 'Top'->allowed_params(); ok $allowed->{document}; ok $allowed->{bar}; ok !$allowed->{foo}; $allowed = 'Top'->allowed_params(sub_class => 'Sub2'); ok $allowed->{document}; ok !$allowed->{bar}; ok $allowed->{foo}; } { local @Top::ISA = qw(Class::Container); Top->valid_params(foo => {type => SCALAR}); Top->contained_objects(); ok 'Top'->valid_params; ok 'Top'->valid_params->{foo}{type}, SCALAR; } { local @Top::ISA = qw(Class::Container); Top->valid_params(foo => {type => SCALAR}, child => {isa => 'Child'}); Top->contained_objects(child => 'Child'); local @Child::ISA = qw(Class::Container); Child->valid_params(bar => {type => SCALAR}, grand_child => {isa => 'GrandChild'}); Child->contained_objects(grand_child => 'GrandChild'); local @GrandChild::ISA = qw(Class::Container); GrandChild->valid_params(baz => {type => SCALAR}, boo => {default => 5}); GrandChild->contained_objects(); local @GrandSibling::ISA = qw(GrandChild); my $dump = GrandSibling->new(baz => 'BAZ')->dump_parameters; ok keys(%$dump), 2; ok $dump->{baz}, 'BAZ', "Sibling has baz=BAZ"; ok $dump->{boo}, 5, "Sibling has boo=5"; $dump = Child->new(bar => 'BAR', baz => 'BAZ')->dump_parameters; ok keys(%$dump), 3; ok $dump->{bar}, 'BAR'; ok $dump->{baz}, 'BAZ'; $dump = Child->new(bar => 'BAR', baz => 'BAZ', grand_child_class => 'GrandChild')->dump_parameters; ok keys(%$dump), 3; ok $dump->{bar}, 'BAR'; ok $dump->{baz}, 'BAZ'; $dump = Top->new(foo => 'FOO', bar => 'BAR', baz => 'BAZ')->dump_parameters; ok keys(%$dump), 4; ok $dump->{foo}, 'FOO'; ok $dump->{bar}, 'BAR'; ok $dump->{baz}, 'BAZ'; # Test default values in a delayed object Top->valid_params(undef); Top->contained_objects(child => {class => 'Child', delayed => 1}); Child->valid_params(bar => {default => 4}); Child->contained_objects(); $dump = Top->new()->dump_parameters; ok keys(%$dump), 1; ok $dump->{bar}, 4; $dump = Top->new(bar => 6)->dump_parameters; ok keys(%$dump), 1; ok $dump->{bar}, 6; } { # Make sure a later call to valid_params() clears the param list local @Top::ISA = qw(Class::Container); Top->valid_params(undef); Top->contained_objects(); ok eval{ new Top }; } { # Make sure valid_params() gives sensible null output local @Nonexistent::ISA = qw(Class::Container); my $params = Nonexistent->valid_params; ok ref($params), 'HASH'; ok keys(%$params), 0; } Class-Container-0.12/t/02-decorator.t0000644000076500007650000000363410175063032016643 0ustar kenken00000000000000use strict; use Test; BEGIN { plan tests => 24 } use Class::Container; use Params::Validate qw(:types); use File::Spec; require File::Spec->catfile('t', 'classes.pl'); # Decorator stuff { local @Top::ISA = qw(Class::Container); Top->valid_params(undef); Top->contained_objects(); sub Top::foo { "foo" } local @Decorator::ISA = qw(Top); Decorator->decorates; sub Decorator::bar { "bar" } local @OtherDec::ISA = qw(Top); OtherDec->decorates; sub OtherDec::baz { "baz" } # Make sure a simple 1-level decorator works { my $d = new Decorator; ok $d; ok $d->foo, 'foo'; ok $d->bar, 'bar'; # Should be using simple subclassing since it's just 1 level (no interface for this) ok !$d->{_decorates}; # Make sure can() is correct # Test.pm will run subrefs (don't want that), so make them booleans ok !!$d->can('foo'); ok !!$d->can('bar'); ok !$d->can('baz'); } # Try a 2-level decorator { my $d = new Decorator(decorate_class => 'OtherDec'); ok $d; ok !!$d->can('foo'); ok !!$d->can('bar'); ok !!$d->can('baz'); ok $d->foo, 'foo'; ok $d->bar, 'bar'; ok $d->baz, 'baz'; # Make sure it's using decoration containment at top level, and subclassing below. ok $d->{_decorates}; ok ref($d->{_decorates}), 'OtherDec'; ok !$d->{_decorates}{_decorates}; } # Make sure arguments are passed correctly Top->valid_params( one => { type => SCALAR } ); Decorator->valid_params( two => { type => SCALAR } ); Top->decorates; Decorator->decorates; OtherDec->decorates; my $d = Decorator->new( one => 1, two => 2 ); ok $d; $d = OtherDec->new( decorate_class => 'Decorator', one => 1, two => 2 ); ok $d; ok $d->{one}, 1; ok $d->{_decorates}{two}, 2; $d = Decorator->new( decorate_class => 'OtherDec', one => 1, two => 2 ); ok $d; ok $d->{one}, 1; ok $d->{two}, 2; } Class-Container-0.12/t/classes.pl0000644000076500007650000000305010175063032016237 0ustar kenken00000000000000use strict; use Params::Validate qw(:types); my $SCALAR = SCALAR; # So we don't have to keep importing it below # Create some boilerplate classes { no strict 'refs'; foreach my $class (qw(Parent Boy Toy Daughter)) { push @{$class.'::ISA'}, 'Class::Container'; } } # Define the relationships { package Parent; push @Parent::ISA, 'Foo'; # Make sure it works with non-container superclasses # Has one son and several daughters __PACKAGE__->valid_params( parent_val => { type => $SCALAR }, son => {isa => 'Son'}, ); __PACKAGE__->contained_objects( son => 'Son', daughter => {delayed => 1, class => 'Daughter'}); } { package Boy; __PACKAGE__->valid_params( eyes => { default => 'brown', type => $SCALAR }, toy => {isa => 'Toy'}); __PACKAGE__->contained_objects( toy => 'Slingshot', other_toys => {class => 'Toy', delayed => 1}, ); } { package Son; push @Son::ISA, 'Boy'; __PACKAGE__->valid_params( mood => { type => $SCALAR } ); } { package Slingshot; push @Slingshot::ISA, 'Toy'; __PACKAGE__->valid_params( weapon => { default => 'rock', type => $SCALAR } ); } { package Daughter; __PACKAGE__->valid_params( hair => { default => 'short' } ); } { package StepDaughter; push @StepDaughter::ISA, 'Daughter'; __PACKAGE__->valid_params( toy => {isa => 'Toy'} ); __PACKAGE__->contained_objects( toy => { class => 'Toy'}, other_toys => {class => 'Toy', delayed => 1}, ); } { push @StepSon::ISA, 'Son'; push @Ball::ISA, 'Toy'; push @Streamer::ISA, 'Toy'; } 1;