File Coverage

blib/lib/Data/Hierarchy/Traverser.pm

Criterion	Covered	Total	%
statement	15	51	29.4
branch	0	16	0.0
condition	0	16	0.0
subroutine	5	11	45.4
pod	0	1	0.0
total	20	95	21.0

package Data::Hierarchy::Traverser;

use 5.008;
use Carp;
use strict;
use warnings;
use Data::Dumper;

require Exporter;

our @ISA = qw(Exporter AutoLoader);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Hierarchy::Traverser ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	hierarchy_traverse
);

our $VERSION = '0.01';

sub hierarchy_traverse {
  my ($roots, $get_children_function, $options) = @_;
  my  $deepth =           $options->{deepth};
  my  $is_leaf =          $options->{is_leaf};
  my  $leaf =             $options->{leaf};
  my  $bare_branch     =   $options->{bare_branch};
  my  $pre_branch=        $options->{pre_branch};
  my  $post_branch =      $options->{post_branch};

  $options->{deepth} -- if defined $options->{deepth};

  defined $roots or croak "parameter roots is mandatory";
  defined $get_children_function  or croak "parameter get_children_function is mandatory\n";
  UNIVERSAL::isa($get_children_function, 'CODE')  or croak "get_children_function must be a sub\n";

  # should check if $get_children_function is ref to CODE.
  $is_leaf ||= sub {};
  $leaf ||=  sub {};
  $pre_branch ||=  sub {};
  $post_branch ||= sub {};
  $bare_branch ||=  sub {};

  my @roots;
  @roots = ref($roots)? @$roots : ($roots);
  foreach my $node (@roots) {
    if ($is_leaf->($node)) {
       $leaf->($node);
    } else {
      my $children = $get_children_function->($node);
      if (not defined $children or 0 ==@$children) {
	$bare_branch->($node);
        next;
      } else {
        if (defined $deepth and $deepth < 0 ) {
          $bare_branch->($node);
          next;
      }
        $pre_branch->($node);
        hierarchy_traverse($children, $get_children_function, $options);
        $post_branch->($node);
      }
    }
  }
}

# Preloaded methods go here.

1;
__END__