← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Wed Dec 14 15:57:08 2022
Reported on Wed Dec 14 16:00:37 2022

Filename/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/YAML/PP/Representer.pm
StatementsExecuted 20 statements in 1.60ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11133µs38µsYAML::PP::Dumper::::BEGIN@1.294 YAML::PP::Dumper::BEGIN@1.294
11110µs52µsYAML::PP::Representer::::BEGIN@7YAML::PP::Representer::BEGIN@7
1118µs72µsYAML::PP::Representer::::BEGIN@9YAML::PP::Representer::BEGIN@9
1118µs8µsYAML::PP::Representer::::newYAML::PP::Representer::new
1117µs50µsYAML::PP::Dumper::::BEGIN@2.295 YAML::PP::Dumper::BEGIN@2.295
1117µs9µsYAML::PP::Representer::::BEGIN@18YAML::PP::Representer::BEGIN@18
0000s0sYAML::PP::Representer::::_represent_node_nonrefYAML::PP::Representer::_represent_node_nonref
0000s0sYAML::PP::Representer::::_represent_noderefYAML::PP::Representer::_represent_noderef
0000s0sYAML::PP::Representer::::cloneYAML::PP::Representer::clone
0000s0sYAML::PP::Representer::::preserve_aliasYAML::PP::Representer::preserve_alias
0000s0sYAML::PP::Representer::::preserve_flow_styleYAML::PP::Representer::preserve_flow_style
0000s0sYAML::PP::Representer::::preserve_orderYAML::PP::Representer::preserve_order
0000s0sYAML::PP::Representer::::preserve_scalar_styleYAML::PP::Representer::preserve_scalar_style
0000s0sYAML::PP::Representer::::represent_nodeYAML::PP::Representer::represent_node
0000s0sYAML::PP::Representer::::schemaYAML::PP::Representer::schema
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1238µs243µs
# spent 38µs (33+5) within YAML::PP::Dumper::BEGIN@1.294 which was called: # once (33µs+5µs) by YAML::PP::Dumper::BEGIN@10 at line 1
use strict;
# spent 38µs making 1 call to YAML::PP::Dumper::BEGIN@1.294 # spent 5µs making 1 call to strict::import
2262µs293µs
# spent 50µs (7+43) within YAML::PP::Dumper::BEGIN@2.295 which was called: # once (7µs+43µs) by YAML::PP::Dumper::BEGIN@10 at line 2
use warnings;
# spent 50µs making 1 call to YAML::PP::Dumper::BEGIN@2.295 # spent 43µs making 1 call to warnings::import
3package YAML::PP::Representer;
4
511µsour $VERSION = '0.035'; # VERSION
6
7246µs294µs
# spent 52µs (10+42) within YAML::PP::Representer::BEGIN@7 which was called: # once (10µs+42µs) by YAML::PP::Dumper::BEGIN@10 at line 7
use Scalar::Util qw/ reftype blessed refaddr /;
# spent 52µs making 1 call to YAML::PP::Representer::BEGIN@7 # spent 42µs making 1 call to Exporter::import
8
910s
# spent 72µs (8+64) within YAML::PP::Representer::BEGIN@9 which was called: # once (8µs+64µs) by YAML::PP::Dumper::BEGIN@10 at line 17
use YAML::PP::Common qw/
10 YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE
11 YAML_DOUBLE_QUOTED_SCALAR_STYLE
12 YAML_ANY_SCALAR_STYLE
13 YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
14 YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE
15 YAML_BLOCK_MAPPING_STYLE YAML_BLOCK_SEQUENCE_STYLE
16 PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE PRESERVE_ALIAS
17129µs2136µs/;
# spent 72µs making 1 call to YAML::PP::Representer::BEGIN@9 # spent 64µs making 1 call to Exporter::import
1821.41ms211µs
# spent 9µs (7+2) within YAML::PP::Representer::BEGIN@18 which was called: # once (7µs+2µs) by YAML::PP::Dumper::BEGIN@10 at line 18
use B;
# spent 9µs making 1 call to YAML::PP::Representer::BEGIN@18 # spent 2µs making 1 call to B::import
19
20
# spent 8µs within YAML::PP::Representer::new which was called: # once (8µs+0s) by YAML::PP::Dumper::new at line 46 of YAML/PP/Dumper.pm
sub new {
2112µs my ($class, %args) = @_;
2210s my $preserve = delete $args{preserve} || 0;
2311µs if ($preserve == 1) {
24 $preserve = PRESERVE_ORDER | PRESERVE_SCALAR_STYLE | PRESERVE_FLOW_STYLE | PRESERVE_ALIAS;
25 }
26 my $self = bless {
27 schema => delete $args{schema},
2812µs preserve => $preserve,
29 }, $class;
3011µs if (keys %args) {
31 die "Unexpected arguments: " . join ', ', sort keys %args;
32 }
3313µs return $self;
34}
35
36sub clone {
37 my ($self) = @_;
38 my $clone = {
39 schema => $self->schema,
40 preserve => $self->{preserve},
41 };
42 return bless $clone, ref $self;
43}
44
45sub schema { return $_[0]->{schema} }
46sub preserve_order { return $_[0]->{preserve} & PRESERVE_ORDER }
47sub preserve_scalar_style { return $_[0]->{preserve} & PRESERVE_SCALAR_STYLE }
48sub preserve_flow_style { return $_[0]->{preserve} & PRESERVE_FLOW_STYLE }
49sub preserve_alias { return $_[0]->{preserve} & PRESERVE_ALIAS }
50
51sub represent_node {
52 my ($self, $node) = @_;
53
54 my $preserve_alias = $self->preserve_alias;
55 my $preserve_style = $self->preserve_scalar_style;
56 if ($preserve_style or $preserve_alias) {
57 if (ref $node->{value} eq 'YAML::PP::Preserve::Scalar') {
58 my $value = $node->{value}->value;
59 if ($preserve_style) {
60 $node->{style} = $node->{value}->style;
61 }
62# $node->{tag} = $node->{value}->tag;
63 $node->{value} = $value;
64 }
65 }
66 $node->{reftype} = reftype($node->{value});
67 if (not $node->{reftype} and reftype(\$node->{value}) eq 'GLOB') {
68 $node->{reftype} = 'GLOB';
69 }
70
71 if ($node->{reftype}) {
72 $self->_represent_noderef($node);
73 }
74 else {
75 $self->_represent_node_nonref($node);
76 }
77 $node->{reftype} = (reftype $node->{data}) || '';
78
79 if ($node->{reftype} eq 'HASH' and my $tied = tied(%{ $node->{data} })) {
80 my $representers = $self->schema->representers;
81 $tied = ref $tied;
82 if (my $def = $representers->{tied_equals}->{ $tied }) {
83 my $code = $def->{code};
84 my $done = $code->($self, $node);
85 }
86 }
87
88 if ($node->{reftype} eq 'HASH') {
89 unless (defined $node->{items}) {
90 # by default we sort hash keys
91 my @keys;
92 if ($self->preserve_order) {
93 @keys = keys %{ $node->{data} };
94 }
95 else {
96 @keys = sort keys %{ $node->{data} };
97 }
98 for my $key (@keys) {
99 push @{ $node->{items} }, $key, $node->{data}->{ $key };
100 }
101 }
102 my %args;
103 if ($self->preserve_flow_style and reftype $node->{value} eq 'HASH') {
104 if (my $tied = tied %{ $node->{value} } ) {
105 $args{style} = $tied->{style};
106 }
107 }
108 return [ mapping => $node, %args ];
109 }
110 elsif ($node->{reftype} eq 'ARRAY') {
111 unless (defined $node->{items}) {
112 @{ $node->{items} } = @{ $node->{data} };
113 }
114 my %args;
115 if ($self->preserve_flow_style and reftype $node->{value} eq 'ARRAY') {
116 if (my $tied = tied @{ $node->{value} } ) {
117 $args{style} = $tied->{style};
118 }
119 }
120 return [ sequence => $node, %args ];
121 }
122 elsif ($node->{reftype}) {
123 die "Cannot handle reftype '$node->{reftype}' (you might want to enable YAML::PP::Schema::Perl)";
124 }
125 else {
126 unless (defined $node->{items}) {
127 $node->{items} = [$node->{data}];
128 }
129 return [ scalar => $node ];
130 }
131
132}
133
13410smy $bool_code = <<'EOM';
135sub {
136 my ($x) = @_;
137 use experimental qw/ builtin /;
138 builtin::is_bool($x);
139}
140EOM
14110smy $is_bool;
142
143sub _represent_node_nonref {
144 my ($self, $node) = @_;
145 my $representers = $self->schema->representers;
146
147 if (not defined $node->{value}) {
148 if (my $undef = $representers->{undef}) {
149 return 1 if $undef->($self, $node);
150 }
151 else {
152 $node->{style} = YAML_SINGLE_QUOTED_SCALAR_STYLE;
153 $node->{data} = '';
154 return 1;
155 }
156 }
157 if ($] >= 5.036000 and my $rep = $representers->{bool}) {
158 $is_bool ||= eval $bool_code;
159 if ($is_bool->($node->{value})) {
160 return $rep->{code}->($self, $node);
161 }
162 }
163 for my $rep (@{ $representers->{flags} }) {
164 my $check_flags = $rep->{flags};
165 my $flags = B::svref_2object(\$node->{value})->FLAGS;
166 if ($flags & $check_flags) {
167 return 1 if $rep->{code}->($self, $node);
168 }
169
170 }
171 if (my $rep = $representers->{equals}->{ $node->{value} }) {
172 return 1 if $rep->{code}->($self, $node);
173 }
174 for my $rep (@{ $representers->{regex} }) {
175 if ($node->{value} =~ $rep->{regex}) {
176 return 1 if $rep->{code}->($self, $node);
177 }
178 }
179 unless (defined $node->{data}) {
180 $node->{data} = $node->{value};
181 }
182 unless (defined $node->{style}) {
183 $node->{style} = YAML_ANY_SCALAR_STYLE;
184 $node->{style} = "";
185 }
186}
187
188sub _represent_noderef {
189 my ($self, $node) = @_;
190 my $representers = $self->schema->representers;
191
192 if (my $classname = blessed($node->{value})) {
193 if (my $def = $representers->{class_equals}->{ $classname }) {
194 my $code = $def->{code};
195 return 1 if $code->($self, $node);
196 }
197 for my $matches (@{ $representers->{class_matches} }) {
198 my ($re, $code) = @$matches;
199 if (ref $re and $classname =~ $re or $re) {
200 return 1 if $code->($self, $node);
201 }
202 }
203 for my $isa (@{ $representers->{class_isa} }) {
204 my ($class_name, $code) = @$isa;
205 if ($node->{ value }->isa($class_name)) {
206 return 1 if $code->($self, $node);
207 }
208 }
209 }
210 if ($node->{reftype} eq 'SCALAR' and my $scalarref = $representers->{scalarref}) {
211 my $code = $scalarref->{code};
212 return 1 if $code->($self, $node);
213 }
214 if ($node->{reftype} eq 'REF' and my $refref = $representers->{refref}) {
215 my $code = $refref->{code};
216 return 1 if $code->($self, $node);
217 }
218 if ($node->{reftype} eq 'CODE' and my $coderef = $representers->{coderef}) {
219 my $code = $coderef->{code};
220 return 1 if $code->($self, $node);
221 }
222 if ($node->{reftype} eq 'GLOB' and my $glob = $representers->{glob}) {
223 my $code = $glob->{code};
224 return 1 if $code->($self, $node);
225 }
226 $node->{data} = $node->{value};
227
228}
229
23015µs1;
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.