File Coverage

blib/lib/Devel/Gladiator.pm

Criterion	Covered	Total	%
statement	12	27	44.4
branch	0	4	0.0
condition			n/a
subroutine	4	6	66.6
pod	2	2	100.0
total	18	39	46.1

use strict;
use warnings;
package Devel::Gladiator;
# git description: v0.06-9-g25ce2f6
$Devel::Gladiator::VERSION = '0.07';
# ABSTRACT: Walk Perl's arena
# KEYWORDS: development debugging memory allocation usage leaks cycles arena

use base 'Exporter';

our %EXPORT_TAGS = ( 'all' => [ qw(
    walk_arena arena_ref_counts arena_table
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

sub arena_ref_counts {
    my $all = Devel::Gladiator::walk_arena();
    my %ct;
    foreach my $it (@$all) {
        $ct{ref $it}++;
        if (ref $it eq "REF") {
            $ct{"REF-" . ref $$it}++;
        }
    }
    $all = undef;
    return \%ct;
}

sub arena_table {
    my $ct = arena_ref_counts();
    my $ret;
    $ret .= "ARENA COUNTS:\n";
    foreach my $k (sort { $ct->{$b} <=> $ct->{$a} || $a cmp $b } keys %$ct) {
        $ret .= sprintf(" %4d $k\n", $ct->{$k});
    }
    return $ret;
}

use XSLoader;
XSLoader::load(
    __PACKAGE__,
    exists $Devel::Gladiator::{VERSION}
        ? ${ $Devel::Gladiator::{VERSION} }
        : (),
);

1;

__END__