File Coverage

blib/lib/Tree/Simple/Manager.pm

Criterion	Covered	Total	%
statement	138	142	97.1
branch	57	62	91.9
condition	12	18	66.6
subroutine	24	24	100.0
pod	8	8	100.0
total	239	254	94.0

package Tree::Simple::Manager;

use strict;
use warnings;

use Scalar::Util qw(blessed);

our $VERSION = '0.07';

use Tree::Simple::Manager::Index;
use Tree::Simple::Manager::Exceptions;

use Tree::Parser;

use Tree::Simple;
use Tree::Simple::View::DHTML;

use File::stat;

use Storable ();

sub new {
    my ($_class, @tree_configs) = @_;
    (@tree_configs && scalar(@tree_configs) >= 2)
        || throw Tree::Simple::Manager::InsufficientArguments "You must supply at least one tree valid config";
    my $class = ref($_class) || $_class;
    my $tree_manager = {};
    bless($tree_manager, $class);
    $tree_manager->_init(\@tree_configs);
    return $tree_manager;
}

sub _init {
    my ($self, $tree_configs) = @_;
    $self->{trees} = {};
    while (@{$tree_configs}) {
        my ($tree_name, $config) = splice @{$tree_configs}, 0, 2;

        (exists $config->{tree_root})
            || throw Tree::Simple::Manager::InsufficientArguments "missing the required keys for '$tree_name' config";

        (!exists $self->{trees}->{$tree_name})
            || throw Tree::Simple::Manager::DuplicateName "The tree '$tree_name' already exists";

        $self->{trees}->{$tree_name} = {};

        my $root_tree = $config->{tree_root};
        (blessed($root_tree) && $root_tree->isa('Tree::Simple'))
            || throw Tree::Simple::Manager::IncorrectObjectType "The 'root_tree' must be a Tree::Simple instance (or a subclass of it)";

        # load from the file or something
        my $tree = $self->_loadTree($tree_name => $config);

        # by default we use our Index module

        my $tree_index_module;
        if (exists $config->{tree_index}) {
            ($config->{tree_index}->isa('Tree::Simple::Manager::Index'))
                || throw Tree::Simple::Manager::IncorrectObjectType "the 'tree_index' must be a subclass of Tree::Simple::Manager::Index";
            $tree_index_module = $config->{tree_index};
        }
        else {
            $tree_index_module = "Tree::Simple::Manager::Index";
        }

        $self->{trees}->{$tree_name}->{index} = $tree_index_module->new($tree);

        if (exists $config->{tree_meta_data}) {
            (ref $config->{tree_meta_data} eq 'HASH')
                || throw Tree::Simple::Manager::IncorrectObjectType "the 'tree_meta_data' option must be a HASH";
            foreach my $tree_id (keys %{$config->{tree_meta_data}}) {
                my $tree = $self->{trees}->{$tree_name}->{index}->getTreeByID($tree_id);
                ($tree->isa('Tree::Simple::WithMetaData'))
                    || throw Tree::Simple::Manager::IncorrectObjectType "the 'tree_meta_data' node for ($tree_name) id($tree_id) must be a Tree::Simple::WithMetaData instance";
                $tree->addMetaData(%{$config->{tree_meta_data}->{$tree_id}});
            }
        }

        my $tree_view;
        if (exists $config->{tree_view}) {
            ($config->{tree_view}->isa('Tree::Simple::View'))
                || throw Tree::Simple::Manager::IncorrectObjectType "the 'tree_view' must be a subclass of Tree::Simple::View";
            $tree_view = $config->{tree_view};
        }
        else {
            $tree_view = "Tree::Simple::View::DHTML"
        }

        $self->{trees}->{$tree_name}->{view} = $tree_view;
    }
}

