File Coverage

blib/lib/Tree/Serial.pm

Criterion	Covered	Total	%
statement	8	72	11.1
branch	0	26	0.0
condition	0	6	0.0
subroutine	3	13	23.0
pod	2	3	66.6
total	13	120	10.8

package Tree::Serial;

use warnings;
use v5.12;

use List::Util qw(min reduce sum zip);

our $VERSION=0.20;

sub new {
    my ($class,$data) = @_;
    my $self = {};
    bless $self, $class;
    $self->_init($data);
    return $self;
}

sub _init {
    my ($self,$data) = @_;
    my %data = (
	separator => '.',
	degree => 2,
        traversal => 0,
	(defined $data) ? (%{$data}) : (),
	);
    (exists $data{showMissing}) && do {$self->{showMissing} = $data{showMissing}};
    @{$self}{qw(separator degree traversal)} = @data{qw(separator degree traversal)};
}

sub _eatWhileNot {
    my ($pred,$acc,$el) = @_;
    my @larger = (@{$acc->[1]}, $el);
    return ($pred->(\@larger)) ? ([[@{$acc->[0]}, \@larger],[]]) : ([$acc->[0], \@larger]);
}

sub _chunkBy {
    my ($pred,$aref) = @_;
    my $reduction = reduce { _eatWhileNot($pred, $a, $b) } [[],[]], @{$aref};
    return $reduction->[0];
}

sub _isKAry {
    my ($separator,$degree,$aref) = @_;
    return ((sum map { ($_ eq $separator) ? (-1) : ($degree-1) } @{$aref}) == -1);
}

sub _chunkKAry {
    my ($separator,$degree,$aref) = @_;
    my $pred = sub { _isKAry($separator,$degree,$_[0]) };
    return _chunkBy($pred,$aref);
}

sub strs2hash {
    my ($self, $aref) = @_;
    (! scalar @{$aref}) && return {};
    ($aref->[0] eq $self->{separator}) && do {
	(exists $self->{showMissing} && defined $self->{showMissing}) && return {name => $self->{showMissing}};
	(exists $self->{showMissing}) && return {};
	return;
    };
    my @rest = @{$aref}[1..scalar @{$aref}-1];
    my @chunks = @{_chunkKAry($self->{separator}, $self->{degree}, \@rest)};
    (! exists $self->{showMissing}) && do {@chunks = grep {$_->[0] ne $self->{separator}} @chunks};
    my %h = (
	name => $aref->[0],
	map {$_->[0] => strs2hash($self,$_->[1])} zip [0..$#chunks], \@chunks,
	);
    return \%h;
}

sub strs2lol {
    my ($self, $aref) = @_;
    (! scalar @{$aref}) && return [];
    ($aref->[0] eq $self->{separator}) && do {
	(exists $self->{showMissing} && defined $self->{showMissing}) && return [$self->{showMissing}];
	(exists $self->{showMissing}) && return [];
	return;
    };
    my @rest = @{$aref}[1..scalar @{$aref}-1];
    my $chunks = _chunkKAry($self->{separator}, $self->{degree}, \@rest);
    my @others = map {strs2lol($self,$_)} @{$chunks};
    splice(@others,min(scalar @others, $self->{traversal}),0,$aref->[0]);
    return \@others;
}

1;

__END__