← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:01:44 2013

Filename/usr/share/perl5/YAML/Types.pm
StatementsExecuted 32 statements in 2.25ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11149.4ms51.7msYAML::Type::code::::BEGIN@137 YAML::Type::code::BEGIN@137
11152µs136µsYAML::Type::regexp::::BEGIN@200 YAML::Type::regexp::BEGIN@200
11122µs29µsYAML::Types::::BEGIN@3 YAML::Types::BEGIN@3
11118µs49µsYAML::Type::blessed::::BEGIN@22YAML::Type::blessed::BEGIN@22
11116µs38µsYAML::Type::glob::::BEGIN@97 YAML::Type::glob::BEGIN@97
11115µs46µsYAML::Types::::BEGIN@6 YAML::Types::BEGIN@6
11115µs38µsYAML::Types::::BEGIN@4 YAML::Types::BEGIN@4
11112µs59µsYAML::Types::::BEGIN@5 YAML::Types::BEGIN@5
11111µs46µsYAML::Type::blessed::::BEGIN@16YAML::Type::blessed::BEGIN@16
0000s0sYAML::Type::blessed::::yaml_dumpYAML::Type::blessed::yaml_dump
0000s0sYAML::Type::code::::__ANON__[:163] YAML::Type::code::__ANON__[:163]
0000s0sYAML::Type::code::::__ANON__[:171] YAML::Type::code::__ANON__[:171]
0000s0sYAML::Type::code::::__ANON__[:172] YAML::Type::code::__ANON__[:172]
0000s0sYAML::Type::code::::yaml_dump YAML::Type::code::yaml_dump
0000s0sYAML::Type::code::::yaml_load YAML::Type::code::yaml_load
0000s0sYAML::Type::glob::::yaml_dump YAML::Type::glob::yaml_dump
0000s0sYAML::Type::glob::::yaml_load YAML::Type::glob::yaml_load
0000s0sYAML::Type::ref::::yaml_dump YAML::Type::ref::yaml_dump
0000s0sYAML::Type::ref::::yaml_load YAML::Type::ref::yaml_load
0000s0sYAML::Type::regexp::::__ANON__[:201] YAML::Type::regexp::__ANON__[:201]
0000s0sYAML::Type::regexp::::__ANON__[:202] YAML::Type::regexp::__ANON__[:202]
0000s0sYAML::Type::regexp::::__ANON__[:203] YAML::Type::regexp::__ANON__[:203]
0000s0sYAML::Type::regexp::::__ANON__[:204] YAML::Type::regexp::__ANON__[:204]
0000s0sYAML::Type::regexp::::__ANON__[:205] YAML::Type::regexp::__ANON__[:205]
0000s0sYAML::Type::regexp::::__ANON__[:206] YAML::Type::regexp::__ANON__[:206]
0000s0sYAML::Type::regexp::::__ANON__[:207] YAML::Type::regexp::__ANON__[:207]
0000s0sYAML::Type::regexp::::__ANON__[:208] YAML::Type::regexp::__ANON__[:208]
0000s0sYAML::Type::regexp::::__ANON__[:209] YAML::Type::regexp::__ANON__[:209]
0000s0sYAML::Type::regexp::::__ANON__[:210] YAML::Type::regexp::__ANON__[:210]
0000s0sYAML::Type::regexp::::__ANON__[:211] YAML::Type::regexp::__ANON__[:211]
0000s0sYAML::Type::regexp::::__ANON__[:212] YAML::Type::regexp::__ANON__[:212]
0000s0sYAML::Type::regexp::::__ANON__[:213] YAML::Type::regexp::__ANON__[:213]
0000s0sYAML::Type::regexp::::__ANON__[:214] YAML::Type::regexp::__ANON__[:214]
0000s0sYAML::Type::regexp::::__ANON__[:215] YAML::Type::regexp::__ANON__[:215]
0000s0sYAML::Type::regexp::::__ANON__[:216] YAML::Type::regexp::__ANON__[:216]
0000s0sYAML::Type::regexp::::__ANON__[:225] YAML::Type::regexp::__ANON__[:225]
0000s0sYAML::Type::regexp::::yaml_dump YAML::Type::regexp::yaml_dump
0000s0sYAML::Type::regexp::::yaml_load YAML::Type::regexp::yaml_load
0000s0sYAML::Type::undef::::yaml_dump YAML::Type::undef::yaml_dump
0000s0sYAML::Type::undef::::yaml_load YAML::Type::undef::yaml_load
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package YAML::Types;
2
3337µs236µs
# spent 29µs (22+7) within YAML::Types::BEGIN@3 which was called: # once (22µs+7µs) by YAML::Loader::BEGIN@7 at line 3
use strict;
# spent 29µs making 1 call to YAML::Types::BEGIN@3 # spent 7µs making 1 call to strict::import
4330µs262µs
# spent 38µs (15+24) within YAML::Types::BEGIN@4 which was called: # once (15µs+24µs) by YAML::Loader::BEGIN@7 at line 4
use warnings;
# spent 38µs making 1 call to YAML::Types::BEGIN@4 # spent 24µs making 1 call to warnings::import
5331µs2107µs
# spent 59µs (12+47) within YAML::Types::BEGIN@5 which was called: # once (12µs+47µs) by YAML::Loader::BEGIN@7 at line 5
use YAML::Base;
# spent 59µs making 1 call to YAML::Types::BEGIN@5 # spent 48µs making 1 call to Exporter::import
6369µs278µs
# spent 46µs (15+31) within YAML::Types::BEGIN@6 which was called: # once (15µs+31µs) by YAML::Loader::BEGIN@7 at line 6
use YAML::Node;
# spent 46µs making 1 call to YAML::Types::BEGIN@6 # spent 31µs making 1 call to Exporter::import
7
812µsour $VERSION = '0.71';
9119µsour @ISA = 'YAML::Base';
10
11# XXX These classes and their APIs could still use some refactoring,
12# but at least they work for now.
13#-------------------------------------------------------------------------------
14package YAML::Type::blessed;
15
16367µs282µs
# spent 46µs (11+36) within YAML::Type::blessed::BEGIN@16 which was called: # once (11µs+36µs) by YAML::Loader::BEGIN@7 at line 16
use YAML::Base; # XXX
# spent 46µs making 1 call to YAML::Type::blessed::BEGIN@16 # spent 36µs making 1 call to Exporter::import
17
18sub yaml_dump {
19 my $self = shift;
20 my ($value) = @_;
21 my ($class, $type) = YAML::Base->node_info($value);
223517µs280µs
# spent 49µs (18+31) within YAML::Type::blessed::BEGIN@22 which was called: # once (18µs+31µs) by YAML::Loader::BEGIN@7 at line 22
no strict 'refs';
# spent 49µs making 1 call to YAML::Type::blessed::BEGIN@22 # spent 31µs making 1 call to strict::unimport
23 my $kind = lc($type) . ':';
24 my $tag = ${$class . '::ClassTag'} ||
25 "!perl/$kind$class";
26 if ($type eq 'REF') {
27 YAML::Node->new(
28 {(&YAML::VALUE, ${$_[0]})}, $tag
29 );
30 }
31 elsif ($type eq 'SCALAR') {
32 $_[1] = $$value;
33 YAML::Node->new($_[1], $tag);
34 } else {
35 YAML::Node->new($value, $tag);
36 }
37}
38
39#-------------------------------------------------------------------------------
40package YAML::Type::undef;
41
42sub yaml_dump {
43 my $self = shift;
44}
45
46sub yaml_load {
47 my $self = shift;
48}
49
50#-------------------------------------------------------------------------------
51package YAML::Type::glob;
52
53sub yaml_dump {
54 my $self = shift;
55 my $ynode = YAML::Node->new({}, '!perl/glob:');
56 for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
57 my $value = *{$_[0]}{$type};
58 $value = $$value if $type eq 'SCALAR';
59 if (defined $value) {
60 if ($type eq 'IO') {
61 my @stats = qw(device inode mode links uid gid rdev size
62 atime mtime ctime blksize blocks);
63 undef $value;
64 $value->{stat} = YAML::Node->new({});
65 map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]});
66 $value->{fileno} = fileno(*{$_[0]});
67 {
68 local $^W;
69 $value->{tell} = tell(*{$_[0]});
70 }
71 }
72 $ynode->{$type} = $value;
73 }
74 }
75 return $ynode;
76}
77
78sub yaml_load {
79 my $self = shift;
80 my ($node, $class, $loader) = @_;
81 my ($name, $package);
82 if (defined $node->{NAME}) {
83 $name = $node->{NAME};
84 delete $node->{NAME};
85 }
86 else {
87 $loader->warn('YAML_LOAD_WARN_GLOB_NAME');
88 return undef;
89 }
90 if (defined $node->{PACKAGE}) {
91 $package = $node->{PACKAGE};
92 delete $node->{PACKAGE};
93 }
94 else {
95 $package = 'main';
96 }
973365µs260µs
# spent 38µs (16+22) within YAML::Type::glob::BEGIN@97 which was called: # once (16µs+22µs) by YAML::Loader::BEGIN@7 at line 97
no strict 'refs';
# spent 38µs making 1 call to YAML::Type::glob::BEGIN@97 # spent 22µs making 1 call to strict::unimport
98 if (exists $node->{SCALAR}) {
99 *{"${package}::$name"} = \$node->{SCALAR};
100 delete $node->{SCALAR};
101 }
102 for my $elem (qw(ARRAY HASH CODE IO)) {
103 if (exists $node->{$elem}) {
104 if ($elem eq 'IO') {
105 $loader->warn('YAML_LOAD_WARN_GLOB_IO');
106 delete $node->{IO};
107 next;
108 }
109 *{"${package}::$name"} = $node->{$elem};
110 delete $node->{$elem};
111 }
112 }
113 for my $elem (sort keys %$node) {
114 $loader->warn('YAML_LOAD_WARN_BAD_GLOB_ELEM', $elem);
115 }
116 return *{"${package}::$name"};
117}
118
119#-------------------------------------------------------------------------------
120package YAML::Type::code;
121
1221600nsmy $dummy_warned = 0;
1231500nsmy $default = '{ "DUMMY" }';
124
125sub yaml_dump {
126 my $self = shift;
127 my $code;
128 my ($dumpflag, $value) = @_;
129 my ($class, $type) = YAML::Base->node_info($value);
130 my $tag = "!perl/code";
131 $tag .= ":$class" if defined $class;
132 if (not $dumpflag) {
133 $code = $default;
134 }
135 else {
136 bless $value, "CODE" if $class;
1373887µs151.7ms
# spent 51.7ms (49.4+2.31) within YAML::Type::code::BEGIN@137 which was called: # once (49.4ms+2.31ms) by YAML::Loader::BEGIN@7 at line 137
eval { use B::Deparse };
# spent 51.7ms making 1 call to YAML::Type::code::BEGIN@137
138 return if $@;
139 my $deparse = B::Deparse->new();
140 eval {
141 local $^W = 0;
142 $code = $deparse->coderef2text($value);
143 };
144 if ($@) {
145 warn YAML::YAML_DUMP_WARN_DEPARSE_FAILED() if $^W;
146 $code = $default;
147 }
148 bless $value, $class if $class;
149 chomp $code;
150 $code .= "\n";
151 }
152 $_[2] = $code;
153 YAML::Node->new($_[2], $tag);
154}
155
156sub yaml_load {
157 my $self = shift;
158 my ($node, $class, $loader) = @_;
159 if ($loader->load_code) {
160 my $code = eval "package main; sub $node";
161 if ($@) {
162 $loader->warn('YAML_LOAD_WARN_PARSE_CODE', $@);
163 return sub {};
164 }
165 else {
166 CORE::bless $code, $class if $class;
167 return $code;
168 }
169 }
170 else {
171 return CORE::bless sub {}, $class if $class;
172 return sub {};
173 }
174}
175
176#-------------------------------------------------------------------------------
177package YAML::Type::ref;
178
179sub yaml_dump {
180 my $self = shift;
181 YAML::Node->new({(&YAML::VALUE, ${$_[0]})}, '!perl/ref')
182}
183
184sub yaml_load {
185 my $self = shift;
186 my ($node, $class, $loader) = @_;
187 $loader->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE', 'ptr')
188 unless exists $node->{&YAML::VALUE};
189 return \$node->{&YAML::VALUE};
190}
191
192#-------------------------------------------------------------------------------
193package YAML::Type::regexp;
194
195# XXX Be sure to handle blessed regexps (if possible)
196sub yaml_dump {
197 die "YAML::Type::regexp::yaml_dump not currently implemented";
198}
199
200
# spent 136µs (52+84) within YAML::Type::regexp::BEGIN@200 which was called: # once (52µs+84µs) by YAML::Loader::BEGIN@7 at line 217
use constant _QR_TYPES => {
201 '' => sub { qr{$_[0]} },
202 x => sub { qr{$_[0]}x },
203 i => sub { qr{$_[0]}i },
204 s => sub { qr{$_[0]}s },
205 m => sub { qr{$_[0]}m },
206 ix => sub { qr{$_[0]}ix },
207 sx => sub { qr{$_[0]}sx },
208 mx => sub { qr{$_[0]}mx },
209 si => sub { qr{$_[0]}si },
210 mi => sub { qr{$_[0]}mi },
211 ms => sub { qr{$_[0]}sm },
212 six => sub { qr{$_[0]}six },
213 mix => sub { qr{$_[0]}mix },
214 msx => sub { qr{$_[0]}msx },
215 msi => sub { qr{$_[0]}msi },
216 msix => sub { qr{$_[0]}msix },
2173221µs2220µs};
# spent 136µs making 1 call to YAML::Type::regexp::BEGIN@200 # spent 84µs making 1 call to constant::import
218
219sub yaml_load {
220 my $self = shift;
221 my ($node, $class) = @_;
222 return qr{$node} unless $node =~ /^\(\?([\-xism]*):(.*)\)\z/s;
223 my ($flags, $re) = ($1, $2);
224 $flags =~ s/-.*//;
225 my $sub = _QR_TYPES->{$flags} || sub { qr{$_[0]} };
226 my $qr = &$sub($re);
227 bless $qr, $class if length $class;
228 return $qr;
229}
230
23116µs1;
232
233__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.