File Coverage

blib/lib/Tree/Simple/Visitor/LoadClassHierarchy.pm

Criterion	Covered	Total	%
statement	68	68	100.0
branch	19	26	73.0
condition	3	9	33.3
subroutine	13	13	100.0
pod	4	4	100.0
total	107	120	89.1

package Tree::Simple::Visitor::LoadClassHierarchy;

use strict;
use warnings;

our $VERSION = '0.14';

use Scalar::Util qw(blessed);

use base qw(Tree::Simple::Visitor);

sub new {
    my ($_class) = @_;
    my $class = ref($_class) || $_class;
    my $visitor = {};
    bless($visitor, $class);
    $visitor->_init();
    return $visitor;
}

sub _init {
    my ($self) = @_;
    $self->{class_to_load} = undef;
    $self->{include_methods} = 0;
    $self->SUPER::_init();
}

sub setClass {
    my ($self, $class_to_load) = @_;
    (defined($class_to_load)) || die "Insufficient Arguments : Must provide a class to load";
    $self->{class_to_load} = $class_to_load;
}

sub includeMethods {
    my ($self, $boolean) = @_;
    $self->{include_methods} = ($boolean ? 1 : 0) if defined $boolean;
    return $self->{include_methods};
}

sub visit {
	my ($self, $tree) = @_;
	(blessed($tree) && $tree->isa("Tree::Simple"))
		|| die "Insufficient Arguments : You must supply a valid Tree::Simple object";
    # it must be a leaf
    ($tree->isLeaf()) || die "Illegal Operation : The tree must be a leaf node to load a class hierarchy";
    (defined $self->{class_to_load}) || die "Insufficient Arguments : Must provide a class to load";
    # get the filter
    my $filter = $self->getNodeFilter();
    # get the class to load
    my $class_to_load = ref($self->{class_to_load}) || $self->{class_to_load};

    # deal with the include trunk functionality
    if ($self->includeTrunk()) {
        $tree->setNodeValue(defined $filter ? $filter->($class_to_load) : $class_to_load);
    }
    else {
        my $new_tree = Tree::Simple->new(defined $filter ? $filter->($class_to_load) : $class_to_load);
        $tree->addChild($new_tree);
        if ($self->includeMethods()) {
            $self->_loadMethods($new_tree, $class_to_load, $filter);
        }
        $tree = $new_tree;
    }

    # and load it recursively
    $self->_loadClass($tree, $class_to_load, $filter);
}

sub _loadClass {
    my ($self, $tree, $class_to_load, $filter) = @_;
    my @superclasses;
    {
        no strict 'refs';
        @superclasses = @{"${class_to_load}::ISA"};
    }
    foreach my $superclass (@superclasses) {
        my $new_tree = Tree::Simple->new(defined $filter ? $filter->($superclass) : $superclass);
        $tree->addChild($new_tree);
        if ($self->includeMethods()) {
            $self->_loadMethods($new_tree, $superclass, $filter);
        }
        $self->_loadClass($new_tree, $superclass, $filter);
    }
}

sub _loadMethods {
    my ($self, $tree, $class, $filter) = @_;
    my @methods;
    {
        no strict 'refs';
        @methods = sort grep { defined &{"${class}::$_"} } keys %{"${class}::"};
    }
    foreach my $method (@methods) {
        $tree->addChild(Tree::Simple->new(defined $filter ? $filter->($method) : $method));
    }
}

1;

__END__