File Coverage

blib/lib/Callgrind/Parser.pm

Criterion	Covered	Total	%
statement	57	67	85.0
branch	12	12	100.0
condition	1	2	50.0
subroutine	8	8	100.0
pod	1	1	100.0
total	79	90	87.7

package Callgrind::Parser;
$Callgrind::Parser::VERSION = '0.001';
use strict;
use warnings;
require Exporter;
use base qw(Exporter);
use Carp;
use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);

BEGIN{
    @EXPORT = ();
    @EXPORT_OK = qw(&parseFile);
    %EXPORT_TAGS = (all=>\@EXPORT_OK);
}

=head1 NAME

Callgrind::Parser - Parses Callgrind output file into a hashref representing the call tree of the source program

=head1 VERSION

version 0.001

=head1 SYNOPSIS

    use Callgrind::Parser;

    my $profile = Callgrind::Parser::parseFile('t/data/helloworld.out')

    print "Hello world took ".$profile->{main}{Time}." milliseconds to run\n";

=head1 DESCRIPTION

The parser was designed to read Callgrind profile data as described L.
Primarily written to read and manipulate profiling output generated by L.  Thus far it has only been tested
with files generated by xdebug.

=cut

=head1 METHODS

=head2 parseFile

This method does all the work of the function.  Takes in the full path to a file to parse
Returns a hash containing the metadata read from the file header, as well has a hash ref
which represents the full call tree of the program from which the profile was generated.

=cut

sub parseFile {
    my($inf) = @_;

    open(my $fh, '<', $inf) or croak "Couldn't open input file for reading: $!\n";
    my(%meta)=();
    while (my $line = <$fh>) {
	chomp $line;
	next if(length($line) == 0);
	my($key, $value) = split(/:\s+/, $line);
	if ($key eq 'positions') {
	    $meta{$key} = [split(/\s+/, $value)];
	}
	elsif($key eq 'events') {
	    $meta{$key} = [split(/\s+/, $value)];
	    # discard trailing empty line
	    scalar(<$fh>);
	    last;
	}
	else {
	    $meta{$key} = $value;
	}
    }

    my(@buffer) = ();
    my(%commands) = ();
    while (my $line = <$fh>) {
	chomp $line;
	if (length($line) == 0){
	    # Handle summary line for program main
	    if ($buffer[-1] eq 'fn={main}') {
		my $summary =<$fh>;
		$summary=~m/(\d+)/;
		$meta{total_time} = $1;
		my $j = <$fh>;
	    }else{
		&_parseCommand(\@buffer, \%commands, \%meta);
		@buffer=();
	    }
	}
	else {
	    push @buffer, $line;
	}
    }
    close($fh);

    return {meta=>\%meta, main=>$commands{'{main}'}{instances}[0]};
}

sub _parseCommand {
    my($stack, $commands, $meta) = @_;
    # disregard file name
    shift @$stack;
    my $function = substr(shift @$stack, 3);

    my($line, @fields) = split(/\s+/, shift @$stack);

    $commands->{ $function } ||= {instances=>[]};
    my(%instance) = (line=>$line, function=>$function);
    @instance{ @{ $meta->{events} } } = @fields;
    while ($#$stack > 0) {
	# disregard file name
	shift @$stack;
	my $sfn = substr(shift @$stack, 4);
	my $ca  = substr(shift @$stack, 6);
	my($cline, $time) = split(/\s+/, shift @$stack);
	my $inst = shift @{ $commands->{ $sfn }{instances} };
	$inst->{called_from} = $cline;
	$inst->{time_inclusive} = $time;
	push @{ $instance{children} }, $inst;
    }
    push @{ $commands->{$function}{instances} }, \%instance;
}

1;
=head1 AUTHOR

  Dave Mueller

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by Dave Mueller.

This is free software; you can redistribute it and/or modify it under the
same terms as the Perl 5 programming language system itself.