sub _loadTree {
    my ($self, $tree_name, $config) = @_;

    (exists $config->{tree_file_path})
        || throw Tree::Simple::Manager::InsufficientArguments "missing the required keys for '$tree_name' config";

    if (exists $config->{tree_cache_path}) {
        my $cache_stat = stat $config->{tree_cache_path};
        my $file_stat = stat $config->{tree_file_path};

        if ( $file_stat and $cache_stat and $cache_stat->mtime >= $file_stat->mtime ) {
            my $tree;
            eval {
                $tree = Storable::retrieve($config->{tree_cache_path});
            };
            if ($@) {
                warn "Unable to load tree cache, removing cache tree";
                unlink $config->{tree_cache_path};
                warn "Attempting to load tree with parser";
            }
            else {
                $self->{trees_loaded_from_cache}->{$tree_name}++;
                return $tree;
            }
        }
    }

    my $tree;
    eval {
        my $tp = Tree::Parser->new($config->{tree_root});

        $tp->setFileEncoding($config->{tree_file_encoding})
            if exists $config->{tree_file_encoding};

        $tp->setInput($config->{tree_file_path});

        if (exists $config->{tree_parse_filter}) {
            (ref($config->{tree_parse_filter}) eq 'CODE')
                || throw Tree::Simple::Manager::IncorrectObjectType "a 'tree_parse_filter' must be a code ref";
            $tp->setParseFilter(
                $self->_parseFilterWrapper(
                    ref($config->{tree_root}),
                    $config->{tree_parse_filter}
                )
            );
        }
        else {
            $tp->setParseFilter(
                $self->_getDefaultParseFilter(
                    ref($config->{tree_root})
                )
            );
        }
        $tp->parse();
        $tree = $tp->getTree();
    };

    if ($@) {
        throw Tree::Simple::Manager::OperationFailed "unable to parse tree file '" . $config->{tree_file_path}. "'" => $@;
    }

    if (exists $config->{tree_cache_path}) {
        eval {
            Storable::store($tree, $config->{tree_cache_path});
        };
        if ($@) {
            warn "Unable to store tree cache ... sorry";
        }
    }

    return $tree;
}

sub _parseFilterWrapper {
    my ($self, $tree_type, $filter) = @_;
    return sub {
        my $i = shift;
        my ($depth, $tree) = $filter->($i, $tree_type);
        (blessed($tree) && $tree->isa('Tree::Simple'))
            || throw Tree::Simple::Manager::IncorrectObjectType "Custom Parse filters must return Tree::Simple objects";
        return ($depth, $tree);
    };
}

sub _getDefaultParseFilter {
    my (undef, $tree_type) = @_;
    return sub {
        my ($line_iterator) = @_;
        my $line = $line_iterator->next();
        my ($id, $tabs, $node) = ($line =~ /(\d+)\t(\t+)?(.*)/);
        my $depth = 0;
        $depth = length $tabs if $tabs;
        my $tree = $tree_type->new($node);
        $tree->setUID($id);
        return ($depth, $tree);
    };
}

sub getTreeList {
    my ($self) = @_;
    return wantarray ? keys %{$self->{trees}} : [ keys %{$self->{trees}} ];
}

sub getRootTree {
    my ($self, $tree_name) = @_;
    (defined($tree_name))
        || throw Tree::Simple::Manager::InsufficientArguments "Tree name not specified";
    (exists $self->{trees}->{$tree_name})
        || throw Tree::Simple::Manager::KeyDoesNotExist "tree ($tree_name) does not exist";
    return $self->{trees}->{$tree_name}->{index}->getRootTree();
}

sub getTreeIndex {
    my ($self, $tree_name) = @_;
    (defined($tree_name))
        || throw Tree::Simple::Manager::InsufficientArguments "Tree name not specified";
    (exists $self->{trees}->{$tree_name})
        || throw Tree::Simple::Manager::KeyDoesNotExist "tree ($tree_name) does not exist";
    return $self->{trees}->{$tree_name}->{index};
}

sub getTreeByID {
    my ($self, $tree_name, $tree_id) = @_;
    return $self->getTreeIndex($tree_name)->getTreeByID($tree_id);
}

sub getTreeViewClass {
    my ($self, $tree_name) = @_;
    (defined($tree_name))
        || throw Tree::Simple::Manager::InsufficientArguments "Tree name not specified";
    (exists $self->{trees}->{$tree_name})
        || throw Tree::Simple::Manager::KeyDoesNotExist "tree ($tree_name) does not exist";
    return $self->{trees}->{$tree_name}->{view};
}

sub getNewTreeView {
    my ($self, $tree_name, @view_args) = @_;
    my $tree_view_class = $self->getTreeViewClass($tree_name);
    return $tree_view_class->new($self->getRootTree($tree_name), @view_args);
}

sub isTreeLoadedFromCache {
    my ($self, $tree_name) = @_;
    exists $self->{trees_loaded_from_cache}->{$tree_name} &&
           $self->{trees_loaded_from_cache}->{$tree_name};
}

1;

__END__