[Maine-pm] calling callbacks as object methods via hash lookup

[maine-pm at mail.pm.org]

Joe,

Thanks for the suggestions. I appreciate your review of the code and 
have enclosed some responses which may be of interest, depending on 
your workload and how easily amused you are by my awkward OO Perl code. 
At the very least, it has helped me to attempt to explain it.

My overall objective was to write a logging module that would take a 
simple call like $my_log->log($var) and then dispatch a series of 
customizable callbacks from MyClass::log(). For example, _before() 
could output a heading, _each() could deal with the arguments 
themselves and _after() could follow up with a newline.

I used the hash as a convenience for registering the callbacks, though 
in the production version they are only accessible through get/set 
methods as you suggested, or in the constructor. So, for example, if 
you said my $log = Log->new('before' => \&my_before_sub), it would 
override the default. Inheritance is handled by calling a _prototype() 
method inside the constructor which fetches the default callbacks from 
whatever package the object was blessed into. (This is adapted from 
Conway's book).

sub new {
	my ($invocant, %args) = @_;
	my $obj = ref($invocant); # is invocant an object?
	my $class = $obj || $invocant;
	my $self = bless {}, $class;
	for my $prop ($self->_prototype()) {
		my ($arg) = ($prop =~ /^_(.*)/);
		if (exists $args{$arg}) {
			$self->{$prop} = $args{$arg};
		}
		elsif ($obj) {
			$self->{$prop} = $obj->{$prop};
		}
		else {
			$self->{$prop} = $self->_prototype($prop);
		}
	}
	return $self;
}

sub _prototype {
	my $self = shift;
	my %defaults = (
		'_before_all' => \&_before_all,
		'_before_each' => \&_before_each,
		'_each' => \&_each,
		'_after_each' => \&_after_each,
		'_after_all' => \&_after_all,
		'_log_tag' => \&_log_tag,
		'_scalar' => \&_scalar,
		'_array' => \&_array,
		'_hash' => \&_hash,
		'_code' => \&_code,
		'_glob' => \&_glob,
		'_ref' => \&_ref,
		'_lvalue' => \&_lvalue,
		'_io::handle' => \&_io_handle,
		'_object' => \&_object,
		'_default' => \&_default,
		'_new_line' => "\n",
		'_indent' => "\t",
		'_line_char' => "^",
		'_rule_length' => 80,
		'_verbosity' => 3
	);
	return keys %defaults if wantarray;
	my $prop = shift;
	if (exists($defaults{$prop})) {
		return $defaults{$prop};
	}
}

The convenience factor I was looking for would come into play as all 
these callbacks were calling each other at the upper reaches of the 
call stack. Here's an example. If an arrayref is passed in to the log 
method, it is recursively printed by calling '_each()' on each value.

sub _array {
	my ($self, $ref, $indent, $v, $type, $address, $class) = @_;
	return unless ref($self); # object method only
	my $string;
	# OBJECT HEADING
	$string .= $self->${\$self->{'_object'}}($ref, $indent, $v, $type, 
$address, $class) if $class;
	# PREFIX
	if ($v) {
		$string .= $self->{'_new_line'} . $self->{'_indent'} x $indent . "[";
		$string .= " # $type at $address" if $v >= 5;
		$indent++;
	}
	# FIX
	for (@{$ref}) {
		$string .= $self->${\$self->{'_each'}}(\$_, $indent);
	}
	# POSTFIX
	if ($v) {
		$string .= $self->{'_new_line'} . $self->{'_indent'} x --$indent . 
"]";
		$string .= $indent? "," : ";";
	}
	return $string;
}

I like the idea of using a dispatcher method. Although it adds an 
additional call to the stack it still supports the convenience of 
invoking the callbacks with a single expression, as long as the name of 
the intended callback is passed in as an argument (which would then be 
used as a hash key). Also it would allow centralized error handling for 
misspellings and bad coderefs.

Bogart