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