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


line stmt bran cond sub pod time code
1             package Callgrind::Parser;
2             $Callgrind::Parser::VERSION = '0.002';
3 1     1   97965 use strict;
  1         2  
  1         29  
4 1     1   4 use warnings;
  1         2  
  1         26  
5             require Exporter;
6 1     1   4 use base qw(Exporter);
  1         4  
  1         56  
7 1     1   4 use Carp;
  1         1  
  1         66  
8 1     1   4 use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
  1         1  
  1         77  
9              
10             BEGIN{
11 1     1   2 @EXPORT = ();
12 1         1 @EXPORT_OK = qw(&parseFile);
13 1         462 %EXPORT_TAGS = (all=>\@EXPORT_OK);
14             }
15              
16             =head1 NAME
17              
18             Callgrind::Parser - Parses Callgrind output file into a hashref representing the call tree of the source program
19              
20             =head1 VERSION
21              
22             version 0.001
23              
24             =head1 SYNOPSIS
25              
26             use Callgrind::Parser;
27            
28             my $profile = Callgrind::Parser::parseFile('t/data/helloworld.out')
29            
30             print "Hello world took ".$profile->{main}{Time}." milliseconds to run\n";
31              
32             =head1 DESCRIPTION
33              
34             The parser was designed to read Callgrind profile data as described L.
35             Primarily written to read and manipulate profiling output generated by L. Thus far it has only been tested
36             with files generated by xdebug.
37              
38             =cut
39              
40             =head1 METHODS
41              
42             =head2 parseFile
43              
44             This method does all the work of the function. Takes in the full path to a file to parse
45             Returns a hash containing the metadata read from the file header, as well has a hash ref
46             which represents the full call tree of the program from which the profile was generated.
47              
48             =cut
49              
50             sub parseFile {
51 2     2 1 2749 my($inf) = @_;
52            
53 2 100       142 open(my $fh, '<', $inf) or croak "Couldn't open input file for reading: $!\n";
54 1         3 my(%meta)=();
55 1         18 while (my $line = <$fh>) {
56 7         8 chomp $line;
57 7 100       12 next if(length($line) == 0);
58 6         19 my($key, $value) = split(/:\s+/, $line);
59 6 100       12 if ($key eq 'positions') {
    100          
60 1         5 $meta{$key} = [split(/\s+/, $value)];
61             }
62             elsif($key eq 'events') {
63 1         3 $meta{$key} = [split(/\s+/, $value)];
64             # discard trailing empty line
65 1         2 scalar(<$fh>);
66 1         2 last;
67             }
68             else {
69 4         13 $meta{$key} = $value;
70             }
71             }
72            
73 1         3 my(@buffer) = ();
74 1         2 my(%commands) = ();
75 1         6 while (my $line = <$fh>) {
76 5         6 chomp $line;
77 5 100       9 if (length($line) == 0){
78             # Handle summary line for program main
79 2 100       107 if ($buffer[-1] eq 'fn={main}') {
80 1         4 my $summary =<$fh>;
81 1         6 $summary=~m/(\d+)/;
82 1         7 $meta{total_time} = $1;
83 1         5 my $j = <$fh>;
84             }else{
85 1         73 &_parseCommand(\@buffer, \%commands, \%meta);
86 1         10 @buffer=();
87             }
88             }
89             else {
90 3         8 push @buffer, $line;
91             }
92             }
93 1         9 close($fh);
94            
95 1         11 return {meta=>\%meta, main=>$commands{'{main}'}{instances}[0]};
96             }
97              
98             sub _parseCommand {
99 1     1   3 my($stack, $commands, $meta) = @_;
100             # disregard file name
101 1         2 shift @$stack;
102 1         4 my $function = substr(shift @$stack, 3);
103            
104 1         3 my($line, @fields) = split(/\s+/, shift @$stack);
105            
106 1   50     13 $commands->{ $function } ||= {instances=>[]};
107 1         5 my(%instance) = (line=>$line, function=>$function);
108 1         1 @instance{ @{ $meta->{events} } } = @fields;
  1         4  
109 1         4 while ($#$stack > 0) {
110             # disregard file name
111 0         0 shift @$stack;
112 0         0 my $sfn = substr(shift @$stack, 4);
113 0         0 my $ca = substr(shift @$stack, 6);
114 0         0 my($cline, $time) = split(/\s+/, shift @$stack);
115 0         0 my $inst = shift @{ $commands->{ $sfn }{instances} };
  0         0  
116 0         0 $inst->{called_from} = $cline;
117 0         0 $inst->{time_inclusive} = $time;
118 0         0 push @{ $instance{children} }, $inst;
  0         0  
119             }
120 1         2 push @{ $commands->{$function}{instances} }, \%instance;
  1         4  
121             }
122              
123             1;
124             =head1 AUTHOR
125              
126             Dave Mueller
127              
128             =head1 COPYRIGHT AND LICENSE
129              
130             This software is copyright (c) 2015 by Dave Mueller.
131              
132             This is free software; you can redistribute it and/or modify it under the
133             same terms as the Perl 5 programming language system itself.