← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:11 2010

File /usr/share/perl5/YAML/Base.pm
Statements Executed 158
Total Time 0.0023892 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
4116.11ms6.67msYAML::Base::::__ANON__[:168]YAML::Base::__ANON__[:168]
441592µs7.36msYAML::Base::::fieldYAML::Base::field
41196µs96µsYAML::Base::::__ANON__[:158]YAML::Base::__ANON__[:158]
0000s0sYAML::Base::::BEGINYAML::Base::BEGIN
0000s0sYAML::Base::::XXXYAML::Base::XXX
0000s0sYAML::Base::::__ANON__[:120]YAML::Base::__ANON__[:120]
0000s0sYAML::Base::::__ANON__[:129]YAML::Base::__ANON__[:129]
0000s0sYAML::Base::::__ANON__[:142]YAML::Base::__ANON__[:142]
0000s0sYAML::Base::::dieYAML::Base::die
0000s0sYAML::Base::::newYAML::Base::new
0000s0sYAML::Base::::node_infoYAML::Base::node_info
0000s0sYAML::Base::::warnYAML::Base::warn
LineStmts.Exclusive
Time
Avg.Code
1package YAML::Base;
2643µs7µsuse strict; use warnings;
# spent 23µs making 1 call to warnings::import # spent 6µs making 1 call to strict::import
33542µs181µsuse base 'Exporter';
# spent 1.01ms making 1 call to base::import
4
512µs2µsour @EXPORT = qw(field XXX);
6
7sub new {
8 my $class = shift;
9 $class = ref($class) || $class;
10 my $self = bless {}, $class;
11 while (@_) {
12 my $method = shift;
13 $self->$method(shift);
14 }
15 return $self;
16}
17
18# Use lexical subs to reduce pollution of private methods by base class.
191500ns500nsmy ($_new_error, $_info, $_scalar_info, $parse_arguments, $default_as_code);
20
21sub XXX {
22 require Data::Dumper;
23 CORE::die(Data::Dumper::Dumper(@_));
24}
25
2617µs7µsmy %code = (
27 sub_start =>
28 "sub {\n",
29 set_default =>
30 " \$_[0]->{%s} = %s\n unless exists \$_[0]->{%s};\n",
31 init =>
32 " return \$_[0]->{%s} = do { my \$self = \$_[0]; %s }\n" .
33 " unless \$#_ > 0 or defined \$_[0]->{%s};\n",
34 return_if_get =>
35 " return \$_[0]->{%s} unless \$#_ > 0;\n",
36 set =>
37 " \$_[0]->{%s} = \$_[1];\n",
38 sub_end =>
39 " return \$_[0]->{%s};\n}\n",
40);
41
42
# spent 7.36ms (592µs+6.77) within YAML::Base::field which was called 4 times, avg 1.84ms/call: # once (162µs+6.49ms) at line 15 of /usr/share/perl5/YAML.pm # once (157µs+88µs) at line 17 of /usr/share/perl5/YAML.pm # once (147µs+85µs) at line 19 of /usr/share/perl5/YAML.pm # once (127µs+103µs) at line 16 of /usr/share/perl5/YAML.pm
sub field {
4343µs775ns my $package = caller;
44428µs7µs my ($args, @values) = &$parse_arguments(
# spent 96µs making 4 calls to YAML::Base::__ANON__[/usr/share/perl5/YAML/Base.pm:158], avg 24µs/call
45 [ qw(-package -init) ],
46 @_,
47 );
4843µs750ns my ($field, $default) = @values;
4946µs2µs $package = $args->{-package} if defined $args->{-package};
5047µs2µs return if defined &{"${package}::$field"};
51424µs6µs my $default_string =
# spent 6.67ms making 4 calls to YAML::Base::__ANON__[/usr/share/perl5/YAML/Base.pm:168], avg 1.67ms/call
52 ( ref($default) eq 'ARRAY' and not @$default )
53 ? '[]'
54 : (ref($default) eq 'HASH' and not keys %$default )
55 ? '{}'
56 : &$default_as_code($default);
57
5844µs1µs my $code = $code{sub_start};
59415µs4µs if ($args->{-init}) {
6022µs1µs my $fragment = $code{init};
6128µs4µs $code .= sprintf $fragment, $field, $args->{-init}, ($field) x 4;
62 }
6348µs2µs $code .= sprintf $code{set_default}, $field, $default_string, $field
64 if defined $default;
6548µs2µs $code .= sprintf $code{return_if_get}, $field;
6645µs1µs $code .= sprintf $code{set}, $field;
6745µs1µs $code .= sprintf $code{sub_end}, $field;
68
694443µs111µs my $sub = eval $code;
7041µs350ns die $@ if $@;
713749µs250µs no strict 'refs';
# spent 32µs making 1 call to strict::unimport
72418µs4µs *{"${package}::$field"} = $sub;
73410µs2µs return $code if defined wantarray;
74}
75
76sub die {
77 my $self = shift;
78 my $error = $self->$_new_error(@_);
79 $error->type('Error');
80 Carp::croak($error->format_message);
81}
82
83sub warn {
84 my $self = shift;
85 return unless $^W;
86 my $error = $self->$_new_error(@_);
87 $error->type('Warning');
88 Carp::cluck($error->format_message);
89}
90
91# This code needs to be refactored to be simpler and more precise, and no,
92# Scalar::Util doesn't DWIM.
93#
94# Can't handle:
95# * blessed regexp
96sub node_info {
97 my $self = shift;
98 my $stringify = $_[1] || 0;
99 my ($class, $type, $id) =
100 ref($_[0])
101 ? $stringify
102 ? &$_info("$_[0]")
103 : do {
104 require overload;
105 my @info = &$_info(overload::StrVal($_[0]));
106 if (ref($_[0]) eq 'Regexp') {
107 @info[0, 1] = (undef, 'REGEXP');
108 }
109 @info;
110 }
111 : &$_scalar_info($_[0]);
112 ($class, $type, $id) = &$_scalar_info("$_[0]")
113 unless $id;
114 return wantarray ? ($class, $type, $id) : $id;
115}
116
117#-------------------------------------------------------------------------------
118$_info = sub {
119 return (($_[0]) =~ qr{^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$}o);
12013µs3µs};
121
122$_scalar_info = sub {
123 my $id = 'undef';
124 if (defined $_[0]) {
125 \$_[0] =~ /\((\w+)\)$/o or CORE::die();
126 $id = "$1-S";
127 }
128 return (undef, undef, $id);
12913µs3µs};
130
131$_new_error = sub {
132 require Carp;
133 my $self = shift;
134 require YAML::Error;
135
136 my $code = shift || 'unknown error';
137 my $error = YAML::Error->new(code => $code);
138 $error->line($self->line) if $self->can('line');
139 $error->document($self->document) if $self->can('document');
140 $error->arguments([@_]);
141 return $error;
142115µs15µs};
143
144
# spent 96µs within YAML::Base::__ANON__[/usr/share/perl5/YAML/Base.pm:158] which was called 4 times, avg 24µs/call: # 4 times (96µs+0s) by YAML::Base::field at line 44, avg 24µs/call
$parse_arguments = sub {
14544µs1µs my $paired_arguments = shift || [];
14645µs1µs my ($args, @values) = ({}, ());
147419µs5µs my %pairs = map { ($_, 1) } @$paired_arguments;
14843µs725ns while (@_) {
14984µs462ns my $elem = shift;
150828µs4µs if (defined $elem and defined $pairs{$elem} and @_) {
151 $args->{$elem} = shift;
152 }
153 else {
15465µs817ns push @values, $elem;
155 }
156 }
157418µs4µs return wantarray ? ($args, @values) : $args;
15815µs5µs};
159
160
# spent 6.67ms (6.11+561µs) within YAML::Base::__ANON__[/usr/share/perl5/YAML/Base.pm:168] which was called 4 times, avg 1.67ms/call: # 4 times (6.11ms+561µs) by YAML::Base::field at line 51, avg 1.67ms/call
$default_as_code = sub {
1613111µs37µs no warnings 'once';
# spent 24µs making 1 call to warnings::unimport
1624132µs33µs require Data::Dumper;
16342µs525ns local $Data::Dumper::Sortkeys = 1;
164428µs7µs my $code = Data::Dumper::Dumper(shift);
# spent 268µs making 4 calls to Data::Dumper::Dumper, avg 67µs/call
165432µs8µs $code =~ s/^\$VAR1 = //;
16646µs2µs $code =~ s/;$//;
167411µs3µs return $code;
16812µs2µs};
169
170110µs10µs1;
171
172__END__
173
174=head1 NAME
175
176YAML::Base - Base class for YAML classes
177
178=head1 SYNOPSIS
179
180 package YAML::Something;
181 use YAML::Base -base;
182
183=head1 DESCRIPTION
184
185YAML::Base is the parent of all YAML classes.
186
187=head1 AUTHOR
188
189Ingy döt Net <ingy@cpan.org>
190
191=head1 COPYRIGHT
192
193Copyright (c) 2006. Ingy döt Net. All rights reserved.
194
195This program is free software; you can redistribute it and/or modify it
196under the same terms as Perl itself.
197
198See L<http://www.perl.com/perl/misc/Artistic.html>
199
200=cut