File: nytprofcg

package info (click to toggle)
libdevel-nytprof-perl 4.04-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 2,124 kB
  • ctags: 1,330
  • sloc: perl: 4,392; ansic: 92; makefile: 19
file content (141 lines) | stat: -rwxr-xr-x 4,233 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
#!/usr/bin/perl
##########################################################
## This script is part of the Devel::NYTProf distribution
## Released under the same terms as Perl 5.8.0
## See http://search.cpan.org/dist/Devel-NYTProf/
##
##########################################################
# $Id: /mirror/devel-nytprof/bin/nytprofhtml 13295 2009-04-06T20:34:49.946854Z tim.bunce  $
###########################################################
use warnings;
use strict;

use Getopt::Long;

use Devel::NYTProf::Data;


my %opt = (
    file => 'nytprof.out',
    out  => 'nytprof.callgrind',
);

GetOptions( \%opt, qw/file|f=s out|o=s help|h/ )
    or usage();

usage() if $opt{help};


print "Reading $opt{file} ...\n";

my $profile = Devel::NYTProf::Data->new( { filename => $opt{file},
                                           quiet => 1 } );

print "Writing $opt{out} ...\n";

# calltree format specification
# http://kcachegrind.sourceforge.net/cgi-bin/show.cgi/KcacheGrindCalltreeFormat

open my $fh, '>', $opt{out}
    or die "Can't write to $opt{out}: $!\n";

print $fh "events: Ticks".$/;
print $fh $/;


my %callmap;
my $subname_subinfo_map = $profile->subname_subinfo_map;

for my $sub (values %$subname_subinfo_map) {

    my $callers = $sub->caller_fid_line_places;
    next unless ($callers && %$callers);

    my $fi = eval { $sub->fileinfo };

    print $fh 'fl='.( $fi ? $fi->filename : "Unknown").$/;
    print $fh 'fn='.$sub->subname.$/;
    print $fh join(' ',$sub->first_line, int($sub->excl_time * 1_000_000)).$/;
    print $fh $/;

    my @callers;
    while ( my ( $fid, $fid_line_info ) = each %$callers ) {
        for my $line ( keys %$fid_line_info ) {
            my ( $count, $incl_time, $excl_time, undef, undef, undef,
                undef, $calling_subs) = @{ $fid_line_info->{$line} };

            my @subnames = sort keys %$calling_subs;

            ref $_ and $_ = sprintf "%s (merge of %d subs)", $_->[0], scalar @$_
                for @subnames;
            my $subname = (@subnames) ? join( " or ", @subnames ) : "__main";

            my $fi        = $profile->fileinfo_of($fid);
            my $filename  = $fi->filename($fid);
            my $line_desc = "line $line of $filename";

            # chase string eval chain back to a real file
            while ( my ( $outer_fileinfo, $outer_line ) = $fi->outer ) {
                ( $filename, $line ) = ( $outer_fileinfo->filename, $outer_line );
                $line_desc .= sprintf " at line %s of %s", $line, $filename;
                $fi = $outer_fileinfo;
            }

            push @{ $callmap{$subname} }, [ $filename, $line, $sub, $count, $incl_time, $excl_time ];
        }
    }

}

for (keys %callmap) {
    for my $entry (@{$callmap{$_}}) {
        my ($filename, $line, $sub, $count, $incl_time, $excl_time) = @$entry;
        print $fh "fl=$filename$/";
        print $fh 'fn='.$_.$/;
        print $fh "cfl=".(eval { $sub->fileinfo->filename } || 'Unknown').$/;
        print $fh "cfn=".$sub->subname.$/;
        # calls=(Call Count) (Destination position)
        # (Source position) (Inclusive cost of call)
        print $fh "calls=$count ".$sub->first_line.$/;
        print $fh "$line ".int(1_000_000 * $incl_time).$/;
        print $fh $/;
    }
}

sub usage {
    print <<END;
usage: [perl] nytprofcg [opts]
 --file <file>, -f <file>  Specify NYTProf data file [default: nytprof.out]
 --out <file>,  -o <file>  Specify output file [default: nytprof.callgrind]
 --help,        -h         Print this message

This script of part of the Devel::NYTProf distribution.
Released under the same terms as Perl 5.8.0
See http://search.cpan.org/dist/Devel-NYTProf/
END
    exit 1;
}

__END__

=head1 NAME

nytprofcg - Convert an NYTProf profile into Callgrind format

=head1 SYNOPSIS

 $ nytprofcg --file=nytprof.out --out=nytprof.callgrind

 $ nytprofcg    # same as above

=head1 DESCRIPTION

Reads a profile data file generated by Devel::NYTProf and writes out the
subroutine call graph information it contains in Callgrind format.

The output Callgrind file can be loaded into the C<kcachegrind> GUI for
interactive exploration. 

For more information see L<http://kcachegrind.sourceforge.net/html/Home.html>

=cut