File Coverage

blib/lib/HTML/Template/Dumper.pm

Criterion	Covered	Total	%
statement	53	62	85.4
branch	19	28	67.8
condition	2	6	33.3
subroutine	9	10	90.0
pod	4	5	80.0
total	87	111	78.3

package HTML::Template::Dumper;
use strict;
use warnings;
use base 'HTML::Template';

our $VERSION = 0.1;

my ($format_obj, $output_filter);

BEGIN {
	use HTML::Template::Dumper::Data_Dumper;
	$format_obj = HTML::Template::Dumper::Data_Dumper->new();
}


sub set_output_format
{
	my $self    = shift;
	my $format  = shift || die "Need an output format";
	my @rest    = @_;

	my $full_format = $format;  # Rule 1 (see POD doc)
	if($full_format !~ /::/) {  # Rule 2
		$full_format = "HTML::Template::Dumper::$format";
	}

	$format_obj = eval {
		eval "require $full_format";
		$@ and die $@;
		$full_format->new(@rest);
	};
	if($@) {
		# Rule 3
		$format_obj = eval {
			eval "require $format";
			$@ and die $@;
			$format->new(@rest);
		};
	}

	# Give up trying to load the module and just attempt
	# to call it.  This would work if the module was in a
	# package declaration placed inline with the calling
	# file instead of a seperate file in @INC.
	#
	$@ and ($format_obj = eval { $full_format ->new(@rest) });
	$@ and ($format_obj = eval { $format      ->new(@rest) });

	# If we still don't have it, give up (Rule 4)
	$@ and die "No such module -- $full_format";

	$format_obj->isa( 'HTML::Template::Dumper::Format' ) or die
		ref $format_obj .
		" is not a HTML::Template::Dumper::Format implementation";

	return 1;
}

sub get_output_format { ref $format_obj }

sub output
{
	my $self = shift;
	my %in   = @_ ? @_ : ( );

	# Call HTML::Template->output(), since it could return
	# errors if there was a problem with the input parameters
	eval { $self->SUPER::output(@_) };
	$@ and die $@;

	my $ref = {
		map { $_ => $self->param($_) } $self->param(),
	};

	my $output = $format_obj->dump($ref);
	$output_filter->(\$output) if $output_filter;

	if($in{print_to}) {
		print {$in{print_to}} ( $output );
		return undef; # As per HTML::Template docs
	}
	return $output;
}

sub set_output_filter
{
	my $self = shift;
	my $filter = shift;
	die "set_output_filter() needs to be called with a code reference"
		unless ref $filter eq 'CODE';

	$output_filter = $filter;
}

sub parse
{
	my $self = shift;
	my $data = shift || return;

	if(! ref $self ) {
		# Called as a class method
		my $format = shift || 'Data_Dumper';
		my $dummy_tmpl = '';
		$self = $self->new( scalarref => \$dummy_tmpl );
		$self->set_output_format( $format );
	}

	return $format_obj->parse( $data );
}


1;
__END__