File Coverage

blib/lib/Tree/Simple/View/HTML.pm

Criterion	Covered	Total	%
statement	161	163	98.7
branch	66	70	94.2
condition	15	24	62.5
subroutine	23	23	100.0
pod	4	4	100.0
total	269	284	94.7

package Tree::Simple::View::HTML;

use strict;
use warnings;

our $VERSION = '0.20';

use parent 'Tree::Simple::View';

use Tree::Simple::View::Exceptions;

use constant OPEN_TAG  => 1;
use constant CLOSE_TAG => 2;
use constant EXPANDED  => 3;

my(%tags) =
(
	xhtml	=> { OL => 'ol', UL => 'ul', LI => 'li', STYLE => q{ style='}, CLASS => q{ class='} },
	html	=> { OL => 'OL', UL => 'UL', LI => 'LI', STYLE => q{ STYLE='}, CLASS => q{ CLASS='} },
);

## public methods

sub expandPathSimple  {
    my ($self, $tree, $current_path, @path) = @_;
    my @results;
    # if we were not called from this routine, and
    # include trunk has been turned on then, this is
    # the first time we have been called, so ...
    if ($self->{include_trunk} && (caller(1))[3] !~ /expandPathSimple$/) {
        push @results => '';
        push @results => ('' . $tree->getNodeValue() . '');
        # now recurse but dont change any of the args,
        # (if we are supposed to that is, based on the path)
        push @results => ($self->expandPathSimple($tree, @path))
            if (defined $current_path && $tree->getNodeValue() eq $current_path);
        push @results => '';
    }
    else {
        push @results => '';
        foreach my $child ($tree->getAllChildren()) {
            if (defined $current_path && $self->_compareNodeToPath($current_path, $child)) {
                push @results => ('' . $child->getNodeValue() . '');
                push @results => ($self->expandPathSimple($child, @path));
            }
            else {
                push @results => ('' . $child->getNodeValue() . '');
            }
        }
        push @results => '';
    }
    return (join "\n" => @results);
}

sub expandPathComplex {
    my ($self, $tree, $config, $current_path, @path) = @_;
    # get the config
    my ($list_func, $list_item_func) = $self->_processConfig($config);

    # use the helper function to recurse
    my $_expandPathComplex = sub {
        my ($self_func, $list_func, $list_item_func, $tree, $current_path, @path) = @_;
        my @results = ($list_func->(OPEN_TAG));
        foreach my $child ($tree->getAllChildren()) {
            if (defined $current_path && $self->_compareNodeToPath($current_path, $child)) {
                unless ($child->isLeaf()) {
                    push @results => ($list_item_func->($child, EXPANDED));
                    push @results => ($self_func->($self_func, $list_func, $list_item_func, $child, @path));
                }
                else {
                    push @results => ($list_item_func->($child));
                }
            }
            else {
                push @results => ($list_item_func->($child));
            }
        }
        push @results => ($list_func->(CLOSE_TAG));
        return (join "\n" => @results);
    };

    my @results;
    if ($self->{include_trunk}) {
        push @results => ($list_func->(OPEN_TAG));
        if (defined $current_path && $self->_compareNodeToPath($current_path, $tree)) {
            push @results => ($list_item_func->($tree, EXPANDED));
            push @results => $_expandPathComplex->($_expandPathComplex, $list_func, $list_item_func, $tree, @path);
        }
        else {
           push @results => ($list_item_func->($tree));
        }
        push @results => ($list_func->(CLOSE_TAG));
    }
    else {
        push @results => $_expandPathComplex->($_expandPathComplex, $list_func, $list_item_func, $tree, $current_path, @path);
    }

    return (join "\n" => @results);
}

sub expandAllSimple  {
    my ($self) = @_;

    my @results = ('');
    my $root_depth = $self->{tree}->getDepth() + 1;
    my $last_depth = -1;
    my $traversal_sub = sub {
        my ($t) = @_;
        my $current_depth = $t->getDepth();
        push @results => ('' x ($last_depth - $current_depth)) if ($last_depth > $current_depth);
        push @results => ('' . $t->getNodeValue() . '');
        push @results => '' unless $t->isLeaf();
        $last_depth = $current_depth;
    };
    $traversal_sub->($self->{tree}) if $self->{include_trunk};
    $self->{tree}->traverse($traversal_sub);
    $last_depth -= $root_depth;
    $last_depth++ if $self->{include_trunk};
    push @results => ('' x ($last_depth + 1));
    return (join "\n" => @results);
}

