Profile of YAML/Base.pm

Filename	/usr/share/perl5/YAML/Base.pm
Statements	Executed 1017 statements in 5.46ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
21	21	2	2.70ms	4.25ms	YAML::Base::::fieldYAML::Base::field
64	2	1	764µs	764µs	YAML::Base::::newYAML::Base::new
21	1	1	296µs	296µs	YAML::Base::::__ANON__[:162]YAML::Base::__ANON__[:162]
17	1	1	276µs	1.25ms	YAML::Base::::__ANON__[:172]YAML::Base::__ANON__[:172]
34	2	1	110µs	110µs	YAML::Base::::CORE:substYAML::Base::CORE:subst (opcode)
1	1	1	18µs	44µs	YAML::Base::::BEGIN@165YAML::Base::BEGIN@165
1	1	1	18µs	22µs	YAML::Base::::BEGIN@3YAML::Base::BEGIN@3
1	1	1	13µs	36µs	YAML::Base::::BEGIN@75YAML::Base::BEGIN@75
1	1	1	10µs	22µs	YAML::Base::::BEGIN@4YAML::Base::BEGIN@4
1	1	1	9µs	9µs	YAML::Base::::BEGIN@5YAML::Base::BEGIN@5
0	0	0	0s	0s	YAML::Base::::XXXYAML::Base::XXX
0	0	0	0s	0s	YAML::Base::::__ANON__[:124]YAML::Base::__ANON__[:124]
0	0	0	0s	0s	YAML::Base::::__ANON__[:133]YAML::Base::__ANON__[:133]
0	0	0	0s	0s	YAML::Base::::__ANON__[:146]YAML::Base::__ANON__[:146]
0	0	0	0s	0s	YAML::Base::::dieYAML::Base::die
0	0	0	0s	0s	YAML::Base::::node_infoYAML::Base::node_info
0	0	0	0s	0s	YAML::Base::::warnYAML::Base::warn

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

