AVLTree
view release on metacpan or search on metacpan
int count;
//ENTER;
//SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVsv(p1)));
XPUSHs(sv_2mortal(newSVsv(p2)));
PUTBACK;
/* Call the Perl sub to process the callback */
count = call_sv(callback, G_SCALAR);
SPAGAIN;
if(count != 1)
croak("Did not return a value\n");
cmp = POPi;
PUTBACK;
Makefile.PL view on Meta::CPAN
},
},
LIBS => [''], # e.g., '-lm',
DEFINE => '-DENABLE_DEBUG', # e.g., '-DHAVE_SOMETHING'
INC => '-Iavltree', # e.g., '-I/usr/include/other'
MYEXTLIB => 'avltree/libavltree$(LIB_EXT)',
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'AVLTree-*' },
);
sub MY::postamble {
'
$(MYEXTLIB): avltree/Makefile
cd avltree && $(MAKE) $(PASSTHRU)
';
}
avltree/Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker;
$Verbose = 1;
WriteMakefile(
NAME => 'AVLTree::avltree',
SKIP => [qw(all static static_lib dynamic dynamic_lib)],
clean => {'FILES' => 'libavltree$(LIB_EXT)'},
);
sub MY::top_targets {
'
all :: static
pure_all :: static
static :: libavltree$(LIB_EXT)
libavltree$(LIB_EXT): $(O_FILES)
$(AR) cr libavltree$(LIB_EXT) $(O_FILES)
$(RANLIB) libavltree$(LIB_EXT)
';
}
lib/AVLTree.pm view on Meta::CPAN
for creating and querying an AVL tree, get its size and insert and remove elements
from it. Additionaly, it is possible to traverse the tree in forward/reverse order.
=head1 SYNOPSIS
use AVLTree;
# Define a function to compare two numbers i1 and i2,
# return -1 if i1 < i2, 1 if i2 > i1 and 0 otherwise
sub cmp_f = sub {
my ($i1, $i2) = @_;
return $i1<$i2?-1:($i1>$i2)?1:0;
}
# Instantiate a tree which holds numbers
my $tree = AVLTree->new(\&cmp_f);
# Add some numbers to the tree
map { $tree->insert($_) } qw/10 20 30 40 50 25/;
lib/AVLTree.pm view on Meta::CPAN
printf "Size of tree is now: %d\n", $tree->size();
...
# Suppose you want the tree to hold generic data items, e.g. hashrefs
# which hold some data. We can deal with these by definying a custom
# comparison function based on one of the attributes of these data items,
# e.g. 'id':
sub compare {
my ($i1, $i2) = @_;
my ($id1, $id2) = ($i1->{id}, $i2->{id});
croak "Cannot compare items based on id"
unless defined $id1 and defined $id2;
return $id1<$id2?-1:($id1>$id2)?1:0;
}
# Now can do the same as with numbers
}
exit 0;
}
# Scan for possible replacement candidates
my(%replace, %need, %hints, %warnings, %depends);
my $replace = 0;
my($hint, $define, $function);
sub find_api
{
my $code = shift;
$code =~ s{
/ (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
| "[^"\\]*(?:\\.[^"\\]*)*"
| '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
grep { exists $API{$_} } $code =~ /(\w+)/mg;
}
while (<DATA>) {
else {
my @new = grep { -f } glob $_
or warn "'$_' does not exist.\n";
push @files, grep { !$seen{$_}++ } @new;
}
}
}
else {
eval {
require File::Find;
File::Find::find(sub {
$File::Find::name =~ /($srcext)$/i
and push @files, $File::Find::name;
}, '.');
};
if ($@) {
@files = map { glob "*$_" } @srcext;
}
}
if (!@ARGV || $opt{filter}) {
else {
info("Looks good");
}
}
close PATCH if $patch_opened;
exit 0;
sub try_use { eval "use @_;"; return $@ eq '' }
sub mydiff
{
local *F = shift;
my($file, $str) = @_;
my $diff;
if (exists $opt{diff}) {
$diff = run_diff($opt{diff}, $file, $str);
}
if (!defined $diff and try_use('Text::Diff')) {
}
if (!defined $diff) {
error("Cannot generate a diff. Please install Text::Diff or use --copy.");
return;
}
print F $diff;
}
sub run_diff
{
my($prog, $file, $str) = @_;
my $tmp = 'dppptemp';
my $suf = 'aaa';
my $diff = '';
local *F;
while (-e "$tmp.$suf") { $suf++ }
$tmp = "$tmp.$suf";
unlink $tmp;
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
sub rec_depend
{
my($func, $seen) = @_;
return () unless exists $depends{$func};
$seen = {%{$seen||{}}};
return () if $seen->{$func}++;
my %s;
grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
}
sub parse_version
{
my $ver = shift;
if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
return ($1, $2, $3);
}
elsif ($ver !~ /^\d+\.[\d_]+$/) {
die "cannot parse version '$ver'\n";
}
if ($r < 5 || ($r == 5 && $v < 6)) {
if ($s % 10) {
die "cannot parse version '$ver'\n";
}
}
return ($r, $v, $s);
}
sub format_version
{
my $ver = shift;
$ver =~ s/$/000000/;
my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
$v = int $v;
$s = int $s;
if ($r < 5 || ($r == 5 && $v < 6)) {
$ver = sprintf "%d.%03d", $r, $v;
$s > 0 and $ver .= sprintf "_%02d", $s;
return $ver;
}
return sprintf "%d.%d.%d", $r, $v, $s;
}
sub info
{
$opt{quiet} and return;
print @_, "\n";
}
sub diag
{
$opt{quiet} and return;
$opt{diag} and print @_, "\n";
}
sub warning
{
$opt{quiet} and return;
print "*** ", @_, "\n";
}
sub error
{
print "*** ERROR: ", @_, "\n";
}
my %given_hints;
my %given_warnings;
sub hint
{
$opt{quiet} and return;
my $func = shift;
my $rv = 0;
if (exists $warnings{$func} && !$given_warnings{$func}++) {
my $warn = $warnings{$func};
$warn =~ s!^!*** !mg;
print "*** WARNING: $func\n", $warn;
$rv++;
}
if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
my $hint = $hints{$func};
$hint =~ s/^/ /mg;
print " --- hint for $func ---\n", $hint;
}
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
Usage: $usage
See perldoc $0 for details.
ENDUSAGE
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
eval { require Devel::PPPort };
\$@ and die "Cannot require Devel::PPPort, please install.\\n";
if (eval \$Devel::PPPort::VERSION < $VERSION) {
/* Replace: 1 */
# define PL_ppaddr ppaddr
# define PL_no_modify no_modify
/* Replace: 0 */
#endif
#if (PERL_BCDVERSION <= 0x5004005)
/* Replace: 1 */
# define PL_DBsignal DBsignal
# define PL_DBsingle DBsingle
# define PL_DBsub DBsub
# define PL_DBtrace DBtrace
# define PL_Sv Sv
# define PL_bufend bufend
# define PL_bufptr bufptr
# define PL_compiling compiling
# define PL_copline copline
# define PL_curcop curcop
# define PL_curstash curstash
# define PL_debstash debstash
# define PL_defgv defgv
scripts/benchmarks.pl view on Meta::CPAN
# $diff = timediff($end, $start);
# printf "time taken was %s seconds\n", timestr($diff, 'all');
$start = new Benchmark;
print "[AVLTree]\t\t";
map { $avltree->remove($_) } @items;
$end = new Benchmark;
$diff = timediff($end, $start);
printf "time taken was %s seconds\n", timestr($diff, 'all');
sub cmp_f {
my ($i1, $i2) = @_;
return $i1<$i2?-1:($i1>$i2)?1:0;
}
t/01-numbers.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
plan tests => 28;
use AVLTree;
# test AVL tree with numbers
sub cmp_f {
my ($i1, $i2) = @_;
return $i1<$i2?-1:($i1>$i2)?1:0;
}
my $tree = AVLTree->new(\&cmp_f);
isa_ok($tree, "AVLTree");
is($tree->size(), 0, "Empty tree upon construction");
map { ok($tree->insert($_), "Insert item") } qw/10 20 30 40 50 25/;
t/02-custom.t view on Meta::CPAN
use Carp;
plan tests => 31;
use AVLTree;
# test AVL tree with custom data
# suppose data comes as a hash ref where the comparison is based on
# on the values associated to a given key, e.g. id
sub cmp_f {
my ($i1, $i2) = @_;
my ($id1, $id2) = ($i1->{id}, $i2->{id});
croak "Cannot compare items based on id"
unless defined $id1 and defined $id2;
return $id1<$id2?-1:($id1>$id2)?1:0;
}
my $tree = AVLTree->new(\&cmp_f);
isa_ok($tree, "AVLTree");
t/03-leak.t view on Meta::CPAN
use strict;
use warnings FATAL => 'all';
use constant HAS_LEAKTRACE => eval{ require Test::LeakTrace };
use Test::More HAS_LEAKTRACE ? (tests => 10) : (skip_all => 'require Test::LeakTrace');
use Test::LeakTrace;
use Carp;
BEGIN { use_ok('AVLTree'); }
sub cmp_numbers {
my ($i1, $i2) = @_;
return $i1<$i2?-1:($i1>$i2)?1:0;
}
sub cmp_custom {
my ($i1, $i2) = @_;
my ($id1, $id2) = ($i1->{id}, $i2->{id});
croak "Cannot compare items based on id"
unless defined $id1 and defined $id2;
return $id1<$id2?-1:($id1>$id2)?1:0;
}
# tests with numbers
no_leaks_ok {
xt/boilerplate.t view on Meta::CPAN
#!perl -T
use 5.006;
use strict;
use warnings;
use Test::More;
plan tests => 3;
sub not_in_file_ok {
my ($filename, %regex) = @_;
open( my $fh, '<', $filename )
or die "couldn't open $filename for reading: $!";
my %violated;
while (my $line = <$fh>) {
while (my ($desc, $regex) = each %regex) {
if ($line =~ $regex) {
push @{$violated{$desc}||=[]}, $.;
xt/boilerplate.t view on Meta::CPAN
}
if (%violated) {
fail("$filename contains boilerplate text");
diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
} else {
pass("$filename contains no boilerplate text");
}
}
sub module_boilerplate_ok {
my ($module) = @_;
not_in_file_ok($module =>
'the great new $MODULENAME' => qr/ - The great new /,
'boilerplate description' => qr/Quick summary of what the module/,
'stub function definition' => qr/function[12]/,
);
}
TODO: {
local $TODO = "Need to replace the boilerplate text";
( run in 0.323 second using v1.01-cache-2.11-cpan-a5abf4f5562 )