File Coverage

blib/lib/Tree/RB/XS.pm

Criterion	Covered	Total	%
statement	52	56	92.8
branch	26	32	81.2
condition	18	31	58.0
subroutine	14	16	87.5
pod	4	4	100.0
total	114	139	82.0

package Tree::RB::XS;
$Tree::RB::XS::VERSION = '0.07';
# VERSION
# ABSTRACT: Red/Black Tree implemented in C, with similar API to Tree::RB

use strict;
use warnings;
use Carp;
use Scalar::Util ();
require XSLoader;
XSLoader::load('Tree::RB::XS', $Tree::RB::XS::VERSION);
use Exporter 'import';
our @_key_types= qw( KEY_TYPE_ANY KEY_TYPE_INT KEY_TYPE_FLOAT KEY_TYPE_BSTR KEY_TYPE_USTR );
our @_cmp_enum= qw( CMP_PERL CMP_INT CMP_FLOAT CMP_MEMCMP CMP_UTF8 CMP_NUMSPLIT );
our @_lookup_modes= qw( GET_EQ GET_EQ_LAST GET_GT GET_LT GET_GE GET_LE GET_LE_LAST GET_NEXT GET_PREV
                        LUEQUAL LUGTEQ LULTEQ LUGREAT LULESS LUNEXT LUPREV );
our @EXPORT_OK= (@_key_types, @_cmp_enum, @_lookup_modes);
our %EXPORT_TAGS= (
	key_type => \@_key_types,
	cmp      => \@_cmp_enum,
	lookup   => \@_lookup_modes,
	get      => \@_lookup_modes,
	all      => \@EXPORT_OK,
);


sub new {
	my $class= shift;
	my %options= @_ == 1 && ref $_[0] eq 'HASH'? %{$_[0]}
		: @_ == 1? ( compare_fn => $_[0] )
		: @_;
	my $self= bless \%options, $class;
	$self->_init_tree(delete $self->{key_type}, delete $self->{compare_fn});
	$self->allow_duplicates(1) if delete $self->{allow_duplicates};
	$self->compat_list_get(1) if delete $self->{compat_list_get};
	$self;
}


*root= *root_node;
*min= *min_node;
*max= *max_node;
*nth= *nth_node;


sub iter {
	my ($self, $key_or_node, $mode)= @_;
	$key_or_node= $self->get_node($key_or_node, @_ > 2? $mode : GET_GE())
		if @_ > 1 && ref $key_or_node ne 'Tree::RB::XS::Node';
	Tree::RB::XS::Iter->_new($key_or_node || $self, 1);
}

sub rev_iter {
	my ($self, $key_or_node, $mode)= @_;
	$key_or_node= $self->get_node($key_or_node, @_ > 2? $mode : GET_LE_LAST())
		if @_ > 1 && ref $key_or_node ne 'Tree::RB::XS::Node';
	Tree::RB::XS::Iter->_new($key_or_node || $self, -1);
}


*Tree::RB::XS::Node::min=         *Tree::RB::XS::Node::left_leaf;
*Tree::RB::XS::Node::max=         *Tree::RB::XS::Node::right_leaf;
*Tree::RB::XS::Node::successor=   *Tree::RB::XS::Node::next;
*Tree::RB::XS::Node::predecessor= *Tree::RB::XS::Node::prev;


sub Tree::RB::XS::Node::strip {
	my ($self, $cb)= @_;
	my ($at, $next, $last)= (undef, $self->left_leaf || $self, $self->right_leaf || $self);
	do {
		$at= $next;
		$next= $next->next;
		if ($at != $self) {
			$at->prune;
			$cb->($at) if $cb;
		}
	} while ($at != $last);
}

sub Tree::RB::XS::Node::as_lol {
	my $self= $_[1] || $_[0];
	[
		$self->left? $self->left->as_lol : '*',
		$self->right? $self->right->as_lol : '*',
		($self->color? 'R':'B').':'.($self->key||'')
	]
}

sub Tree::RB::XS::Node::iter {
	Tree::RB::XS::Iter->_new($_[0], 1);
}

sub Tree::RB::XS::Node::rev_iter {
	Tree::RB::XS::Iter->_new($_[0], -1);
}


# I can't figure out how to do the closure in XS yet
sub Tree::RB::XS::Iter::_new {
	my $class= shift;
	my ($self,$y);
	$self= bless sub { Tree::XS::RB::Iter::next($y) }, $class;
	Scalar::Util::weaken($y= $self);
	$self->_init(@_);
}
sub Tree::RB::XS::Iter::clone {
	my $self= shift;
	ref($self)->_new($self);
}


*TIEHASH= *new;
*STORE= *put;
*CLEAR= *clear;

sub hseek {
	my ($self, $key, $opts)= @_;
	if (@_ == 2 && ref $key eq 'HASH') {
		$opts= $key;
		$key= $opts->{'-key'};
	}
	my $reverse= $opts && $opts->{'-reverse'} || 0;
	my $node= defined $key? $self->get_node($key, $reverse? GET_LE_LAST() : GET_GE()) : undef;
	$self->_set_hashiter($node, $reverse);
}


*LUEQUAL= *GET_EQ;
*LUGTEQ=  *GET_GE;
*LUGTLT=  *GET_LE;
*LUGREAT= *GET_GT;
*LULESS=  *GET_LT;
*LUPREV=  *GET_PREV;
*LUNEXT=  *GET_NEXT;


1;

__END__