[htmltmpl] RFC PATCH for Associating objects

[Scottsweep <sco...@ya...>]

Hello all,
   I want to propose the following PATCH to
HTML::Template. This would allow objects to be
associated without the need to define a param method
(all public methods can be TMPL_VARs). It adds two
options (see section 2 below) to maintain backwards
compatability with param use. As I understand
associate was originally added as a means for working
with a CGI object, but as things have grown the need
to just associate a plain old blessed object has
grown. I am of the opinion that requiring a param
method for objects is not always practical. There are
3 below sections to modify/replace in HTML::Template.
I've tested and it appears to work well, but please
don't trust me and take a look for yourself.
   
Additional possibilities:
    What would make this really powerful is adding an
'associate' method to the class, rather than just in
the constructor. This would allow examination of the
template before the object is associated. The
developer could then alter the object based on what is
visible in the template. Of course non-constructor
binding of associated objects can be achieved with:
push(@{$template->{options}->{associate}},
$my_object), but it'd be a hack, breaking OO, etc.

Thanks,
Scott Connelly
   

################################################################################
#111111111111111111111111111111111111111111111111111111111111111111111111111111#
#REPLACE LINES 1015 - 1020 (only LINE 1017 has
changed) WITH
  # make sure objects in associate area support
param()
  foreach my $object (@{$options->{associate}}) {
    if($object->can('param') &&
!$options->{associate_by_methods}) {
      croak("HTML::Template->new called with associate
option, containing object of type " . ref($object) . "
which lacks a param() method!");
  }

################################################################################
#222222222222222222222222222222222222222222222222222222222222222222222222222222#
#LINE 2604 - 2633
#####################
# support for two new options:
#         - associate_by_methods - this will force
HTML::Template to look at an
#                                  objects methods and
retrieve data from them
#                                  rather than via
param (i.e., associated
#                                  object does not
need to define param). This
#                                  should maintain
backwards compatibility with
#                                  existing param use.
#
#         - associate_by_methods_respect_privacy -
this is a prefix that will
#                                  be looked for when
examining object methods,
#                                  if found then those
methods will not be
#                                  useable in the
template. Setting to 1 will
#                                  cause the default
of '_' to be used. This
#                                  allows you to
actually keep private methods
#                                  private. I.e.,
$my_object->_some_private_method()
#                                  would not be
available as a TMPL_VAR, while
#                                 
$my_object->some_public_method() would.

  if (scalar(@{$options->{associate}})) {
   # prepare case-mapping hashes to do
case-insensitive matching
    # against associated objects.  This allows CGI.pm
to be
    # case-sensitive and still work with asssociate.
    my (%case_map, $lparam);
    foreach my $associated_object
(@{$options->{associate}}) {
      # what a hack!  This should really be optimized
out for case_sensitive.
      if ($associated_object->can('param') &&
!$options->{associate_by_methods}) { ###
         if ($options->{case_sensitive}) {
           map {
             $case_map{$associated_object}{$_} = $_
           } $associated_object->param();
         } else {
           map {
             $case_map{$associated_object}{lc($_)} =
$_
           } $associated_object->param();
         }
      } else { ### get the object's methods
         if ($options->{case_sensitive}) {
           map {
             $case_map{$associated_object}{$_} = $_
           }
$self->_get_object_methods($associated_object,$options->{associate_by_methods_respect_privacy});
         } else {
           map {
             $case_map{$associated_object}{lc($_)} =
$_
           }
$self->_get_object_methods($associated_object,$options->{associate_by_methods_respect_privacy});
         }
      }

    }

    foreach my $param (keys %{$self->{param_map}}) {
      unless (defined($self->param($param))) {
      OBJ: foreach my $associated_object (reverse
@{$options->{associate}}) {

          if ($associated_object->can('param') &&
!$options->{associate_by_methods}) {
            $self->param($param, scalar
$associated_object->param($case_map{$associated_object}{$param})),
last OBJ
               if
(exists($case_map{$associated_object}{$param}));
          } else {
             my $method =
$case_map{$associated_object}{$param};
             $self->param($param, scalar
$associated_object->$method), last OBJ
               if
(exists($case_map{$associated_object}{$param}));
          }

        }
      }
    }
  }


################################################################################
#333333333333333333333333333333333333333333333333333333333333333333333333333333#
# Add to module where appropriate
######################
#
#  _get_object_methods
#
# This accepts an object or package name and will
return a list of methods
#
#  $self->_get_object_methods('HTML::Template',1)
#      would return
['associateCGI','carp','clear_params','confess','croak','md5_hex','new','new_array_ref','new_file','new_filehandle','new_scalar_ref','output','param','query']
#
#  Params:
#     pkg - either an object or package/module name to
be examined
#     respect_private - This is a prefix to hide
private methods from the list.
#                       Defaults to '_' if set to 1.
TODO://let a regex be passed
#
# Based on function and symTable from
http://search.cpan.org/~mpocock/MRP-1.0/MRP/Introspection.pm
#
sub _get_object_methods {
  my $self = shift;
  my $pkg = shift;
  my $respect_private = shift; # won't return methods
beginning with an this value, '_' by default
  $respect_private = '_' if($respect_private == 1);
  $pkg = (ref $pkg || $pkg) . '::';

  my @methods;
  my ($name, $glob);

  no strict 'refs';
  while(($name, $glob) = each %{\%$pkg}) {
    defined (*$glob{CODE}) && do { push @methods,
$name unless($respect_private && $name =~
/^$respect_private/) };
  }

  return @methods;
}

__________________________________________________
Do You Yahoo!?
Tired of spam?  Yahoo! Mail has the best spam protection around 
http://mail.yahoo.com