File Coverage

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

Criterion	Covered	Total	%
statement	139	141	98.5
branch	53	56	94.6
condition	15	24	62.5
subroutine	21	21	100.0
pod	4	4	100.0
total	232	246	94.3

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

use strict;
use warnings;

our $VERSION = '0.180001';

use base '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 ($list_func, $list_item_func) = $self->_processConfig($config);

    my @results = $list_func->(OPEN_TAG);
    my $root_depth = $self->{tree}->getDepth() + 1;
    my $last_depth = -1;
    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;
    };
    $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);
}

## 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);
        return '<'.$config{tags}->{LI}.$item_css.'>' . (($node_formatter) ? $node_formatter->($t) : $t->getNodeValue()) . '{LI}.'>';
    }
|;

## 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__