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<here|http://kcachegrind.sourceforge.net/html/CallgrindFormat.html>.
Primarily written to read and manipulate profiling output generated by L<xdebug|http://xdebug.org/>.  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 <dave@perljedi.com>

=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.