The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
use strict;

sub report {
    my($desc, $count, $sub) = @_;
    print STDERR "[[ timing ]] $desc\n";
    print STDERR timestr(timeit($count, $sub))."\n";
}

sub mark {
    print STDERR "------\n";
}

my %options = @ARGV;
srand(delete $options{srand}) if exists $options{srand};
defined(my $size   = delete $options{size})   || die "No size option";
defined(my $string = delete $options{string}) || die "No string option";
defined(my $inc    = delete $options{INC})    || die "No INC option";
die "Unknown option ", join(",", keys %options) if %options;
@INC = map { s/%(\d+)/chr($1)/eg; $_ } split /:/, $inc;
eval '
    use Benchmark;
    use Heap::Priority;
    1' || die $@;

# Only do few priority levels, or it's unfair to Heap::Priority
my $levels = int sqrt $size;
$levels =~ s/\B./0/g;
my @input;
if ($string) {
    for (1..$size) {
        push @input, ["A$_", rand(2*$size) % $levels]
    }
} else {
    for (1..$size) {
        push @input, [$_, rand(2*$size) % $levels];
    }
}

my $heap = Heap::Priority->new;
mark;
report("Insert of $size elements into Heap::Priority",
       $size,
       sub { $heap->add(@{pop @input}) });
undef @input;
report("Extract $size elements from Heap::Priority",
       $size,
       sub { $heap->pop });