File Coverage

blib/lib/Devel/Memalyzer/Plugin/ProcSmaps.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	7	10	70.0
condition	3	5	60.0
subroutine	7	7	100.0
pod	0	2	0.0
total	52	59	88.1

package Devel::Memalyzer::Plugin::ProcSmaps;
use strict;
use warnings;

use base 'Devel::Memalyzer::Base';

BEGIN {
    die( __PACKAGE__ . ' cannot be used without a proc filesystem')
        unless -e '/proc';
}

sub collect {
    my $self = shift;
    my ( $pid ) = @_;

    return $self->capture_smaps( $pid );
}

sub smaps {
    my $self = shift;
    my ( $pid ) = @_;
    return "/proc/$pid/smaps";
}

sub capture_smaps {
    my $self = shift;
    my ( $pid ) = @_;
    my $smaps_file = $self->smaps( $pid );

    my %data;
    next unless -e $smaps_file && -r $smaps_file;
    open( my $smap, '<', $smaps_file ) || die( "Error opening smaps: $!" );
    my $module;
    while( my $line = <$smap> ) {
        chomp( $line );
        if ( $module ) {
            $line =~ m/^Size:\s+(\d+)/i;
            $data{ $module } += $1;
            $module = undef;
            next;
        }
        next unless $line =~ m{(/lib/perl5/.*$)};
        $module = $1;
        $data{ $module } ||= 0;
    }
    close( $smap );
    return %data;
}

1;

__END__