sub expandAllComplex
{
	my($self, $config)				= @_;
	my($html5)						= $$config{html5} ? 1 : 0;
	my($last_depth)					= -1;
	my($list_func, $list_item_func)	= $self->_processConfig($config);
	my($root_depth)					= $self->{tree}->getDepth + 1;

	my(@results);

	if ($html5)
	{
		@results									= ();
		my($css, $expanded_css, $node_formatter)	= $self->_processListItemConfig(%$config);
		$css										= $expanded_css;
		my($pre_sub)								= sub
		{
			my($t)			= @_;
			my($node_value)	= $node_formatter ? $node_formatter->($t) : $t->getNodeValue;

			push @results, "<$tags{html}{UL}$css>" if ($t->isFirstChild);
			push @results, "<$tags{html}{LI}$css>$node_value";
		};
		my($post_sub) = sub
		{
			my($t) = @_;

			push @results, "";
			push @results, "" if ($t->isLastChild);
		};

		if ($self->{include_trunk})
		{
			push @results, $list_func->(OPEN_TAG);

			$pre_sub->($self->{tree});
		}

		$self->{tree}->traverse($pre_sub, $post_sub);

		if ($self->{include_trunk})
		{
			$post_sub->($self->{tree});

			push @results, $list_func->(CLOSE_TAG);
		}
	}
	else
	{
		my($traversal_sub) = sub
		{
			my($t)				= @_;
			my($current_depth)	= $t->getDepth;

			push @results, ($list_func->(CLOSE_TAG) x ($last_depth - $current_depth) ) if ($last_depth > $current_depth);

			if ($t->isLeaf)
			{
				push @results, ($list_item_func->($t) );
			}
			else
			{
				push @results, $list_item_func->($t, EXPANDED);
			}

			push @results, $list_func->(OPEN_TAG) unless $t->isLeaf;

			$last_depth = $current_depth;
		};

		push @results, $list_func->(OPEN_TAG);

		$traversal_sub->($self->{tree}) if $self->{include_trunk};
		$self->{tree}->traverse($traversal_sub);

		$last_depth -= $root_depth;

		$last_depth++ if $self->{include_trunk};

		push @results, ($list_func->(CLOSE_TAG) x ($last_depth + 1) );
	}

	return (join "\n" => @results);

} # End of expandAllComplex.

## private methods

# process configurations

sub _processConfig {
    my ($self, $config) = @_;
    my %config = %{$config};

    # Make sure the tag style is always set to something we know &
    # set tags to be the hashref of tags we want to save extra indirection later
    if ( !exists $config{ tag_style } ) {
        $config{ tags } = $tags{ html };
    }
    elsif ( !exists( $tags{ $config{ tag_style } }) ) {
        throw Tree::Simple::View::CompilationFailed "Unknown tag_style $config{ tag_style }";
    }
    else {
        $config{ tags } = $tags{ $config{ tag_style } };
    }

    my $list_func = $self->_buildListFunction(%config)
        || throw Tree::Simple::View::CompilationFailed "List function didn't compile", $@;
    my $list_item_func  = $self->_buildListItemFunction(%config)
    	|| throw Tree::Simple::View::CompilationFailed "List item function didn't compile", $@;

    return ($list_func, $list_item_func);
}

## code strings to be evaluated

use constant LIST_FUNCTION_CODE_STRING => q|
    sub {
        my ($tag_type) = @_;
        return '<' . $config{tags}->{$list_type} . ${list_css} . '>' if ($tag_type == OPEN_TAG);
        return '{$list_type} .'>' if ($tag_type == CLOSE_TAG);
    }
|;

use constant LIST_ITEM_FUNCTION_CODE_STRING  => q|;
    sub {
		my($t, $is_expanded)	= @_;
		my($item_css)			= $list_item_css;
		$item_css				= $expanded_item_css if ($is_expanded && $expanded_item_css);
		my($node_value)			= $node_formatter ? $node_formatter->($t) : $t->getNodeValue;

		return  "<${$config{tags} }{LI}$item_css>$node_value";
    }
|;

## list config processing
sub _processListConfig {
    my ($self, %config) = @_;

    my $list_type = 'UL';
    $list_type = (($config{list_type} eq 'unordered') ? 'UL' : 'OL') if exists $config{list_type};

    my $list_css = '';
    if (exists $config{list_css}) {
        # make sure we have a proper ';' at the end
        # of the CSS code here, it is needed by the
        # DHTML subclass when we add the display property
        # to it, no other element requires this so far,
        # but if it did, this same idiom could be reused
        my $_list_css = $config{list_css};
        $_list_css .= ';' unless ($_list_css =~ /\;$/);
        $list_css = $config{tags}->{STYLE} . "${_list_css}'";
    }
    elsif (exists $config{list_css_class}) {
        $list_css = $config{tags}->{CLASS} . $config{list_css_class} . "'";
    }
    # otherwise do nothing and stick with default

    return ($list_type, $list_css);
}

sub _buildListFunction {
    my ($self, %config) = @_;
    # process the configuration directives
    my ($list_type, $list_css) = $self->_processListConfig(%config);
    # now compile the subroutine in the current environment
    return eval $self->LIST_FUNCTION_CODE_STRING;
}

## list item config processing

sub _processListItemConfig {
    my ($self, %config) = @_;

    my $list_item_css = '';
    if (exists $config{list_item_css}) {
        $list_item_css = $config{tags}->{STYLE} . $config{list_item_css} . "'";
    }
    elsif (exists $config{list_item_css_class}) {
        $list_item_css = $config{tags}->{CLASS} . $config{list_item_css_class} . "'";
    }
    # otherwise do nothing and stick with default

    my $expanded_item_css = '';
    if (exists $config{expanded_item_css}) {
        $expanded_item_css = $config{tags}->{STYLE} . $config{expanded_item_css} . "'";
    }
    elsif (exists $config{expanded_item_css_class}) {
        $expanded_item_css = $config{tags}->{CLASS} . $config{expanded_item_css_class} . "'";
    }
    # otherwise do nothing and stick with default

    my $node_formatter;
    $node_formatter = $config{node_formatter}
        if (exists $config{node_formatter} && ref($config{node_formatter}) eq 'CODE');

    return ($list_item_css, $expanded_item_css, $node_formatter);
}

sub _buildListItemFunction {
    my ($self, %config) = @_;
    # process the configuration directives
    my ($list_item_css, $expanded_item_css, $node_formatter) = $self->_processListItemConfig(%config);
    # now compile the subroutine in the current environment
    return eval $self->LIST_ITEM_FUNCTION_CODE_STRING;
}

1;

__END__