Profile of YAML/Base.pm

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

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
21	21	2	3.63ms	5.73ms	YAML::Base::::fieldYAML::Base::field
64	2	1	720µs	720µs	YAML::Base::::newYAML::Base::new
21	1	1	427µs	427µs	YAML::Base::::__ANON__[:162]YAML::Base::__ANON__[:162]
17	1	1	368µs	1.67ms	YAML::Base::::__ANON__[:172]YAML::Base::__ANON__[:172]
34	2	1	130µs	130µs	YAML::Base::::CORE:substYAML::Base::CORE:subst (opcode)
1	1	1	18µs	42µs	YAML::Base::::BEGIN@4YAML::Base::BEGIN@4
1	1	1	18µs	22µs	YAML::Base::::BEGIN@3YAML::Base::BEGIN@3
1	1	1	16µs	41µs	YAML::Base::::BEGIN@165YAML::Base::BEGIN@165
1	1	1	15µs	35µs	YAML::Base::::BEGIN@75YAML::Base::BEGIN@75
1	1	1	5µs	5µ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	35µs	2	26µ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	40µs	2	66µs	# spent 42µs (18+24) within YAML::Base::BEGIN@4 which was called: # once (18µs+24µs) by YAML::BEGIN@6 at line 4 use warnings; # spent 42µs making 1 call to YAML::Base::BEGIN@4 # spent 24µs making 1 call to warnings::import
5	3	375µs	1	5µs	# spent 5µs within YAML::Base::BEGIN@5 which was called: # once (5µs+0s) by YAML::BEGIN@6 at line 5 use Exporter (); # spent 5µs making 1 call to YAML::Base::BEGIN@5
6
7	1	600ns			our $VERSION = '0.71';
8	1	11µs			our @ISA = 'Exporter';
9	1	900ns			our @EXPORT = qw(field XXX);
10
11					# spent 720µs within YAML::Base::new which was called 64 times, avg 11µs/call: # 32 times (451µs+0s) by YAML::Load at line 33 of YAML.pm, avg 14µs/call # 32 times (268µs+0s) by YAML::init_action_object at line 87 of YAML.pm, avg 8µs/call sub new {
12	64	58µs			my $class = shift;
13	64	71µs			$class = ref($class) \|\| $class;
14	64	303µs			my $self = bless {}, $class;
15	64	78µs			while (@_) {
16					my $method = shift;
17					$self->$method(shift);
18					}
19	64	264µ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 5.73ms (3.63+2.09) within YAML::Base::field which was called 21 times, avg 273µs/call: # once (229µs+191µs) by YAML::Loader::BEGIN@6 at line 10 of YAML/Loader/Base.pm # once (203µs+171µs) by YAML::Loader::BEGIN@6 at line 19 of YAML/Loader/Base.pm # once (231µs+124µs) by YAML::Loader::BEGIN@6 at line 23 of YAML/Loader/Base.pm # once (177µs+154µs) by YAML::Loader::BEGIN@6 at line 22 of YAML/Loader/Base.pm # once (131µs+185µs) by C4::Search::BEGIN@34 at line 18 of YAML.pm # once (196µs+116µs) by YAML::Loader::BEGIN@6 at line 25 of YAML/Loader/Base.pm # once (188µs+123µs) by YAML::Loader::BEGIN@6 at line 24 of YAML/Loader/Base.pm # once (191µs+116µs) by YAML::Loader::BEGIN@6 at line 26 of YAML/Loader/Base.pm # once (182µs+118µs) by YAML::Loader::BEGIN@6 at line 11 of YAML/Loader/Base.pm # once (182µs+116µs) by YAML::Loader::BEGIN@6 at line 21 of YAML/Loader/Base.pm # once (175µs+108µs) by YAML::Loader::BEGIN@6 at line 17 of YAML/Loader/Base.pm # once (157µs+117µs) by YAML::Loader::BEGIN@6 at line 13 of YAML/Loader/Base.pm # once (177µs+91µs) by YAML::Loader::BEGIN@6 at line 16 of YAML/Loader/Base.pm # once (241µs+22µs) by YAML::Loader::BEGIN@6 at line 18 of YAML/Loader/Base.pm # once (209µs+26µs) by YAML::Loader::BEGIN@6 at line 20 of YAML/Loader/Base.pm # once (158µs+69µs) by C4::Search::BEGIN@34 at line 20 of YAML.pm # once (147µs+70µs) by C4::Search::BEGIN@34 at line 19 of YAML.pm # once (141µs+69µs) by C4::Search::BEGIN@34 at line 22 of YAML.pm # once (123µs+81µs) by YAML::Loader::BEGIN@6 at line 12 of YAML/Loader/Base.pm # once (100µs+14µs) by YAML::Loader::BEGIN@6 at line 14 of YAML/Loader/Base.pm # once (95µs+12µs) by YAML::Loader::BEGIN@6 at line 15 of YAML/Loader/Base.pm sub field {
47	21	28µs			my $package = caller;
48	21	128µs	21	427µs	my ($args, @values) = &$parse_arguments( # spent 427µs making 21 calls to YAML::Base::__ANON__[YAML/Base.pm:162], avg 20µs/call
49					[ qw(-package -init) ],
50					@_,
51					);
52	21	18µs			my ($field, $default) = @values;
53	21	31µs			$package = $args->{-package} if defined $args->{-package};
54	21	63µs			return if defined &{"${package}::$field"};
55	21	79µs	17	1.67ms	my $default_string = # spent 1.67ms making 17 calls to YAML::Base::__ANON__[YAML/Base.pm:172], avg 98µ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	23µs			my $code = $code{sub_start};
63	21	31µ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	60µs			$code .= sprintf $code{set_default}, $field, $default_string, $field
68					if defined $default;
69	21	28µs			$code .= sprintf $code{return_if_get}, $field;
70	21	24µs			$code .= sprintf $code{set}, $field;
71	21	20µs			$code .= sprintf $code{sub_end}, $field;
72
73	21	2.56ms			my $sub = eval $code; # spent 1.59ms executing statements in string eval # includes 1.39ms spent executing 288 calls to 1 sub defined therein. # spent 913µs executing statements in string eval # includes 706µs spent executing 128 calls to 1 sub defined therein. # spent 779µs executing statements in string eval # includes 607µs spent executing 64 calls to 1 sub defined therein. # spent 665µs executing statements in string eval # includes 551µs spent executing 96 calls to 1 sub defined therein. # spent 595µs executing statements in string eval # includes 598µs spent executing 32 calls to 1 sub defined therein. # spent 566µs executing statements in string eval # includes 489µs spent executing 64 calls to 1 sub defined therein. # spent 518µs executing statements in string eval # includes 442µs spent executing 64 calls to 1 sub defined therein. # spent 407µs executing statements in string eval # includes 353µs spent executing 32 calls to 1 sub defined therein. # spent 22µs executing statements in string eval # spent 19µs executing statements in string eval # spent 15µs executing statements in string eval # spent 11µs executing statements in string eval # spent 10µs executing statements in string eval # spent 10µs executing statements in string eval # spent 9µs executing statements in string eval # spent 9µ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 6µs executing statements in string eval # spent 6µs executing statements in string eval
74	21	8µs			die $@ if $@;
75	3	636µs	2	55µs	# spent 35µs (15+20) within YAML::Base::BEGIN@75 which was called: # once (15µs+20µs) by YAML::BEGIN@6 at line 75 no strict 'refs'; # spent 35µs making 1 call to YAML::Base::BEGIN@75 # spent 20µs making 1 call to strict::unimport
76	21	141µs			*{"${package}::$field"} = $sub;
77	21	258µ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 427µs within YAML::Base::__ANON__[/usr/share/perl5/YAML/Base.pm:162] which was called 21 times, avg 20µs/call: # 21 times (427µs+0s) by YAML::Base::field at line 48, avg 20µs/call $parse_arguments = sub {
149	21	20µs			my $paired_arguments = shift \|\| [];
150	21	34µs			my ($args, @values) = ({}, ());
151	21	104µs			my %pairs = map { ($_, 1) } @$paired_arguments;
152	21	19µs			while (@_) {
153	42	27µs			my $elem = shift;
154	42	83µs			if (defined $elem and defined $pairs{$elem} and @_) {
155					$args->{$elem} = shift;
156					}
157					else {
158	40	42µs			push @values, $elem;
159					}
160					}
161	21	153µs			return wantarray ? ($args, @values) : $args;
162	1	6µs			};
163
164					# spent 1.67ms (368µs+1.30) within YAML::Base::__ANON__[/usr/share/perl5/YAML/Base.pm:172] which was called 17 times, avg 98µs/call: # 17 times (368µs+1.30ms) by YAML::Base::field at line 55, avg 98µs/call $default_as_code = sub {
165	3	103µs	2	66µs	# spent 41µs (16+25) within YAML::Base::BEGIN@165 which was called: # once (16µs+25µs) by YAML::BEGIN@6 at line 165 no warnings 'once'; # spent 41µs making 1 call to YAML::Base::BEGIN@165 # spent 25µs making 1 call to warnings::unimport
166	17	18µs			require Data::Dumper;
167	17	15µs			local $Data::Dumper::Sortkeys = 1;
168	17	151µs	17	1.17ms	my $code = Data::Dumper::Dumper(shift); # spent 1.17ms making 17 calls to Data::Dumper::Dumper, avg 69µs/call
169	17	157µs	17	89µs	$code =~ s/^\$VAR1 = //; # spent 89µs making 17 calls to YAML::Base::CORE:subst, avg 5µs/call
170	17	85µs	17	41µs	$code =~ s/;$//; # spent 41µs making 17 calls to YAML::Base::CORE:subst, avg 2µs/call
171	17	84µs			return $code;
172	1	5µs			};
173
174	1	9µs			1;
175
176					__END__

					# spent 130µs within YAML::Base::CORE:subst which was called 34 times, avg 4µs/call: # 17 times (89µs+0s) by YAML::Base::__ANON__[/usr/share/perl5/YAML/Base.pm:172] at line 169, avg 5µs/call # 17 times (41µ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