File Coverage

blib/lib/Set/SegmentTree.pm

Criterion	Covered	Total	%
statement	43	45	95.5
branch	7	10	70.0
condition			n/a
subroutine	14	15	93.3
pod	6	6	100.0
total	70	76	92.1

package Set::SegmentTree;

use strict;
use warnings;

our $VERSION = '0.06';

use Carp qw/confess croak carp/;
use Set::SegmentTree::ValueLookup;
use List::Util qw/uniq/;
use File::Map qw/map_file/;
use Set::SegmentTree::Builder;

use strict;
use warnings;

sub new {
    croak 'There is no new.  Do you mean Set::Interval::Builder->new(\$'
        . 'options)?';
}

sub from_file {
    my ( $class, $filename ) = @_;
    map_file my $bin, $filename, '<';
    return
        bless {
        flatbuffer => Set::SegmentTree::ValueLookup->deserialize($bin) },
        $class;
}

sub deserialize {
    my ( $class, $serialization ) = @_;
    return
        bless { flatbuffer =>
            Set::SegmentTree::ValueLookup->deserialize($serialization) },
        $class;
}

sub find {
    my ( $self, $instant ) = @_;
    return uniq $self->find_segments(
        $self->node( $self->{flatbuffer}->root ), $instant );
}

sub node {
    my ( $self, $offset ) = @_;
    return $self->{flatbuffer}->nodes->[$offset];
}

sub find_segments {
    my ( $self, $node, $instant ) = @_;
    warn "instant $instant node "
        . $node->min . '->'
        . $node->max . q^: ^
        . join( q^ ^, sort @{ $node->segments || [] } ) . "\n"
        if $self->{verbose};
    return uniq @{ $node->segments || [] },
        map { $self->find_segments( $_, $instant ) }
        grep { $instant >= $_->{min} && $instant <= $_->{max} }
        map { $node->$_ ? $self->node( $node->$_ ) : () } qw/low high/;
}

1;
__END__