Line	State ments	Time on line	Calls	Time in subs	Code
1					package YAML::Base;
2
3	3	27µs	2	25µs	# spent 22µs (18+4) within YAML::Base::BEGIN@3 which was called: # once (18µs+4µs) by YAML::BEGIN@6 at line 3 use strict; # spent 22µs making 1 call to YAML::Base::BEGIN@3 # spent 4µs making 1 call to strict::import
4	3	34µs	2	34µs	# spent 22µs (10+12) within YAML::Base::BEGIN@4 which was called: # once (10µs+12µs) by YAML::BEGIN@6 at line 4 use warnings; # spent 22µs making 1 call to YAML::Base::BEGIN@4 # spent 12µs making 1 call to warnings::import
5	3	401µs	1	9µs	# spent 9µs within YAML::Base::BEGIN@5 which was called: # once (9µs+0s) by YAML::BEGIN@6 at line 5 use Exporter (); # spent 9µs making 1 call to YAML::Base::BEGIN@5
6
7	1	800ns			our $VERSION = '0.71';
8	1	12µs			our @ISA = 'Exporter';
9	1	800ns			our @EXPORT = qw(field XXX);
10
11					# spent 764µs within YAML::Base::new which was called 64 times, avg 12µs/call: # 32 times (526µs+0s) by YAML::Load at line 33 of YAML.pm, avg 16µs/call # 32 times (239µs+0s) by YAML::init_action_object at line 87 of YAML.pm, avg 7µs/call sub new {
12	64	61µs			my $class = shift;
13	64	45µs			$class = ref($class) \|\| $class;
14	64	332µs			my $self = bless {}, $class;
15	64	84µs			while (@_) {
16					my $method = shift;
17					$self->$method(shift);
18					}
19	64	322µs			return $self;
20					}
21
22					# Use lexical subs to reduce pollution of private methods by base class.
23	1	500ns			my ($_new_error, $_info, $_scalar_info, $parse_arguments, $default_as_code);
24
25					sub XXX {
26					require Data::Dumper;
27					CORE::die(Data::Dumper::Dumper(@_));
28					}
29
30	1	6µs			my %code = (
31					sub_start =>
32					"sub {\n",
33					set_default =>
34					" \$_[0]->{%s} = %s\n unless exists \$_[0]->{%s};\n",
35					init =>
36					" return \$_[0]->{%s} = do { my \$self = \$_[0]; %s }\n" .
37					" unless \$#_ > 0 or defined \$_[0]->{%s};\n",
38					return_if_get =>
39					" return \$_[0]->{%s} unless \$#_ > 0;\n",
40					set =>
41					" \$_[0]->{%s} = \$_[1];\n",
42					sub_end =>
43					" return \$_[0]->{%s};\n}\n",
44					);
45
46					# spent 4.25ms (2.70+1.55) within YAML::Base::field which was called 21 times, avg 202µs/call: # once (254µs+191µs) by YAML::Loader::BEGIN@6 at line 10 of YAML/Loader/Base.pm # once (150µs+196µs) by C4::Search::BEGIN@34 at line 18 of YAML.pm # once (192µs+104µs) by YAML::Loader::BEGIN@6 at line 13 of YAML/Loader/Base.pm # once (131µs+112µs) by YAML::Loader::BEGIN@6 at line 17 of YAML/Loader/Base.pm # once (125µs+91µs) by YAML::Loader::BEGIN@6 at line 16 of YAML/Loader/Base.pm # once (137µs+65µs) by C4::Search::BEGIN@34 at line 20 of YAML.pm # once (134µs+66µs) by C4::Search::BEGIN@34 at line 22 of YAML.pm # once (113µs+75µs) by C4::Search::BEGIN@34 at line 19 of YAML.pm # once (115µs+70µs) by YAML::Loader::BEGIN@6 at line 11 of YAML/Loader/Base.pm # once (121µs+64µs) by YAML::Loader::BEGIN@6 at line 22 of YAML/Loader/Base.pm # once (110µs+68µs) by YAML::Loader::BEGIN@6 at line 21 of YAML/Loader/Base.pm # once (108µs+69µs) by YAML::Loader::BEGIN@6 at line 19 of YAML/Loader/Base.pm # once (107µs+70µs) by YAML::Loader::BEGIN@6 at line 23 of YAML/Loader/Base.pm # once (109µs+66µs) by YAML::Loader::BEGIN@6 at line 25 of YAML/Loader/Base.pm # once (110µs+65µs) by YAML::Loader::BEGIN@6 at line 12 of YAML/Loader/Base.pm # once (109µs+64µs) by YAML::Loader::BEGIN@6 at line 26 of YAML/Loader/Base.pm # once (108µs+64µs) by YAML::Loader::BEGIN@6 at line 24 of YAML/Loader/Base.pm # once (149µs+13µs) by YAML::Loader::BEGIN@6 at line 20 of YAML/Loader/Base.pm # once (110µs+14µs) by YAML::Loader::BEGIN@6 at line 14 of YAML/Loader/Base.pm # once (107µs+13µs) by YAML::Loader::BEGIN@6 at line 18 of YAML/Loader/Base.pm # once (100µs+12µs) by YAML::Loader::BEGIN@6 at line 15 of YAML/Loader/Base.pm sub field {
47	21	18µs			my $package = caller;
48	21	110µs	21	296µs	my ($args, @values) = &$parse_arguments( # spent 296µs making 21 calls to YAML::Base::__ANON__[YAML/Base.pm:162], avg 14µs/call
49					[ qw(-package -init) ],
50					@_,
51					);
52	21	13µs			my ($field, $default) = @values;
53	21	21µs			$package = $args->{-package} if defined $args->{-package};
54	21	35µs			return if defined &{"${package}::$field"};
55	21	52µs	17	1.25ms	my $default_string = # spent 1.25ms making 17 calls to YAML::Base::__ANON__[YAML/Base.pm:172], avg 74µs/call
56					( ref($default) eq 'ARRAY' and not @$default )
57					? '[]'
58					: (ref($default) eq 'HASH' and not keys %$default )
59					? '{}'
60					: &$default_as_code($default);
61
62	21	20µs			my $code = $code{sub_start};
63	21	22µs			if ($args->{-init}) {
64	2	2µs			my $fragment = $code{init};
65	2	8µs			$code .= sprintf $fragment, $field, $args->{-init}, ($field) x 4;
66					}
67	21	53µs			$code .= sprintf $code{set_default}, $field, $default_string, $field
68					if defined $default;
69	21	24µs			$code .= sprintf $code{return_if_get}, $field;
70	21	19µs			$code .= sprintf $code{set}, $field;
71	21	17µs			$code .= sprintf $code{sub_end}, $field;
72
73	21	1.90ms			my $sub = eval $code; # spent 1.72ms executing statements in string eval # includes 1.34ms spent executing 288 calls to 1 sub defined therein. # spent 1.03ms executing statements in string eval # includes 836µs spent executing 128 calls to 1 sub defined therein. # spent 867µs executing statements in string eval # includes 743µs spent executing 96 calls to 1 sub defined therein. # spent 832µs executing statements in string eval # includes 617µs spent executing 64 calls to 1 sub defined therein. # spent 675µs executing statements in string eval # includes 668µs spent executing 32 calls to 1 sub defined therein. # spent 616µs executing statements in string eval # includes 532µs spent executing 64 calls to 1 sub defined therein. # spent 563µs executing statements in string eval # includes 473µs spent executing 64 calls to 1 sub defined therein. # spent 372µs executing statements in string eval # includes 343µs spent executing 32 calls to 1 sub defined therein. # spent 11µs executing statements in string eval # spent 9µs executing statements in string eval # spent 9µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 6µs executing statements in string eval # spent 6µs executing statements in string eval # spent 6µs executing statements in string eval # spent 6µs executing statements in string eval # spent 6µs executing statements in string eval # spent 6µs executing statements in string eval # spent 6µs executing statements in string eval # spent 5µs executing statements in string eval
74	21	7µs			die $@ if $@;
75	3	708µs	2	59µs	# spent 36µs (13+23) within YAML::Base::BEGIN@75 which was called: # once (13µs+23µs) by YAML::BEGIN@6 at line 75 no strict 'refs'; # spent 36µs making 1 call to YAML::Base::BEGIN@75 # spent 23µs making 1 call to strict::unimport
76	21	89µs			*{"${package}::$field"} = $sub;
77	21	147µs			return $code if defined wantarray;
78					}
79
80					sub die {
81					my $self = shift;
82					my $error = $self->$_new_error(@_);
83					$error->type('Error');
84					Carp::croak($error->format_message);
85					}
86
87					sub warn {
88					my $self = shift;
89					return unless $^W;
90					my $error = $self->$_new_error(@_);
91					$error->type('Warning');
92					Carp::cluck($error->format_message);
93					}
94
95					# This code needs to be refactored to be simpler and more precise, and no,
96					# Scalar::Util doesn't DWIM.
97					#
98					# Can't handle:
99					# * blessed regexp
100					sub node_info {
101					my $self = shift;
102					my $stringify = $_[1] \|\| 0;
103					my ($class, $type, $id) =
104					ref($_[0])
105					? $stringify
106					? &$_info("$_[0]")
107					: do {
108					require overload;
109					my @info = &$_info(overload::StrVal($_[0]));
110					if (ref($_[0]) eq 'Regexp') {
111					@info[0, 1] = (undef, 'REGEXP');
112					}
113					@info;
114					}
115					: &$_scalar_info($_[0]);
116					($class, $type, $id) = &$_scalar_info("$_[0]")
117					unless $id;
118					return wantarray ? ($class, $type, $id) : $id;
119					}
120
121					#-------------------------------------------------------------------------------
122					$_info = sub {
123					return (($_[0]) =~ qr{^(?:(.)\=)?([^=])$([^\(]*)$$}o);
124	1	2µs			};
125
126					$_scalar_info = sub {
127					my $id = 'undef';
128					if (defined $_[0]) {
129					\$_[0] =~ /$(\w+)$$/o or CORE::die();
130					$id = "$1-S";
131					}
132					return (undef, undef, $id);
133	1	2µs			};
134
135					$_new_error = sub {
136					require Carp;
137					my $self = shift;
138					require YAML::Error;
139
140					my $code = shift \|\| 'unknown error';
141					my $error = YAML::Error->new(code => $code);
142					$error->line($self->line) if $self->can('line');
143					$error->document($self->document) if $self->can('document');
144					$error->arguments([@_]);
145					return $error;
146	1	2µs			};
147
148					# spent 296µs within YAML::Base::__ANON__[/usr/share/perl5/YAML/Base.pm:162] which was called 21 times, avg 14µs/call: # 21 times (296µs+0s) by YAML::Base::field at line 48, avg 14µs/call $parse_arguments = sub {
149	21	15µs			my $paired_arguments = shift \|\| [];
150	21	24µs			my ($args, @values) = ({}, ());
151	21	81µs			my %pairs = map { ($_, 1) } @$paired_arguments;
152	21	14µs			while (@_) {
153	42	17µs			my $elem = shift;
154	42	58µs			if (defined $elem and defined $pairs{$elem} and @_) {
155					$args->{$elem} = shift;
156					}
157					else {
158	40	23µs			push @values, $elem;
159					}
160					}
161	21	97µs			return wantarray ? ($args, @values) : $args;
162	1	2µs			};
163
164					# spent 1.25ms (276µs+979µs) within YAML::Base::__ANON__[/usr/share/perl5/YAML/Base.pm:172] which was called 17 times, avg 74µs/call: # 17 times (276µs+979µs) by YAML::Base::field at line 55, avg 74µs/call $default_as_code = sub {
165	3	119µs	2	70µs	# spent 44µs (18+26) within YAML::Base::BEGIN@165 which was called: # once (18µs+26µs) by YAML::BEGIN@6 at line 165 no warnings 'once'; # spent 44µs making 1 call to YAML::Base::BEGIN@165 # spent 26µs making 1 call to warnings::unimport
166	17	14µs			require Data::Dumper;
167	17	11µs			local $Data::Dumper::Sortkeys = 1;
168	17	118µs	17	869µs	my $code = Data::Dumper::Dumper(shift); # spent 869µs making 17 calls to Data::Dumper::Dumper, avg 51µs/call
169	17	127µs	17	76µs	$code =~ s/^\$VAR1 = //; # spent 76µs making 17 calls to YAML::Base::CORE:subst, avg 4µs/call
170	17	68µs	17	34µs	$code =~ s/;$//; # spent 34µs making 17 calls to YAML::Base::CORE:subst, avg 2µs/call
171	17	56µs			return $code;
172	1	2µs			};
173
174	1	9µs			1;
175
176					__END__

					# spent 110µs within YAML::Base::CORE:subst which was called 34 times, avg 3µs/call: # 17 times (76µs+0s) by YAML::Base::__ANON__[/usr/share/perl5/YAML/Base.pm:172] at line 169, avg 4µs/call # 17 times (34µs+0s) by YAML::Base::__ANON__[/usr/share/perl5/YAML/Base.pm:172] at line 170, avg 2µs/call sub YAML::Base::CORE:subst; # opcode