File Coverage

blib/lib/Devel/NYTProf/Callgrind/Ticks.pm
Criterion Covered Total %
statement 101 104 97.1
branch 26 30 86.6
condition 2 2 100.0
subroutine 12 12 100.0
pod 7 7 100.0
total 148 155 95.4


line stmt bran cond sub pod time code
1             package Devel::NYTProf::Callgrind::Ticks; # Represents a mesh of Ticks read from a callgrind file
2              
3 6     6   2905 use strict;
  6         8  
  6         139  
4 6     6   17 use warnings;
  6         6  
  6         253  
5             our $VERSION = '0.02';
6              
7              
8 6     6   2662 use Moose;
  6         1808034  
  6         39  
9              
10             # This class is mainly for TicksDiff but you can also use it alone
11             # to load and save callgrind files.
12             #
13             # With this class you may find via getBlockEquivalent() the same callgrind
14             # block in a file by using a different callgrind file as reference to
15             # compare the values.
16             #
17             # Or you want to manipulate callgrind files by changing values or adding blocks.
18             # If you plan to write any kind of ticks analysis this class might be helpull.
19             # Then maybe getBlocksAsArray() is usefull.
20             #
21             # AUTHOR
22             # ======
23             # Andreas Hernitscheck - ahernit AT cpan.org
24             #
25             # LICENCE
26             # =======
27             # You can redistribute it and/or modify it under the conditions of
28             # LGPL and Artistic Licence.
29              
30              
31             # file to be loaded
32             has 'file' => (
33             is => 'rw',
34             isa => 'Str',
35             );
36              
37             # returns the list of blocks,
38             # or writes them
39             has 'list' => (
40             is => 'rw',
41             isa => 'ArrayRef',
42             default => sub{[]},
43             );
44              
45              
46             has 'blocks_by_id' => (
47             is => 'rw',
48             isa => 'HashRef',
49             default => sub{{}},
50             );
51              
52              
53              
54              
55             sub BUILD{
56 16     16 1 8217 my $self = shift;
57              
58             # file to be loaded?
59 16 100       497 if ( $self->file() ){
60 10         284 $self->loadFile( $self->file() );
61             }
62              
63             }
64              
65             # Loads the callgrind file into memory and starts internal indexing of the blocks.
66             sub loadFile{ # void ( $filename )
67 10     10 1 15 my $self = shift;
68 10         13 my $file = shift;
69            
70 10 50       417 if ( not -f $file ){ die "file $file does not exist" };
  0         0  
71              
72 10         576 open( my $fh, $file );
73              
74 10         18 my $area;
75             my $block;
76 0         0 my @list;
77 10         231 while ( my $line = <$fh> ){
78 354         480 $line =~ s/\n//; # remove return
79              
80             # starting an area
81 354 100       571 if ( $line =~ m/events:\s(\w+)/i ){
82 10         31 $area = lc($1);
83 10         33 next;
84             }
85              
86             # skip line if not type ticks
87 344 50       414 if ( $area ne 'ticks' ){ next };
  0         0  
88              
89             # empty line is cleaning the block buffer
90 344 100       557 if ( $line =~ m/^\s*$/ ){
91              
92             # save the found block infos
93 68 100       135 if ( scalar( keys %$block ) != 0 ){ push @list,$block };
  56         67  
94              
95 68         72 $block={};
96 68         178 next;
97             }
98              
99             # is there a equals char? (=)
100 276 100       503 if ( $line =~ m/(\w+)=(.+)/ ){
101 218         215 my $key = $1;
102 218         209 my $value = $2;
103 218         261 $block->{ $key } = $value;
104              
105 218 100       295 if ( $key eq 'calls' ){
106 34         75 my ($count, $dstpos) = split(/ /, $value, 2);
107 34         48 $block->{ 'count' } = $count;
108 34         43 $block->{ 'dstpos' } = $dstpos;
109             }
110             }
111              
112             ## read the ticks
113 276 100       721 if ( $line =~ m/^(\d+) (\d+)$/ ){
114 58         106 $block->{ 'srcpos' } = $1;
115 58         200 $block->{ 'ticks' } = $2;
116             }
117              
118             } # while
119              
120             # no blank line on the end? save the block if needed
121 10 100       33 if ( keys %$block ){ push @list,$block };
  2         4  
122              
123             #print Dumper( \@list );
124              
125             # save the callgrind list holding blocks
126 10         379 $self->list( \@list );
127 10         33 $self->_buildIdHash();
128              
129 10         248 close( $fh );
130             }
131              
132              
133             # build hash to for list_by_id to find
134             # nodes by a fingerprint/id
135             sub _buildIdHash{
136 10     10   14 my $self = shift;
137 10         312 my $list = $self->list();
138 10         17 my $idhash = {};
139              
140 10         21 foreach my $block (@$list){
141 58         76 my $id = $self->_createFingerprintOfBlock( $block );
142              
143 58         112 $idhash->{ $id } = $block;
144             }
145            
146             #print Dumper( $idhash );
147 10         331 $self->blocks_by_id( $idhash );
148             }
149              
150             # Adds a block. For example you start with an
151             # empty object and wants to add blocks from
152             # a different object. It will replace an existing
153             # block if the definition existists already. So
154             # addBlock can also be used to update a block.
155             # If you update an existing block, it does break
156             # the reference to the given hashref, it makes a copy
157             # of the values. So do not use the original hash then
158             # but use the method of this class to get the callgrind text.
159             sub addBlock{ # void ( HashRef $block )
160 38     38 1 490 my $self = shift;
161 38         29 my $block = shift;
162              
163 38         48 my $id = $self->_createFingerprintOfBlock( $block );
164 38         1349 my $found = $self->blocks_by_id()->{ $id };
165              
166             # if already in, replace it, otherwise add it
167 38 100       58 if ( $found ){
168 2         3 %{ $found } = %{ $block };
  2         12  
  2         5  
169             }else{
170 36 50       62 if ( scalar( keys %$block ) != 0 ){
171 36         24 push @{ $self->list() }, $block;
  36         968  
172 36         1010 $self->blocks_by_id()->{ $id } = $block;
173             }
174             }
175              
176             }
177              
178              
179             # Takes a callgrind block and creates a unique string
180             # to compare different files and find the same block.
181             sub _createFingerprintOfBlock{
182 155     155   4268 my $self = shift;
183 155         105 my $block = shift;
184 155         119 my $id;
185              
186 155         263 my @keys = qw( fl fn srcpos cfl cfn dstpos );
187              
188 155         100 my @id;
189 155         141 foreach my $w (@keys){
190 930   100     1631 push @id, $block->{ $w } || '';
191             }
192 155         242 $id = join("#", @id);
193              
194 155         264 return $id;
195             }
196              
197              
198             # returns the equivalent block in that object to a given
199             # strange block (from a different object).
200             # Returns undef if not found.
201             sub getBlockEquivalent{ # \%block ( \%block )
202 31     31 1 27 my $self = shift;
203 31         24 my $block = shift;
204 31         23 my $found = undef;
205              
206 31         44 my $id = $self->_createFingerprintOfBlock( $block );
207              
208 31 100       978 if ( exists $self->blocks_by_id()->{ $id } ){
209 29         838 $found = $self->blocks_by_id()->{ $id };
210             }
211              
212 31         61 return $found;
213             }
214              
215              
216             # Is the same as list(). It returns an ArrayRef
217             # of the blocks (HashRefs).
218             sub getBlocksAsArray{ # \@list
219 21     21 1 975 my $self = shift;
220              
221 21         638 return $self->list();
222             }
223              
224              
225             # Save the data to a callgrind file. The event type will
226             # be 'Ticks', nothing else.
227             sub saveFile{ # void ( $filename )
228 2     2 1 6 my $self = shift;
229 2         4 my $file = shift;
230            
231 2         5 my $text = $self->getAsText();
232              
233 2 50       308 open( my $fh, ">$file" ) or die "Can not write file $file";
234              
235 2         28 print $fh $text;
236              
237 2         130 close( $fh );
238              
239             }
240              
241              
242             # Returns the callgrind text
243             sub getAsText{ # $text
244 2     2 1 2 my $self = shift;
245 2         4 my @lines;
246              
247 2         3 push @lines, "events: Ticks";
248 2         3 push @lines, "";
249              
250 2         7 my @pairs = qw( fl fn cfl cfn calls );
251              
252 2         3 foreach my $node ( @{ $self->list() } ){
  2         53  
253              
254 14         13 my @block = ();
255              
256 14         13 foreach my $p ( @pairs ){
257 70 100       121 push @block,"$p=".$node->{$p} if exists $node->{$p};
258             }
259              
260 14         27 push @lines, join( "\n", @block );
261 14         20 push @lines, $node->{'srcpos'}.' '.$node->{'ticks'};
262 14         16 push @lines, "";
263              
264              
265             }
266            
267 2         10 return join( "\n", @lines );
268             }
269              
270              
271              
272             1;
273              
274             #################### pod generated by Pod::Autopod - keep this line to make pod updates possible ####################
275              
276             =head1 NAME
277              
278             Devel::NYTProf::Callgrind::Ticks - Represents a mesh of Ticks read from a callgrind file
279              
280              
281             =head1 DESCRIPTION
282              
283             This class is mainly for TicksDiff but you can also use it alone
284             to load and save callgrind files.
285              
286             With this class you may find via getBlockEquivalent() the same callgrind
287             block in a file by using a different callgrind file as reference to
288             compare the values.
289              
290             Or you want to manipulate callgrind files by changing values or adding blocks.
291             If you plan to write any kind of ticks analysis this class might be helpull.
292             Then maybe getBlocksAsArray() is usefull.
293              
294              
295              
296             =head1 REQUIRES
297              
298             L<Moose>
299              
300              
301             =head1 METHODS
302              
303             =head2 new
304              
305             $this->new();
306              
307             =head2 BUILD
308              
309             $this->BUILD();
310              
311             =head2 addBlock
312              
313             $this->addBlock(\%$block);
314              
315             Adds a block. For example you start with an
316             empty object and wants to add blocks from
317             a different object. It will replace an existing
318             block if the definition existists already. So
319             addBlock can also be used to update a block.
320             If you update an existing block, it does break
321             the reference to the given hashref, it makes a copy
322             of the values. So do not use the original hash then
323             but use the method of this class to get the callgrind text.
324              
325              
326             =head2 getAsText
327              
328             my $text = $this->getAsText();
329              
330             Returns the callgrind text
331              
332              
333             =head2 getBlockEquivalent
334              
335             my \%block = $this->getBlockEquivalent(\%block);
336              
337             returns the equivalent block in that object to a given
338             strange block (from a different object).
339             Returns undef if not found.
340              
341              
342             =head2 getBlocksAsArray
343              
344             my \@list = $this->getBlocksAsArray();
345              
346             Is the same as list(). It returns an ArrayRef
347             of the blocks (HashRefs).
348              
349              
350             =head2 loadFile
351              
352             $this->loadFile($filename);
353              
354             Loads the callgrind file into memory and starts internal indexing of the blocks.
355              
356              
357             =head2 saveFile
358              
359             $this->saveFile($filename);
360              
361             Save the data to a callgrind file. The event type will
362             be 'Ticks', nothing else.
363              
364              
365              
366             =head1 LICENCE
367              
368             You can redistribute it and/or modify it under the conditions of
369             LGPL and Artistic Licence.
370              
371              
372             =head1 AUTHOR
373              
374             Andreas Hernitscheck - ahernit AT cpan.org
375              
376              
377              
378             =cut
379