← 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:06 2013

Filename/usr/lib/perl5/Text/CSV_XS.pm
StatementsExecuted 23 statements in 3.02ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11130µs30µsText::CSV_XS::::bootstrapText::CSV_XS::bootstrap (xsub)
11126µs34µsText::CSV_XS::::BEGIN@26Text::CSV_XS::BEGIN@26
11113µs27µsText::CSV_XS::::BEGIN@27Text::CSV_XS::BEGIN@27
11112µs66µsText::CSV_XS::::BEGIN@30Text::CSV_XS::BEGIN@30
11110µs51µsText::CSV_XS::::BEGIN@32Text::CSV_XS::BEGIN@32
1117µs7µsText::CSV_XS::::SetDiagText::CSV_XS::SetDiag (xsub)
1116µs6µsText::CSV_XS::::BEGIN@29Text::CSV_XS::BEGIN@29
0000s0sText::CSV_XS::::IVText::CSV_XS::IV
0000s0sText::CSV_XS::::NVText::CSV_XS::NV
0000s0sText::CSV_XS::::PVText::CSV_XS::PV
0000s0sText::CSV_XS::::_check_sanityText::CSV_XS::_check_sanity
0000s0sText::CSV_XS::::_set_attr_CText::CSV_XS::_set_attr_C
0000s0sText::CSV_XS::::_set_attr_NText::CSV_XS::_set_attr_N
0000s0sText::CSV_XS::::_set_attr_XText::CSV_XS::_set_attr_X
0000s0sText::CSV_XS::::allow_loose_escapesText::CSV_XS::allow_loose_escapes
0000s0sText::CSV_XS::::allow_loose_quotesText::CSV_XS::allow_loose_quotes
0000s0sText::CSV_XS::::allow_whitespaceText::CSV_XS::allow_whitespace
0000s0sText::CSV_XS::::always_quoteText::CSV_XS::always_quote
0000s0sText::CSV_XS::::auto_diagText::CSV_XS::auto_diag
0000s0sText::CSV_XS::::binaryText::CSV_XS::binary
0000s0sText::CSV_XS::::bind_columnsText::CSV_XS::bind_columns
0000s0sText::CSV_XS::::blank_is_undefText::CSV_XS::blank_is_undef
0000s0sText::CSV_XS::::column_namesText::CSV_XS::column_names
0000s0sText::CSV_XS::::combineText::CSV_XS::combine
0000s0sText::CSV_XS::::empty_is_undefText::CSV_XS::empty_is_undef
0000s0sText::CSV_XS::::eofText::CSV_XS::eof
0000s0sText::CSV_XS::::eolText::CSV_XS::eol
0000s0sText::CSV_XS::::error_diagText::CSV_XS::error_diag
0000s0sText::CSV_XS::::error_inputText::CSV_XS::error_input
0000s0sText::CSV_XS::::escape_charText::CSV_XS::escape_char
0000s0sText::CSV_XS::::fieldsText::CSV_XS::fields
0000s0sText::CSV_XS::::getline_hrText::CSV_XS::getline_hr
0000s0sText::CSV_XS::::is_binaryText::CSV_XS::is_binary
0000s0sText::CSV_XS::::is_quotedText::CSV_XS::is_quoted
0000s0sText::CSV_XS::::keep_meta_infoText::CSV_XS::keep_meta_info
0000s0sText::CSV_XS::::meta_infoText::CSV_XS::meta_info
0000s0sText::CSV_XS::::newText::CSV_XS::new
0000s0sText::CSV_XS::::parseText::CSV_XS::parse
0000s0sText::CSV_XS::::quote_charText::CSV_XS::quote_char
0000s0sText::CSV_XS::::quote_nullText::CSV_XS::quote_null
0000s0sText::CSV_XS::::quote_spaceText::CSV_XS::quote_space
0000s0sText::CSV_XS::::sep_charText::CSV_XS::sep_char
0000s0sText::CSV_XS::::statusText::CSV_XS::status
0000s0sText::CSV_XS::::stringText::CSV_XS::string
0000s0sText::CSV_XS::::typesText::CSV_XS::types
0000s0sText::CSV_XS::::verbatimText::CSV_XS::verbatim
0000s0sText::CSV_XS::::versionText::CSV_XS::version
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Text::CSV_XS;
2
3# Copyright (c) 2007-2010 H.Merijn Brand. All rights reserved.
4# Copyright (c) 1998-2001 Jochen Wiedmann. All rights reserved.
5# Portions Copyright (c) 1997 Alan Citterman. All rights reserved.
6#
7# This program is free software; you can redistribute it and/or
8# modify it under the same terms as Perl itself.
9
10################################################################################
11# HISTORY
12#
13# Written by:
14# Jochen Wiedmann <joe@ispsoft.de>
15#
16# Based on Text::CSV by:
17# Alan Citterman <alan@mfgrtl.com>
18#
19# Extended and Remodelled by:
20# H.Merijn Brand (h.m.brand@xs4all.nl)
21#
22############################################################################
23
24135µsrequire 5.005;
25
26336µs242µs
# spent 34µs (26+8) within Text::CSV_XS::BEGIN@26 which was called: # once (26µs+8µs) by Text::CSV::BEGIN@1 at line 26
use strict;
# spent 34µs making 1 call to Text::CSV_XS::BEGIN@26 # spent 8µs making 1 call to strict::import
27328µs241µs
# spent 27µs (13+14) within Text::CSV_XS::BEGIN@27 which was called: # once (13µs+14µs) by Text::CSV::BEGIN@1 at line 27
use warnings;
# spent 27µs making 1 call to Text::CSV_XS::BEGIN@27 # spent 14µs making 1 call to warnings::import
28
29323µs16µs
# spent 6µs within Text::CSV_XS::BEGIN@29 which was called: # once (6µs+0s) by Text::CSV::BEGIN@1 at line 29
use DynaLoader ();
# spent 6µs making 1 call to Text::CSV_XS::BEGIN@29
30336µs2120µs
# spent 66µs (12+54) within Text::CSV_XS::BEGIN@30 which was called: # once (12µs+54µs) by Text::CSV::BEGIN@1 at line 30
use Carp;
# spent 66µs making 1 call to Text::CSV_XS::BEGIN@30 # spent 54µs making 1 call to Exporter::import
31
3232.78ms292µs
# spent 51µs (10+41) within Text::CSV_XS::BEGIN@32 which was called: # once (10µs+41µs) by Text::CSV::BEGIN@1 at line 32
use vars qw( $VERSION @ISA );
# spent 51µs making 1 call to Text::CSV_XS::BEGIN@32 # spent 41µs making 1 call to vars::import
331900ns$VERSION = "0.73";
34113µs@ISA = qw( DynaLoader );
35112µs1327µsbootstrap Text::CSV_XS $VERSION;
# spent 327µs making 1 call to DynaLoader::bootstrap
36
37sub PV { 0 }
38sub IV { 1 }
39sub NV { 2 }
40
41# version
42#
43# class/object method expecting no arguments and returning the version
44# number of Text::CSV. there are no side-effects.
45
46sub version
47{
48 return $VERSION;
49 } # version
50
51# new
52#
53# class/object method expecting no arguments and returning a reference to
54# a newly created Text::CSV object.
55
56116µsmy %def_attr = (
57 quote_char => '"',
58 escape_char => '"',
59 sep_char => ',',
60 eol => '',
61 always_quote => 0,
62 quote_space => 1,
63 quote_null => 1,
64 binary => 0,
65 keep_meta_info => 0,
66 allow_loose_quotes => 0,
67 allow_loose_escapes => 0,
68 allow_whitespace => 0,
69 blank_is_undef => 0,
70 empty_is_undef => 0,
71 verbatim => 0,
72 auto_diag => 0,
73 types => undef,
74
75 _EOF => 0,
76 _STATUS => undef,
77 _FIELDS => undef,
78 _FFLAGS => undef,
79 _STRING => undef,
80 _ERROR_INPUT => undef,
81 _COLUMN_NAMES => undef,
82 _BOUND_COLUMNS => undef,
83 _AHEAD => undef,
84 );
85116µs17µsmy $last_new_err = Text::CSV_XS->SetDiag (0);
# spent 7µs making 1 call to Text::CSV_XS::SetDiag
86
87sub _check_sanity
88{
89 my $attr = shift;
90 for (qw( sep_char quote_char escape_char )) {
91 exists $attr->{$_} && defined $attr->{$_} && $attr->{$_} =~ m/[\r\n]/ and
92 return 1003;
93 }
94 $attr->{allow_whitespace} and
95 (defined $attr->{quote_char} && $attr->{quote_char} =~ m/^[ \t]$/) ||
96 (defined $attr->{escape_char} && $attr->{escape_char} =~ m/^[ \t]$/) and
97 return 1002;
98 return 0;
99 } # _check_sanity
100
101sub new
102{
103 $last_new_err = SetDiag (undef, 1000,
104 "usage: my \$csv = Text::CSV_XS->new ([{ option => value, ... }]);");
105
106 my $proto = shift;
107 my $class = ref ($proto) || $proto or return;
108 @_ > 0 && ref $_[0] ne "HASH" and return;
109 my $attr = shift || {};
110
111 for (keys %{$attr}) {
112 if (m/^[a-z]/ && exists $def_attr{$_}) {
113 $] >= 5.008002 && m/_char$/ and utf8::decode ($attr->{$_});
114 next;
115 }
116# croak?
117 $last_new_err = SetDiag (undef, 1000, "INI - Unknown attribute '$_'");
118 $attr->{auto_diag} and error_diag ();
119 return;
120 }
121
122 my $self = {%def_attr, %{$attr}};
123 if (my $ec = _check_sanity ($self)) {
124 $last_new_err = SetDiag (undef, $ec);
125 $attr->{auto_diag} and error_diag ();
126 return;
127 }
128
129 $last_new_err = SetDiag (undef, 0);
130 defined $\ && !exists $attr->{eol} and $self->{eol} = $\;
131 bless $self, $class;
132 defined $self->{types} and $self->types ($self->{types});
133 $self;
134 } # new
135
136# Keep in sync with XS!
13715µsmy %_cache_id = ( # Only expose what is accessed from within PM
138 quote_char => 0,
139 escape_char => 1,
140 sep_char => 2,
141 binary => 3,
142 keep_meta_info => 4,
143 always_quote => 5,
144 allow_loose_quotes => 6,
145 allow_loose_escapes => 7,
146 allow_double_quoted => 8,
147 allow_whitespace => 9,
148 blank_is_undef => 10,
149 eol => 11, # 11 .. 18
150 verbatim => 22,
151 empty_is_undef => 23,
152 auto_diag => 24,
153 quote_space => 25,
154 quote_null => 31,
155 _is_bound => 26, # 26 .. 29
156 );
157
158# A `character'
159sub _set_attr_C
160{
161 my ($self, $name, $val, $ec) = @_;
162 defined $val or $val = 0;
163 $] >= 5.008002 and utf8::decode ($val);
164 $self->{$name} = $val;
165 $ec = _check_sanity ($self) and
166 croak ($self->SetDiag ($ec));
167 $self->_cache_set ($_cache_id{$name}, $val);
168 } # _set_attr_C
169
170# A flag
171sub _set_attr_X
172{
173 my ($self, $name, $val) = @_;
174 defined $val or $val = 0;
175 $self->{$name} = $val;
176 $self->_cache_set ($_cache_id{$name}, 0 + $val);
177 } # _set_attr_X
178
179# A number
180sub _set_attr_N
181{
182 my ($self, $name, $val) = @_;
183 $self->{$name} = $val;
184 $self->_cache_set ($_cache_id{$name}, 0 + $val);
185 } # _set_attr_N
186
187# Accessor methods.
188# It is unwise to change them halfway through a single file!
189sub quote_char
190{
191 my $self = shift;
192 if (@_) {
193 my $qc = shift;
194 $self->_set_attr_C ("quote_char", $qc);
195 }
196 $self->{quote_char};
197 } # quote_char
198
199sub escape_char
200{
201 my $self = shift;
202 if (@_) {
203 my $ec = shift;
204 $self->_set_attr_C ("escape_char", $ec);
205 }
206 $self->{escape_char};
207 } # escape_char
208
209sub sep_char
210{
211 my $self = shift;
212 @_ and $self->_set_attr_C ("sep_char", shift);
213 $self->{sep_char};
214 } # sep_char
215
216sub eol
217{
218 my $self = shift;
219 if (@_) {
220 my $eol = shift;
221 defined $eol or $eol = "";
222 $self->{eol} = $eol;
223 $self->_cache_set ($_cache_id{eol}, $eol);
224 }
225 $self->{eol};
226 } # eol
227
228sub always_quote
229{
230 my $self = shift;
231 @_ and $self->_set_attr_X ("always_quote", shift);
232 $self->{always_quote};
233 } # always_quote
234
235sub quote_space
236{
237 my $self = shift;
238 @_ and $self->_set_attr_X ("quote_space", shift);
239 $self->{quote_space};
240 } # quote_space
241
242sub quote_null
243{
244 my $self = shift;
245 @_ and $self->_set_attr_X ("quote_null", shift);
246 $self->{quote_null};
247 } # quote_null
248
249sub binary
250{
251 my $self = shift;
252 @_ and $self->_set_attr_X ("binary", shift);
253 $self->{binary};
254 } # binary
255
256sub keep_meta_info
257{
258 my $self = shift;
259 @_ and $self->_set_attr_X ("keep_meta_info", shift);
260 $self->{keep_meta_info};
261 } # keep_meta_info
262
263sub allow_loose_quotes
264{
265 my $self = shift;
266 @_ and $self->_set_attr_X ("allow_loose_quotes", shift);
267 $self->{allow_loose_quotes};
268 } # allow_loose_quotes
269
270sub allow_loose_escapes
271{
272 my $self = shift;
273 @_ and $self->_set_attr_X ("allow_loose_escapes", shift);
274 $self->{allow_loose_escapes};
275 } # allow_loose_escapes
276
277sub allow_whitespace
278{
279 my $self = shift;
280 if (@_) {
281 my $aw = shift;
282 $aw and
283 (defined $self->{quote_char} && $self->{quote_char} =~ m/^[ \t]$/) ||
284 (defined $self->{escape_char} && $self->{escape_char} =~ m/^[ \t]$/) and
285 croak ($self->SetDiag (1002));
286 $self->_set_attr_X ("allow_whitespace", $aw);
287 }
288 $self->{allow_whitespace};
289 } # allow_whitespace
290
291sub blank_is_undef
292{
293 my $self = shift;
294 @_ and $self->_set_attr_X ("blank_is_undef", shift);
295 $self->{blank_is_undef};
296 } # blank_is_undef
297
298sub empty_is_undef
299{
300 my $self = shift;
301 @_ and $self->_set_attr_X ("empty_is_undef", shift);
302 $self->{empty_is_undef};
303 } # empty_is_undef
304
305sub verbatim
306{
307 my $self = shift;
308 @_ and $self->_set_attr_X ("verbatim", shift);
309 $self->{verbatim};
310 } # verbatim
311
312sub auto_diag
313{
314 my $self = shift;
315 @_ and $self->_set_attr_X ("auto_diag", shift);
316 $self->{auto_diag};
317 } # auto_diag
318
319# status
320#
321# object method returning the success or failure of the most recent
322# combine () or parse (). there are no side-effects.
323
324sub status
325{
326 my $self = shift;
327 return $self->{_STATUS};
328 } # status
329
330sub eof
331{
332 my $self = shift;
333 return $self->{_EOF};
334 } # status
335
336# error_input
337#
338# object method returning the first invalid argument to the most recent
339# combine () or parse (). there are no side-effects.
340
341sub error_input
342{
343 my $self = shift;
344 return $self->{_ERROR_INPUT};
345 } # error_input
346
347# erro_diag
348#
349# If (and only if) an error occured, this function returns a code that
350# indicates the reason of failure
351
352sub error_diag
353{
354 my $self = shift;
355 my @diag = (0 + $last_new_err, $last_new_err, 0);
356
357 if ($self && ref $self && # Not a class method or direct call
358 $self->isa (__PACKAGE__) && exists $self->{_ERROR_DIAG}) {
359 @diag = (0 + $self->{_ERROR_DIAG}, $self->{_ERROR_DIAG});
360 exists $self->{_ERROR_POS} and $diag[2] = 1 + $self->{_ERROR_POS};
361 }
362
363 my $context = wantarray;
364 unless (defined $context) { # Void context, auto-diag
365 if ($diag[0] && $diag[0] != 2012) {
366 my $msg = "# CSV_XS ERROR: $diag[0] - $diag[1] \@ pos $diag[2]\n";
367 if ($self && ref $self) { # auto_diag
368
369 my $lvl = $self->{auto_diag};
370 if ($lvl < 2) {
371 my @c = caller (2);
372 if (@c >= 11 && $c[10] && ref $c[10] eq "HASH") {
373 my $hints = $c[10];
374 (exists $hints->{autodie} && $hints->{autodie} or
375 exists $hints->{"guard Fatal"} &&
376 !exists $hints->{"no Fatal"}) and
377 $lvl++;
378 # Future releases of autodie will probably set $^H{autodie}
379 # to "autodie @args", like "autodie :all" or "autodie open"
380 # so we can/should check for "open" or "new"
381 }
382 }
383 $lvl > 1 ? die $msg : warn $msg;
384 }
385 else { # called without args in void context
386 warn $msg;
387 }
388 }
389 return;
390 }
391 return $context ? @diag : $diag[1];
392 } # error_diag
393
394# string
395#
396# object method returning the result of the most recent combine () or the
397# input to the most recent parse (), whichever is more recent. there are
398# no side-effects.
399
400sub string
401{
402 my $self = shift;
403 return ref $self->{_STRING} ? ${$self->{_STRING}} : undef;
404 } # string
405
406# fields
407#
408# object method returning the result of the most recent parse () or the
409# input to the most recent combine (), whichever is more recent. there
410# are no side-effects.
411
412sub fields
413{
414 my $self = shift;
415 return ref $self->{_FIELDS} ? @{$self->{_FIELDS}} : undef;
416 } # fields
417
418# meta_info
419#
420# object method returning the result of the most recent parse () or the
421# input to the most recent combine (), whichever is more recent. there
422# are no side-effects. meta_info () returns (if available) some of the
423# field's properties
424
425sub meta_info
426{
427 my $self = shift;
428 return ref $self->{_FFLAGS} ? @{$self->{_FFLAGS}} : undef;
429 } # meta_info
430
431sub is_quoted
432{
433 my ($self, $idx, $val) = @_;
434 ref $self->{_FFLAGS} &&
435 $idx >= 0 && $idx < @{$self->{_FFLAGS}} or return;
436 $self->{_FFLAGS}[$idx] & 0x0001 ? 1 : 0;
437 } # is_quoted
438
439sub is_binary
440{
441 my ($self, $idx, $val) = @_;
442 ref $self->{_FFLAGS} &&
443 $idx >= 0 && $idx < @{$self->{_FFLAGS}} or return;
444 $self->{_FFLAGS}[$idx] & 0x0002 ? 1 : 0;
445 } # is_binary
446
447# combine
448#
449# object method returning success or failure. the given arguments are
450# combined into a single comma-separated value. failure can be the
451# result of no arguments or an argument containing an invalid character.
452# side-effects include:
453# setting status ()
454# setting fields ()
455# setting string ()
456# setting error_input ()
457
458sub combine
459{
460 my $self = shift;
461 my $str = "";
462 $self->{_FIELDS} = \@_;
463 $self->{_FFLAGS} = undef;
464 $self->{_STATUS} = (@_ > 0) && $self->Combine (\$str, \@_, 0);
465 $self->{_STRING} = \$str;
466 $self->{_STATUS};
467 } # combine
468
469# parse
470#
471# object method returning success or failure. the given argument is
472# expected to be a valid comma-separated value. failure can be the
473# result of no arguments or an argument containing an invalid sequence
474# of characters. side-effects include:
475# setting status ()
476# setting fields ()
477# setting meta_info ()
478# setting string ()
479# setting error_input ()
480
481sub parse
482{
483 my ($self, $str) = @_;
484
485 my $fields = [];
486 my $fflags = [];
487 $self->{_STRING} = \$str;
488 if (defined $str && $self->Parse ($str, $fields, $fflags)) {
489 $self->{_ERROR_INPUT} = undef;
490 $self->{_FIELDS} = $fields;
491 $self->{_FFLAGS} = $fflags;
492 $self->{_STATUS} = 1;
493 }
494 else {
495 $self->{_FIELDS} = undef;
496 $self->{_FFLAGS} = undef;
497 $self->{_STATUS} = 0;
498 }
499 $self->{_STATUS};
500 } # parse
501
502sub column_names
503{
504 my ($self, @keys) = @_;
505 @keys or
506 return defined $self->{_COLUMN_NAMES} ? @{$self->{_COLUMN_NAMES}} : undef;
507
508 @keys == 1 && ! defined $keys[0] and
509 return $self->{_COLUMN_NAMES} = undef;
510
511 if (@keys == 1 && ref $keys[0] eq "ARRAY") {
512 @keys = @{$keys[0]};
513 }
514 elsif (join "", map { defined $_ ? ref $_ : "" } @keys) {
515 croak ($self->SetDiag (3001));
516 }
517
518 $self->{_BOUND_COLUMNS} && @keys != @{$self->{_BOUND_COLUMNS}} and
519 croak ($self->SetDiag (3003));
520
521 $self->{_COLUMN_NAMES} = [ map { defined $_ ? $_ : "\cAUNDEF\cA" } @keys ];
522 @{$self->{_COLUMN_NAMES}};
523 } # column_names
524
525sub bind_columns
526{
527 my ($self, @refs) = @_;
528 @refs or
529 return defined $self->{_BOUND_COLUMNS} ? @{$self->{_BOUND_COLUMNS}} : undef;
530
531 @refs == 1 && ! defined $refs[0] and
532 return $self->{_BOUND_COLUMNS} = undef;
533
534 $self->{_COLUMN_NAMES} && @refs != @{$self->{_COLUMN_NAMES}} and
535 croak ($self->SetDiag (3003));
536
537 join "", map { ref $_ eq "SCALAR" ? "" : "*" } @refs and
538 croak ($self->SetDiag (3004));
539
540 $self->_set_attr_N ("_is_bound", scalar @refs);
541 $self->{_BOUND_COLUMNS} = [ @refs ];
542 @refs;
543 } # bind_columns
544
545sub getline_hr
546{
547 my ($self, @args, %hr) = @_;
548 $self->{_COLUMN_NAMES} or croak ($self->SetDiag (3002));
549 my $fr = $self->getline (@args) or return;
550 @hr{@{$self->{_COLUMN_NAMES}}} = @$fr;
551 \%hr;
552 } # getline_hr
553
554sub types
555{
556 my $self = shift;
557 if (@_) {
558 if (my $types = shift) {
559 $self->{_types} = join "", map { chr $_ } @{$types};
560 $self->{types} = $types;
561 }
562 else {
563 delete $self->{types};
564 delete $self->{_types};
565 undef;
566 }
567 }
568 else {
569 $self->{types};
570 }
571 } # types
572
573115µs1;
574
575__END__
 
# spent 7µs within Text::CSV_XS::SetDiag which was called: # once (7µs+0s) by Text::CSV::BEGIN@1 at line 85
sub Text::CSV_XS::SetDiag; # xsub
# spent 30µs within Text::CSV_XS::bootstrap which was called: # once (30µs+0s) by DynaLoader::bootstrap at line 215 of DynaLoader.pm
sub Text::CSV_XS::bootstrap; # xsub
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.