Profile of Devel/StackTrace/Frame.pm

← Index
NYTProf Performance Profile «line view»
For script/ponapi
Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:11 2016

Filename | /usr/local/share/perl/5.18.2/Devel/StackTrace/Frame.pm
Statements | Executed 32 statements in 610µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 31µs | 31µs | Devel::StackTrace::Frame::::BEGIN@7Devel::StackTrace::Frame::BEGIN@7
1 | 1 | 1 | 9µs | 18µs | Devel::StackTrace::Frame::::BEGIN@3Devel::StackTrace::Frame::BEGIN@3
1 | 1 | 1 | 8µs | 17µs | Devel::StackTrace::Frame::::BEGIN@8Devel::StackTrace::Frame::BEGIN@8
1 | 1 | 1 | 6µs | 9µs | Devel::StackTrace::Frame::::BEGIN@4Devel::StackTrace::Frame::BEGIN@4
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::Frame::::__ANON__[:14]Devel::StackTrace::Frame::__ANON__[:14]
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::Frame::::argsDevel::StackTrace::Frame::args
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::Frame::::as_stringDevel::StackTrace::Frame::as_string
0 | 0 | 0 | 0s | 0s | Devel::StackTrace::Frame::::newDevel::StackTrace::Frame::new

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Devel::StackTrace::Frame;
2 | 1 | 500ns |  |  | $Devel::StackTrace::Frame::VERSION = '2.00';
3 | 2 | 19µs | 2 | 26µs | # spent 18µs (9+9) within Devel::StackTrace::Frame::BEGIN@3 which was called: # once (9µs+9µs) by Devel::StackTrace::BEGIN@10 at line 3 use strict; # spent 18µs making 1 call to Devel::StackTrace::Frame::BEGIN@3 # spent 9µs making 1 call to strict::import
4 | 2 | 34µs | 2 | 12µs | # spent 9µs (6+3) within Devel::StackTrace::Frame::BEGIN@4 which was called: # once (6µs+3µs) by Devel::StackTrace::BEGIN@10 at line 4 use warnings; # spent 9µs making 1 call to Devel::StackTrace::Frame::BEGIN@4 # spent 3µs making 1 call to warnings::import
5 |  |  |  |  |
6 |  |  |  |  | # Create accessor routines
7 |  |  |  |  | # spent 31µs within Devel::StackTrace::Frame::BEGIN@7 which was called: # once (31µs+0s) by Devel::StackTrace::BEGIN@10 at line 16 BEGIN {
8 | 2 | 66µs | 2 | 26µs | # spent 17µs (8+9) within Devel::StackTrace::Frame::BEGIN@8 which was called: # once (8µs+9µs) by Devel::StackTrace::BEGIN@10 at line 8 no strict 'refs'; # spent 17µs making 1 call to Devel::StackTrace::Frame::BEGIN@8 # spent 9µs making 1 call to strict::unimport
9 | 1 | 4µs |  |  | foreach my $f (
10 |  |  |  |  | qw( package filename line subroutine hasargs
11 |  |  |  |  | wantarray evaltext is_require hints bitmask args )
12 |  |  |  |  | ) {
13 | 11 | 2µs |  |  | next if $f eq 'args';
14 | 10 | 25µs |  |  | *{$f} = sub { my $s = shift; return $s->{$f} };
15 |  |  |  |  | }
16 | 1 | 454µs | 1 | 31µs | } # spent 31µs making 1 call to Devel::StackTrace::Frame::BEGIN@7
17 |  |  |  |  |
18 |  |  |  |  | {
19 | 2 | 2µs |  |  | my @fields = (
20 |  |  |  |  | qw( package filename line subroutine hasargs wantarray
21 |  |  |  |  | evaltext is_require hints bitmask )
22 |  |  |  |  | );
23 |  |  |  |  |
24 |  |  |  |  | sub new {
25 |  |  |  |  | my $proto = shift;
26 |  |  |  |  | my $class = ref $proto || $proto;
27 |  |  |  |  |
28 |  |  |  |  | my $self = bless {}, $class;
29 |  |  |  |  |
30 |  |  |  |  | @{$self}{@fields} = @{ shift() };
31 |  |  |  |  |
32 |  |  |  |  | # fixup unix-style paths on win32
33 |  |  |  |  | $self->{filename} = File::Spec->canonpath( $self->{filename} );
34 |  |  |  |  |
35 |  |  |  |  | $self->{args} = shift;
36 |  |  |  |  |
37 |  |  |  |  | $self->{respect_overload} = shift;
38 |  |  |  |  |
39 |  |  |  |  | $self->{max_arg_length} = shift;
40 |  |  |  |  |
41 |  |  |  |  | $self->{message} = shift;
42 |  |  |  |  |
43 |  |  |  |  | $self->{indent} = shift;
44 |  |  |  |  |
45 |  |  |  |  | return $self;
46 |  |  |  |  | }
47 |  |  |  |  | }
48 |  |  |  |  |
49 |  |  |  |  | sub args {
50 |  |  |  |  | my $self = shift;
51 |  |  |  |  |
52 |  |  |  |  | return @{ $self->{args} };
53 |  |  |  |  | }
54 |  |  |  |  |
55 |  |  |  |  | sub as_string {
56 |  |  |  |  | my $self = shift;
57 |  |  |  |  | my $first = shift;
58 |  |  |  |  | my $p = shift;
59 |  |  |  |  |
60 |  |  |  |  | my $sub = $self->subroutine;
61 |  |  |  |  |
62 |  |  |  |  | # This code stolen straight from Carp.pm and then tweaked. All
63 |  |  |  |  | # errors are probably my fault -dave
64 |  |  |  |  | if ($first) {
65 |  |  |  |  | $sub
66 |  |  |  |  | = defined $self->{message}
67 |  |  |  |  | ? $self->{message}
68 |  |  |  |  | : 'Trace begun';
69 |  |  |  |  | }
70 |  |  |  |  | else {
71 |  |  |  |  |
72 |  |  |  |  | # Build a string, $sub, which names the sub-routine called.
73 |  |  |  |  | # This may also be "require ...", "eval '...' or "eval {...}"
74 |  |  |  |  | if ( my $eval = $self->evaltext ) {
75 |  |  |  |  | if ( $self->is_require ) {
76 |  |  |  |  | $sub = "require $eval";
77 |  |  |  |  | }
78 |  |  |  |  | else {
79 |  |  |  |  | $eval =~ s/([\\\'])/\\$1/g;
80 |  |  |  |  | $sub = "eval '$eval'";
81 |  |  |  |  | }
82 |  |  |  |  | }
83 |  |  |  |  | elsif ( $sub eq '(eval)' ) {
84 |  |  |  |  | $sub = 'eval {...}';
85 |  |  |  |  | }
86 |  |  |  |  |
87 |  |  |  |  | # if there are any arguments in the sub-routine call, format
88 |  |  |  |  | # them according to the format variables defined earlier in
89 |  |  |  |  | # this file and join them onto the $sub sub-routine string
90 |  |  |  |  | #
91 |  |  |  |  | # We copy them because they're going to be modified.
92 |  |  |  |  | #
93 |  |  |  |  | if ( my @a = $self->args ) {
94 |  |  |  |  | for (@a) {
95 |  |  |  |  |
96 |  |  |  |  | # set args to the string "undef" if undefined
97 |  |  |  |  | $_ = "undef", next unless defined $_;
98 |  |  |  |  |
99 |  |  |  |  | # hack!
100 |  |  |  |  | $_ = $self->Devel::StackTrace::_ref_to_string($_)
101 |  |  |  |  | if ref $_;
102 |  |  |  |  |
103 |  |  |  |  | local $SIG{__DIE__};
104 |  |  |  |  | local $@;
105 |  |  |  |  |
106 |  |  |  |  | eval {
107 |  |  |  |  | my $max_arg_length
108 |  |  |  |  | = exists $p->{max_arg_length}
109 |  |  |  |  | ? $p->{max_arg_length}
110 |  |  |  |  | : $self->{max_arg_length};
111 |  |  |  |  |
112 |  |  |  |  | if ( $max_arg_length
113 |  |  |  |  | && length $_ > $max_arg_length ) {
114 |  |  |  |  | substr( $_, $max_arg_length ) = '...';
115 |  |  |  |  | }
116 |  |  |  |  |
117 |  |  |  |  | s/'/\\'/g;
118 |  |  |  |  |
119 |  |  |  |  | # 'quote' arg unless it looks like a number
120 |  |  |  |  | $_ = "'$_'" unless /^-?[\d.]+$/;
121 |  |  |  |  |
122 |  |  |  |  | # print control/high ASCII chars as 'M-<char>' or '^<char>'
123 |  |  |  |  | s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
124 |  |  |  |  | s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
125 |  |  |  |  | };
126 |  |  |  |  |
127 |  |  |  |  | if ( my $e = $@ ) {
128 |  |  |  |  | $_ = $e =~ /malformed utf-8/i ? '(bad utf-8)' : '?';
129 |  |  |  |  | }
130 |  |  |  |  | }
131 |  |  |  |  |
132 |  |  |  |  | # append ('all', 'the', 'arguments') to the $sub string
133 |  |  |  |  | $sub .= '(' . join( ', ', @a ) . ')';
134 |  |  |  |  | $sub .= ' called';
135 |  |  |  |  | }
136 |  |  |  |  | }
137 |  |  |  |  |
138 |  |  |  |  | # If the user opted into indentation (a la Carp::confess), pre-add a tab
139 |  |  |  |  | my $tab = $self->{indent} && !$first ? "\t" : q{};
140 |  |  |  |  |
141 |  |  |  |  | return "${tab}$sub at " . $self->filename . ' line ' . $self->line;
142 |  |  |  |  | }
143 |  |  |  |  |
144 | 1 | 3µs |  |  | 1;
145 |  |  |  |  |
146 |  |  |  |  | # ABSTRACT: A single frame in a stack trace
147 |  |  |  |  |
148 |  |  |  |  | __END__