← Index
NYTProf Performance Profile   « line view »
For split.pl
  Run on Thu Apr 20 02:05:47 2023
Reported on Thu Apr 20 18:31:09 2023

Filename/home/hejohns/perl5/lib/perl5/x86_64-linux-gnu-thread-multi/Text/CSV_XS.pm
StatementsExecuted 831084 statements in 12.7s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
133035113.76s53705sText::CSV_XS::::__ANON__[:1460]Text::CSV_XS::__ANON__[:1460]
105113.70s53714sText::CSV_XS::::getline_allText::CSV_XS::getline_all (xsub)
153405213.23s5.31sText::CSV_XS::::CORE:readlineText::CSV_XS::CORE:readline (opcode)
13303511109ms109msText::CSV_XS::::CORE:sortText::CSV_XS::CORE:sort (opcode)
1051131.9ms53714sText::CSV_XS::::getline_hr_allText::CSV_XS::getline_hr_all
1051124.1ms53715sText::CSV_XS::::csvText::CSV_XS::csv
1051110.0ms12.5msText::CSV_XS::::newText::CSV_XS::new
105118.90ms35.1msText::CSV_XS::::_csv_attrText::CSV_XS::_csv_attr
105114.44ms12.7msText::CSV_XS::::CORE:openText::CSV_XS::CORE:open (opcode)
2520912.12ms2.12msText::CSV_XS::::CORE:matchText::CSV_XS::CORE:match (opcode)
105112.12ms2.25msText::CSV_XS::::error_diagText::CSV_XS::error_diag
105111.88ms1.88msText::CSV_XS::::CORE:closeText::CSV_XS::CORE:close (opcode)
105111.69ms3.33msText::CSV_XS::::callbacksText::CSV_XS::callbacks
105111.36ms3.76msText::CSV_XS::::getlineText::CSV_XS::getline (xsub)
105111.11ms1.57msText::CSV_XS::::_check_sanityText::CSV_XS::_check_sanity
105111.07ms1.07msText::CSV_XS::::column_namesText::CSV_XS::column_names
10511906µs997µsText::CSV_XS::::_set_attr_XText::CSV_XS::_set_attr_X
10511589µs589µsText::CSV_XS::::CORE:substText::CSV_XS::CORE:subst (opcode)
21131223µs223µsText::CSV_XS::::SetDiagText::CSV_XS::SetDiag (xsub)
10511182µs182µsText::CSV_XS::::_unhealthy_whitespaceText::CSV_XS::_unhealthy_whitespace
1051190µs90µsText::CSV_XS::::_cache_setText::CSV_XS::_cache_set (xsub)
11112µs12µsText::CSV_XS::::BEGIN@25Text::CSV_XS::BEGIN@25
1118µs9µsText::CSV_XS::::BEGIN@21Text::CSV_XS::BEGIN@21
1114µs23µsText::CSV_XS::::BEGIN@22Text::CSV_XS::BEGIN@22
1114µs19µsText::CSV_XS::::BEGIN@57Text::CSV_XS::BEGIN@57
1114µs21µsText::CSV_XS::::BEGIN@26Text::CSV_XS::BEGIN@26
1114µs4µsDynaLoader::::BEGIN@112 DynaLoader::BEGIN@112
1113µs26µsText::CSV_XS::::BEGIN@28Text::CSV_XS::BEGIN@28
111300ns300nsText::CSV_XS::::__ANON__Text::CSV_XS::__ANON__ (xsub)
0000s0sText::CSV_XS::::CSV_FLAGS_ERROR_IN_FIELDText::CSV_XS::CSV_FLAGS_ERROR_IN_FIELD
0000s0sText::CSV_XS::::CSV_FLAGS_IS_BINARYText::CSV_XS::CSV_FLAGS_IS_BINARY
0000s0sText::CSV_XS::::CSV_FLAGS_IS_MISSINGText::CSV_XS::CSV_FLAGS_IS_MISSING
0000s0sText::CSV_XS::::CSV_FLAGS_IS_QUOTEDText::CSV_XS::CSV_FLAGS_IS_QUOTED
0000s0sText::CSV_XS::::CSV_TYPE_IVText::CSV_XS::CSV_TYPE_IV
0000s0sText::CSV_XS::::CSV_TYPE_NVText::CSV_XS::CSV_TYPE_NV
0000s0sText::CSV_XS::::CSV_TYPE_PVText::CSV_XS::CSV_TYPE_PV
0000s0sText::CSV_XS::::IVText::CSV_XS::IV
0000s0sText::CSV_XS::::NVText::CSV_XS::NV
0000s0sText::CSV_XS::::PVText::CSV_XS::PV
0000s0sText::CSV_XS::::_SetDiagInfoText::CSV_XS::_SetDiagInfo
0000s0sText::CSV_XS::::__ANON__[:1280]Text::CSV_XS::__ANON__[:1280]
0000s0sText::CSV_XS::::__ANON__[:1281]Text::CSV_XS::__ANON__[:1281]
0000s0sText::CSV_XS::::__ANON__[:1282]Text::CSV_XS::__ANON__[:1282]
0000s0sText::CSV_XS::::__ANON__[:58]Text::CSV_XS::__ANON__[:58]
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::::_supported_formulaText::CSV_XS::_supported_formula
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_unquoted_escapeText::CSV_XS::allow_unquoted_escape
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::::combineText::CSV_XS::combine
0000s0sText::CSV_XS::::comment_strText::CSV_XS::comment_str
0000s0sText::CSV_XS::::decode_utf8Text::CSV_XS::decode_utf8
0000s0sText::CSV_XS::::diag_verboseText::CSV_XS::diag_verbose
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::::escape_charText::CSV_XS::escape_char
0000s0sText::CSV_XS::::escape_nullText::CSV_XS::escape_null
0000s0sText::CSV_XS::::fieldsText::CSV_XS::fields
0000s0sText::CSV_XS::::formulaText::CSV_XS::formula
0000s0sText::CSV_XS::::formula_handlingText::CSV_XS::formula_handling
0000s0sText::CSV_XS::::fragmentText::CSV_XS::fragment
0000s0sText::CSV_XS::::getline_hrText::CSV_XS::getline_hr
0000s0sText::CSV_XS::::headerText::CSV_XS::header
0000s0sText::CSV_XS::::is_binaryText::CSV_XS::is_binary
0000s0sText::CSV_XS::::is_missingText::CSV_XS::is_missing
0000s0sText::CSV_XS::::is_quotedText::CSV_XS::is_quoted
0000s0sText::CSV_XS::::keep_meta_infoText::CSV_XS::keep_meta_info
0000s0sText::CSV_XS::::known_attributesText::CSV_XS::known_attributes
0000s0sText::CSV_XS::::meta_infoText::CSV_XS::meta_info
0000s0sText::CSV_XS::::parseText::CSV_XS::parse
0000s0sText::CSV_XS::::print_hrText::CSV_XS::print_hr
0000s0sText::CSV_XS::::quoteText::CSV_XS::quote
0000s0sText::CSV_XS::::quote_binaryText::CSV_XS::quote_binary
0000s0sText::CSV_XS::::quote_charText::CSV_XS::quote_char
0000s0sText::CSV_XS::::quote_emptyText::CSV_XS::quote_empty
0000s0sText::CSV_XS::::quote_nullText::CSV_XS::quote_null
0000s0sText::CSV_XS::::quote_spaceText::CSV_XS::quote_space
0000s0sText::CSV_XS::::record_numberText::CSV_XS::record_number
0000s0sText::CSV_XS::::sayText::CSV_XS::say
0000s0sText::CSV_XS::::sepText::CSV_XS::sep
0000s0sText::CSV_XS::::sep_charText::CSV_XS::sep_char
0000s0sText::CSV_XS::::skip_empty_rowsText::CSV_XS::skip_empty_rows
0000s0sText::CSV_XS::::statusText::CSV_XS::status
0000s0sText::CSV_XS::::strictText::CSV_XS::strict
0000s0sText::CSV_XS::::stringText::CSV_XS::string
0000s0sText::CSV_XS::::typesText::CSV_XS::types
0000s0sText::CSV_XS::::undef_strText::CSV_XS::undef_str
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
014µsProfile data that couldn't be associated with a specific line:
# spent 4µs making 1 call to DynaLoader::BEGIN@112
118µspackage Text::CSV_XS;
2
3# Copyright (c) 2007-2022 H.Merijn Brand. All rights reserved.
4# Copyright (c) 1998-2001 Jochen Wiedmann. All rights reserved.
5# 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# HISTORY
11#
12# 0.24 -
13# H.Merijn Brand (h.m.brand@xs4all.nl)
14# 0.10 - 0.23
15# Jochen Wiedmann <joe@ispsoft.de>
16# Based on (the original) Text::CSV by:
17# Alan Citterman <alan@mfgrtl.com>
18
1918µsrequire 5.006001;
20
21220µs210µs
# spent 9µs (8+1) within Text::CSV_XS::BEGIN@21 which was called: # once (8µs+1µs) by Text::CSV::BEGIN@1 at line 21
use strict;
# spent 9µs making 1 call to Text::CSV_XS::BEGIN@21 # spent 1µs making 1 call to strict::import
22216µs241µs
# spent 23µs (4+18) within Text::CSV_XS::BEGIN@22 which was called: # once (4µs+18µs) by Text::CSV::BEGIN@1 at line 22
use warnings;
# spent 23µs making 1 call to Text::CSV_XS::BEGIN@22 # spent 18µs making 1 call to warnings::import
23
241800nsrequire Exporter;
25221µs212µs
# spent 12µs (12+300ns) within Text::CSV_XS::BEGIN@25 which was called: # once (12µs+300ns) by Text::CSV::BEGIN@1 at line 25
use XSLoader;
# spent 12µs making 1 call to Text::CSV_XS::BEGIN@25 # spent 300ns making 1 call to Text::CSV_XS::__ANON__
26220µs239µs
# spent 21µs (4+18) within Text::CSV_XS::BEGIN@26 which was called: # once (4µs+18µs) by Text::CSV::BEGIN@1 at line 26
use Carp;
# spent 21µs making 1 call to Text::CSV_XS::BEGIN@26 # spent 18µs making 1 call to Exporter::import
27
282118µs248µs
# spent 26µs (3+22) within Text::CSV_XS::BEGIN@28 which was called: # once (3µs+22µs) by Text::CSV::BEGIN@1 at line 28
use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS );
# spent 26µs making 1 call to Text::CSV_XS::BEGIN@28 # spent 22µs making 1 call to vars::import
291200ns$VERSION = "1.48";
3017µs@ISA = qw( Exporter );
311164µs1173µsXSLoader::load ("Text::CSV_XS", $VERSION);
# spent 173µs making 1 call to XSLoader::load
32
33sub PV { 0 } sub CSV_TYPE_PV { PV }
34sub IV { 1 } sub CSV_TYPE_IV { IV }
35sub NV { 2 } sub CSV_TYPE_NV { NV }
36
37sub CSV_FLAGS_IS_QUOTED { 0x0001 }
38sub CSV_FLAGS_IS_BINARY { 0x0002 }
39sub CSV_FLAGS_ERROR_IN_FIELD { 0x0004 }
40sub CSV_FLAGS_IS_MISSING { 0x0010 }
41
4212µs%EXPORT_TAGS = (
43 CONSTANTS => [qw(
44 CSV_FLAGS_IS_QUOTED
45 CSV_FLAGS_IS_BINARY
46 CSV_FLAGS_ERROR_IN_FIELD
47 CSV_FLAGS_IS_MISSING
48
49 CSV_TYPE_PV
50 CSV_TYPE_IV
51 CSV_TYPE_NV
52 )],
53 );
5411µs@EXPORT_OK = (qw( csv PV IV NV ), @{$EXPORT_TAGS{CONSTANTS}});
55
561300nsif ($] < 5.008002) {
5725.92ms234µs
# spent 19µs (4+15) within Text::CSV_XS::BEGIN@57 which was called: # once (4µs+15µs) by Text::CSV::BEGIN@1 at line 57
no warnings "redefine";
# spent 19µs making 1 call to Text::CSV_XS::BEGIN@57 # spent 15µs making 1 call to warnings::unimport
58 *utf8::decode = sub {};
59 }
60
61# version
62#
63# class/object method expecting no arguments and returning the version
64# number of Text::CSV. there are no side-effects.
65
66sub version {
67 return $VERSION;
68 } # version
69
70# new
71#
72# class/object method expecting no arguments and returning a reference to
73# a newly created Text::CSV object.
74
7518µsmy %def_attr = (
76 'eol' => '',
77 'sep_char' => ',',
78 'quote_char' => '"',
79 'escape_char' => '"',
80 'binary' => 0,
81 'decode_utf8' => 1,
82 'auto_diag' => 0,
83 'diag_verbose' => 0,
84 'strict' => 0,
85 'blank_is_undef' => 0,
86 'empty_is_undef' => 0,
87 'allow_whitespace' => 0,
88 'allow_loose_quotes' => 0,
89 'allow_loose_escapes' => 0,
90 'allow_unquoted_escape' => 0,
91 'always_quote' => 0,
92 'quote_empty' => 0,
93 'quote_space' => 1,
94 'quote_binary' => 1,
95 'escape_null' => 1,
96 'keep_meta_info' => 0,
97 'verbatim' => 0,
98 'formula' => 0,
99 'skip_empty_rows' => 0,
100 'undef_str' => undef,
101 'comment_str' => undef,
102 'types' => undef,
103 'callbacks' => undef,
104
105 '_EOF' => "",
106 '_RECNO' => 0,
107 '_STATUS' => undef,
108 '_FIELDS' => undef,
109 '_FFLAGS' => undef,
110 '_STRING' => undef,
111 '_ERROR_INPUT' => undef,
112
# spent 4µs within DynaLoader::BEGIN@112 which was called: # once (4µs+0s) by XSLoader::load at line 0
'_COLUMN_NAMES' => undef,
113 '_BOUND_COLUMNS' => undef,
114 '_AHEAD' => undef,
115 '_FORMULA_CB' => undef,
116
117 'ENCODING' => undef,
118 );
11912µsmy %attr_alias = (
120 'quote_always' => "always_quote",
121 'verbose_diag' => "diag_verbose",
122 'quote_null' => "escape_null",
123 'escape' => "escape_char",
124 'comment' => "comment_str",
125 );
12616µs12µsmy $last_new_err = Text::CSV_XS->SetDiag (0);
# spent 2µs making 1 call to Text::CSV_XS::SetDiag
1271300nsmy $ebcdic = ord ("A") == 0xC1; # Faster than $Config{'ebcdic'}
1281100nsmy @internal_kh;
129
130# NOT a method: is also used before bless
131
# spent 182µs within Text::CSV_XS::_unhealthy_whitespace which was called 105 times, avg 2µs/call: # 105 times (182µs+0s) by Text::CSV_XS::_check_sanity at line 177, avg 2µs/call
sub _unhealthy_whitespace {
13210539µs my ($self, $aw) = @_;
133105149µs $aw or return 0; # no checks needed without allow_whitespace
134
135 my $quo = $self->{'quote'};
136 defined $quo && length ($quo) or $quo = $self->{'quote_char'};
137 my $esc = $self->{'escape_char'};
138
139 defined $quo && $quo =~ m/^[ \t]/ and return 1002;
140 defined $esc && $esc =~ m/^[ \t]/ and return 1002;
141
142 return 0;
143 } # _unhealty_whitespace
144
145
# spent 1.57ms (1.11+459µs) within Text::CSV_XS::_check_sanity which was called 105 times, avg 15µs/call: # 105 times (1.11ms+459µs) by Text::CSV_XS::new at line 245, avg 15µs/call
sub _check_sanity {
14610522µs my $self = shift;
147
14810552µs my $eol = $self->{'eol'};
14910542µs my $sep = $self->{'sep'};
15010564µs defined $sep && length ($sep) or $sep = $self->{'sep_char'};
15110530µs my $quo = $self->{'quote'};
15210530µs defined $quo && length ($quo) or $quo = $self->{'quote_char'};
15310524µs my $esc = $self->{'escape_char'};
154
155# use DP;::diag ("SEP: '", DPeek ($sep),
156# "', QUO: '", DPeek ($quo),
157# "', ESC: '", DPeek ($esc),"'");
158
159 # sep_char should not be undefined
16010524µs $sep ne "" or return 1008;
16110531µs length ($sep) > 16 and return 1006;
162105363µs105233µs $sep =~ m/[\r\n]/ and return 1003;
# spent 233µs making 105 calls to Text::CSV_XS::CORE:match, avg 2µs/call
163
16410549µs if (defined $quo) {
16510526µs $quo eq $sep and return 1001;
16610517µs length ($quo) > 16 and return 1007;
167105125µs10523µs $quo =~ m/[\r\n]/ and return 1003;
# spent 23µs making 105 calls to Text::CSV_XS::CORE:match, avg 221ns/call
168 }
16910546µs if (defined $esc) {
17010522µs $esc eq $sep and return 1001;
171105110µs10520µs $esc =~ m/[\r\n]/ and return 1003;
# spent 20µs making 105 calls to Text::CSV_XS::CORE:match, avg 190ns/call
172 }
17310542µs if (defined $eol) {
174 length ($eol) > 16 and return 1005;
175 }
176
177105305µs105182µs return _unhealthy_whitespace ($self, $self->{'allow_whitespace'});
# spent 182µs making 105 calls to Text::CSV_XS::_unhealthy_whitespace, avg 2µs/call
178 } # _check_sanity
179
180sub known_attributes {
181 sort grep !m/^_/ => "sep", "quote", keys %def_attr;
182 } # known_attributes
183
184
# spent 12.5ms (10.0+2.49) within Text::CSV_XS::new which was called 105 times, avg 119µs/call: # 105 times (10.0ms+2.49ms) by Text::CSV_XS::_csv_attr at line 1293, avg 119µs/call
sub new {
185105470µs105145µs $last_new_err = Text::CSV_XS->SetDiag (1000,
# spent 145µs making 105 calls to Text::CSV_XS::SetDiag, avg 1µs/call
186 "usage: my \$csv = Text::CSV_XS->new ([{ option => value, ... }]);");
187
18810530µs my $proto = shift;
18910551µs my $class = ref $proto || $proto or return;
19010575µs @_ > 0 && ref $_[0] ne "HASH" and return;
19110524µs my $attr = shift || {};
192 my %attr = map {
1936301.10ms630476µs my $k = m/^[a-zA-Z]\w+$/ ? lc $_ : $_;
# spent 476µs making 630 calls to Text::CSV_XS::CORE:match, avg 756ns/call
194630123µs exists $attr_alias{$k} and $k = $attr_alias{$k};
195630229µs ($k => $attr->{$_});
196105700µs } keys %{$attr};
197
198105182µs my $sep_aliased = 0;
19910551µs if (exists $attr{'sep'}) {
200 $attr{'sep_char'} = delete $attr{'sep'};
201 $sep_aliased = 1;
202 }
20310520µs my $quote_aliased = 0;
20410528µs if (exists $attr{'quote'}) {
205 $attr{'quote_char'} = delete $attr{'quote'};
206 $quote_aliased = 1;
207 }
208 exists $attr{'formula_handling'} and
20910530µs $attr{'formula'} = delete $attr{'formula_handling'};
21010545µs my $attr_formula = delete $attr{'formula'};
211
212105206µs for (keys %attr) {
213630744µs630136µs if (m/^[a-z]/ && exists $def_attr{$_}) {
# spent 136µs making 630 calls to Text::CSV_XS::CORE:match, avg 216ns/call
214 # uncoverable condition false
215630623µs63085µs defined $attr{$_} && m/_char$/ and utf8::decode ($attr{$_});
# spent 85µs making 630 calls to Text::CSV_XS::CORE:match, avg 135ns/call
216630128µs next;
217 }
218# croak?
219 $last_new_err = Text::CSV_XS->SetDiag (1000, "INI - Unknown attribute '$_'");
220 $attr{'auto_diag'} and error_diag ();
221 return;
222 }
22310531µs if ($sep_aliased) {
224 my @b = unpack "U0C*", $attr{'sep_char'};
225 if (@b > 1) {
226 $attr{'sep'} = $attr{'sep_char'};
227 $attr{'sep_char'} = "\0";
228 }
229 else {
230 $attr{'sep'} = undef;
231 }
232 }
23310519µs if ($quote_aliased and defined $attr{'quote_char'}) {
234 my @b = unpack "U0C*", $attr{'quote_char'};
235 if (@b > 1) {
236 $attr{'quote'} = $attr{'quote_char'};
237 $attr{'quote_char'} = "\0";
238 }
239 else {
240 $attr{'quote'} = undef;
241 }
242 }
243
2441054.36ms my $self = { %def_attr, %attr };
245105160µs1051.57ms if (my $ec = _check_sanity ($self)) {
# spent 1.57ms making 105 calls to Text::CSV_XS::_check_sanity, avg 15µs/call
246 $last_new_err = Text::CSV_XS->SetDiag ($ec);
247 $attr{'auto_diag'} and error_diag ();
248 return;
249 }
25010589µs if (defined $self->{'callbacks'} && ref $self->{'callbacks'} ne "HASH") {
251 carp ("The 'callbacks' attribute is set but is not a hash: ignored\n");
252 $self->{'callbacks'} = undef;
253 }
254
255105251µs10576µs $last_new_err = Text::CSV_XS->SetDiag (0);
# spent 76µs making 105 calls to Text::CSV_XS::SetDiag, avg 725ns/call
256105328µs defined $\ && !exists $attr{'eol'} and $self->{'eol'} = $\;
25710541µs bless $self, $class;
25810548µs defined $self->{'types'} and $self->types ($self->{'types'});
25910522µs defined $attr_formula and $self->{'formula'} = _supported_formula ($self, $attr_formula);
260105227µs $self;
261 } # new
262
263# Keep in sync with XS!
26415µsmy %_cache_id = ( # Only expose what is accessed from within PM
265 'quote_char' => 0,
266 'escape_char' => 1,
267 'sep_char' => 2,
268 'sep' => 39, # 39 .. 55
269 'binary' => 3,
270 'keep_meta_info' => 4,
271 'always_quote' => 5,
272 'allow_loose_quotes' => 6,
273 'allow_loose_escapes' => 7,
274 'allow_unquoted_escape' => 8,
275 'allow_whitespace' => 9,
276 'blank_is_undef' => 10,
277 'eol' => 11,
278 'quote' => 15,
279 'verbatim' => 22,
280 'empty_is_undef' => 23,
281 'auto_diag' => 24,
282 'diag_verbose' => 33,
283 'quote_space' => 25,
284 'quote_empty' => 37,
285 'quote_binary' => 32,
286 'escape_null' => 31,
287 'decode_utf8' => 35,
288 '_has_ahead' => 30,
289 '_has_hooks' => 36,
290 '_is_bound' => 26, # 26 .. 29
291 'formula' => 38,
292 'strict' => 42,
293 'skip_empty_rows' => 43,
294 'undef_str' => 46,
295 'comment_str' => 54,
296 'types' => 62,
297 );
298
299# A `character'
300sub _set_attr_C {
301 my ($self, $name, $val, $ec) = @_;
302 defined $val and utf8::decode ($val);
303 $self->{$name} = $val;
304 $ec = _check_sanity ($self) and croak ($self->SetDiag ($ec));
305 $self->_cache_set ($_cache_id{$name}, $val);
306 } # _set_attr_C
307
308# A flag
309
# spent 997µs (906+90) within Text::CSV_XS::_set_attr_X which was called 105 times, avg 9µs/call: # 105 times (906µs+90µs) by Text::CSV_XS::callbacks at line 670, avg 9µs/call
sub _set_attr_X {
310105299µs my ($self, $name, $val) = @_;
31110534µs defined $val or $val = 0;
31210583µs $self->{$name} = $val;
313105437µs10590µs $self->_cache_set ($_cache_id{$name}, 0 + $val);
# spent 90µs making 105 calls to Text::CSV_XS::_cache_set, avg 862ns/call
314 } # _set_attr_X
315
316# A number
317sub _set_attr_N {
318 my ($self, $name, $val) = @_;
319 $self->{$name} = $val;
320 $self->_cache_set ($_cache_id{$name}, 0 + $val);
321 } # _set_attr_N
322
323# Accessor methods.
324# It is unwise to change them halfway through a single file!
325sub quote_char {
326 my $self = shift;
327 if (@_) {
328 $self->_set_attr_C ("quote_char", shift);
329 $self->_cache_set ($_cache_id{'quote'}, "");
330 }
331 $self->{'quote_char'};
332 } # quote_char
333
334sub quote {
335 my $self = shift;
336 if (@_) {
337 my $quote = shift;
338 defined $quote or $quote = "";
339 utf8::decode ($quote);
340 my @b = unpack "U0C*", $quote;
341 if (@b > 1) {
342 @b > 16 and croak ($self->SetDiag (1007));
343 $self->quote_char ("\0");
344 }
345 else {
346 $self->quote_char ($quote);
347 $quote = "";
348 }
349 $self->{'quote'} = $quote;
350
351 my $ec = _check_sanity ($self);
352 $ec and croak ($self->SetDiag ($ec));
353
354 $self->_cache_set ($_cache_id{'quote'}, $quote);
355 }
356 my $quote = $self->{'quote'};
357 defined $quote && length ($quote) ? $quote : $self->{'quote_char'};
358 } # quote
359
360sub escape_char {
361 my $self = shift;
362 if (@_) {
363 my $ec = shift;
364 $self->_set_attr_C ("escape_char", $ec);
365 $ec or $self->_set_attr_X ("escape_null", 0);
366 }
367 $self->{'escape_char'};
368 } # escape_char
369
370sub sep_char {
371 my $self = shift;
372 if (@_) {
373 $self->_set_attr_C ("sep_char", shift);
374 $self->_cache_set ($_cache_id{'sep'}, "");
375 }
376 $self->{'sep_char'};
377 } # sep_char
378
379sub sep {
380 my $self = shift;
381 if (@_) {
382 my $sep = shift;
383 defined $sep or $sep = "";
384 utf8::decode ($sep);
385 my @b = unpack "U0C*", $sep;
386 if (@b > 1) {
387 @b > 16 and croak ($self->SetDiag (1006));
388 $self->sep_char ("\0");
389 }
390 else {
391 $self->sep_char ($sep);
392 $sep = "";
393 }
394 $self->{'sep'} = $sep;
395
396 my $ec = _check_sanity ($self);
397 $ec and croak ($self->SetDiag ($ec));
398
399 $self->_cache_set ($_cache_id{'sep'}, $sep);
400 }
401 my $sep = $self->{'sep'};
402 defined $sep && length ($sep) ? $sep : $self->{'sep_char'};
403 } # sep
404
405sub eol {
406 my $self = shift;
407 if (@_) {
408 my $eol = shift;
409 defined $eol or $eol = "";
410 length ($eol) > 16 and croak ($self->SetDiag (1005));
411 $self->{'eol'} = $eol;
412 $self->_cache_set ($_cache_id{'eol'}, $eol);
413 }
414 $self->{'eol'};
415 } # eol
416
417sub always_quote {
418 my $self = shift;
419 @_ and $self->_set_attr_X ("always_quote", shift);
420 $self->{'always_quote'};
421 } # always_quote
422
423sub quote_space {
424 my $self = shift;
425 @_ and $self->_set_attr_X ("quote_space", shift);
426 $self->{'quote_space'};
427 } # quote_space
428
429sub quote_empty {
430 my $self = shift;
431 @_ and $self->_set_attr_X ("quote_empty", shift);
432 $self->{'quote_empty'};
433 } # quote_empty
434
435sub escape_null {
436 my $self = shift;
437 @_ and $self->_set_attr_X ("escape_null", shift);
438 $self->{'escape_null'};
439 } # escape_null
440sub quote_null { goto &escape_null; }
441
442sub quote_binary {
443 my $self = shift;
444 @_ and $self->_set_attr_X ("quote_binary", shift);
445 $self->{'quote_binary'};
446 } # quote_binary
447
448sub binary {
449 my $self = shift;
450 @_ and $self->_set_attr_X ("binary", shift);
451 $self->{'binary'};
452 } # binary
453
454sub strict {
455 my $self = shift;
456 @_ and $self->_set_attr_X ("strict", shift);
457 $self->{'strict'};
458 } # always_quote
459
460sub skip_empty_rows {
461 my $self = shift;
462 @_ and $self->_set_attr_X ("skip_empty_rows", shift);
463 $self->{'skip_empty_rows'};
464 } # always_quote
465
466sub _SetDiagInfo {
467 my ($self, $err, $msg) = @_;
468 $self->SetDiag ($err);
469 my $em = $self->error_diag ();
470 $em =~ s/^\d+$// and $msg =~ s/^/# /;
471 my $sep = $em =~ m/[;\n]$/ ? "\n\t" : ": ";
472 join $sep => grep m/\S\S\S/ => $em, $msg;
473 } # _SetDiagInfo
474
475sub _supported_formula {
476 my ($self, $f) = @_;
477 defined $f or return 5;
478 if ($self && $f && ref $f && ref $f eq "CODE") {
479 $self->{'_FORMULA_CB'} = $f;
480 return 6;
481 }
482 $f =~ m/^(?: 0 | none )$/xi ? 0 :
483 $f =~ m/^(?: 1 | die )$/xi ? 1 :
484 $f =~ m/^(?: 2 | croak )$/xi ? 2 :
485 $f =~ m/^(?: 3 | diag )$/xi ? 3 :
486 $f =~ m/^(?: 4 | empty | )$/xi ? 4 :
487 $f =~ m/^(?: 5 | undef )$/xi ? 5 :
488 $f =~ m/^(?: 6 | cb )$/xi ? 6 : do {
489 $self ||= "Text::CSV_XS";
490 croak ($self->_SetDiagInfo (1500, "formula-handling '$f' is not supported"));
491 };
492 } # _supported_formula
493
494sub formula {
495 my $self = shift;
496 @_ and $self->_set_attr_N ("formula", _supported_formula ($self, shift));
497 $self->{'formula'} == 6 or $self->{'_FORMULA_CB'} = undef;
498 [qw( none die croak diag empty undef cb )]->[_supported_formula ($self, $self->{'formula'})];
499 } # always_quote
500sub formula_handling {
501 my $self = shift;
502 $self->formula (@_);
503 } # formula_handling
504
505sub decode_utf8 {
506 my $self = shift;
507 @_ and $self->_set_attr_X ("decode_utf8", shift);
508 $self->{'decode_utf8'};
509 } # decode_utf8
510
511sub keep_meta_info {
512 my $self = shift;
513 if (@_) {
514 my $v = shift;
515 !defined $v || $v eq "" and $v = 0;
516 $v =~ m/^[0-9]/ or $v = lc $v eq "false" ? 0 : 1; # true/truth = 1
517 $self->_set_attr_X ("keep_meta_info", $v);
518 }
519 $self->{'keep_meta_info'};
520 } # keep_meta_info
521
522sub allow_loose_quotes {
523 my $self = shift;
524 @_ and $self->_set_attr_X ("allow_loose_quotes", shift);
525 $self->{'allow_loose_quotes'};
526 } # allow_loose_quotes
527
528sub allow_loose_escapes {
529 my $self = shift;
530 @_ and $self->_set_attr_X ("allow_loose_escapes", shift);
531 $self->{'allow_loose_escapes'};
532 } # allow_loose_escapes
533
534sub allow_whitespace {
535 my $self = shift;
536 if (@_) {
537 my $aw = shift;
538 _unhealthy_whitespace ($self, $aw) and
539 croak ($self->SetDiag (1002));
540 $self->_set_attr_X ("allow_whitespace", $aw);
541 }
542 $self->{'allow_whitespace'};
543 } # allow_whitespace
544
545sub allow_unquoted_escape {
546 my $self = shift;
547 @_ and $self->_set_attr_X ("allow_unquoted_escape", shift);
548 $self->{'allow_unquoted_escape'};
549 } # allow_unquoted_escape
550
551sub blank_is_undef {
552 my $self = shift;
553 @_ and $self->_set_attr_X ("blank_is_undef", shift);
554 $self->{'blank_is_undef'};
555 } # blank_is_undef
556
557sub empty_is_undef {
558 my $self = shift;
559 @_ and $self->_set_attr_X ("empty_is_undef", shift);
560 $self->{'empty_is_undef'};
561 } # empty_is_undef
562
563sub verbatim {
564 my $self = shift;
565 @_ and $self->_set_attr_X ("verbatim", shift);
566 $self->{'verbatim'};
567 } # verbatim
568
569sub undef_str {
570 my $self = shift;
571 if (@_) {
572 my $v = shift;
573 $self->{'undef_str'} = defined $v ? "$v" : undef;
574 $self->_cache_set ($_cache_id{'undef_str'}, $self->{'undef_str'});
575 }
576 $self->{'undef_str'};
577 } # undef_str
578
579sub comment_str {
580 my $self = shift;
581 if (@_) {
582 my $v = shift;
583 $self->{'comment_str'} = defined $v ? "$v" : undef;
584 $self->_cache_set ($_cache_id{'comment_str'}, $self->{'comment_str'});
585 }
586 $self->{'comment_str'};
587 } # comment_str
588
589sub auto_diag {
590 my $self = shift;
591 if (@_) {
592 my $v = shift;
593 !defined $v || $v eq "" and $v = 0;
594 $v =~ m/^[0-9]/ or $v = lc $v eq "false" ? 0 : 1; # true/truth = 1
595 $self->_set_attr_X ("auto_diag", $v);
596 }
597 $self->{'auto_diag'};
598 } # auto_diag
599
600sub diag_verbose {
601 my $self = shift;
602 if (@_) {
603 my $v = shift;
604 !defined $v || $v eq "" and $v = 0;
605 $v =~ m/^[0-9]/ or $v = lc $v eq "false" ? 0 : 1; # true/truth = 1
606 $self->_set_attr_X ("diag_verbose", $v);
607 }
608 $self->{'diag_verbose'};
609 } # diag_verbose
610
611# status
612#
613# object method returning the success or failure of the most recent
614# combine () or parse (). there are no side-effects.
615
616sub status {
617 my $self = shift;
618 return $self->{'_STATUS'};
619 } # status
620
621sub eof {
622 my $self = shift;
623 return $self->{'_EOF'};
624 } # status
625
626sub types {
627 my $self = shift;
628 if (@_) {
629 if (my $types = shift) {
630 $self->{'_types'} = join "", map { chr } @{$types};
631 $self->{'types'} = $types;
632 $self->_cache_set ($_cache_id{'types'}, $self->{'_types'});
633 }
634 else {
635 delete $self->{'types'};
636 delete $self->{'_types'};
637 $self->_cache_set ($_cache_id{'types'}, undef);
638 undef;
639 }
640 }
641 else {
642 $self->{'types'};
643 }
644 } # types
645
646
# spent 3.33ms (1.69+1.64) within Text::CSV_XS::callbacks which was called 105 times, avg 32µs/call: # 105 times (1.69ms+1.64ms) by Text::CSV_XS::csv at line 1460, avg 32µs/call
sub callbacks {
64710532µs my $self = shift;
64810550µs if (@_) {
64910517µs my $cb;
65010527µs my $hf = 0x00;
65110538µs if (defined $_[0]) {
65210591µs grep { !defined } @_ and croak ($self->SetDiag (1004));
653105177µs $cb = @_ == 1 && ref $_[0] eq "HASH" ? shift
654 : @_ % 2 == 0 ? { @_ }
655 : croak ($self->SetDiag (1004));
656105271µs foreach my $cbk (keys %{$cb}) {
657 # A key cannot be a ref. That would be stored as the *string
658 # 'SCALAR(0x1f3e710)' or 'ARRAY(0x1a5ae18)'
659105881µs105641µs $cbk =~ m/^[\w.]+$/ && ref $cb->{$cbk} eq "CODE" or
# spent 641µs making 105 calls to Text::CSV_XS::CORE:match, avg 6µs/call
660 croak ($self->SetDiag (1004));
661 }
66210534µs exists $cb->{'error'} and $hf |= 0x01;
66310557µs exists $cb->{'after_parse'} and $hf |= 0x02;
66410524µs exists $cb->{'before_print'} and $hf |= 0x04;
665 }
666 elsif (@_ > 1) {
667 # (undef, whatever)
668 croak ($self->SetDiag (1004));
669 }
670105312µs105997µs $self->_set_attr_X ("_has_hooks", $hf);
# spent 997µs making 105 calls to Text::CSV_XS::_set_attr_X, avg 9µs/call
67110544µs $self->{'callbacks'} = $cb;
672 }
673105123µs $self->{'callbacks'};
674 } # callbacks
675
676# error_diag
677#
678# If (and only if) an error occurred, this function returns a code that
679# indicates the reason of failure
680
681
# spent 2.25ms (2.12+130µs) within Text::CSV_XS::error_diag which was called 105 times, avg 21µs/call: # 105 times (2.12ms+130µs) by Text::CSV_XS::getline_all at line 1047, avg 21µs/call
sub error_diag {
68210534µs my $self = shift;
683105161µs my @diag = (0 + $last_new_err, $last_new_err, 0, 0, 0);
684
685 # Docs state to NEVER use UNIVERSAL::isa, because it will *never* call an
686 # overridden isa method in any class. Well, that is exacly what I want here
687105502µs105130µs if ($self && ref $self and # Not a class method or direct call
# spent 130µs making 105 calls to UNIVERSAL::isa, avg 1µs/call
688 UNIVERSAL::isa ($self, __PACKAGE__) && exists $self->{'_ERROR_DIAG'}) {
68910550µs $diag[0] = 0 + $self->{'_ERROR_DIAG'};
69010545µs $diag[1] = $self->{'_ERROR_DIAG'};
69110542µs $diag[2] = 1 + $self->{'_ERROR_POS'} if exists $self->{'_ERROR_POS'};
69210540µs $diag[3] = $self->{'_RECNO'};
69310521µs $diag[4] = $self->{'_ERROR_FLD'} if exists $self->{'_ERROR_FLD'};
694
695 $diag[0] && $self->{'callbacks'} && $self->{'callbacks'}{'error'} and
69610587µs return $self->{'callbacks'}{'error'}->(@diag);
697 }
698
699105201µs my $context = wantarray;
70010532µs unless (defined $context) { # Void context, auto-diag
70110549µs if ($diag[0] && $diag[0] != 2012) {
702 my $msg = "# CSV_XS ERROR: $diag[0] - $diag[1] \@ rec $diag[3] pos $diag[2]\n";
703 $diag[4] and $msg =~ s/$/ field $diag[4]/;
704
705 unless ($self && ref $self) { # auto_diag
706 # called without args in void context
707 warn $msg;
708 return;
709 }
710
711 $self->{'diag_verbose'} && $self->{'_ERROR_INPUT'} and
712 $msg .= $self->{'_ERROR_INPUT'}."\n".
713 (" " x ($diag[2] - 1))."^\n";
714
715 my $lvl = $self->{'auto_diag'};
716 if ($lvl < 2) {
717 my @c = caller (2);
718 if (@c >= 11 && $c[10] && ref $c[10] eq "HASH") {
719 my $hints = $c[10];
720 (exists $hints->{'autodie'} && $hints->{'autodie'} or
721 exists $hints->{'guard Fatal'} &&
722 !exists $hints->{'no Fatal'}) and
723 $lvl++;
724 # Future releases of autodie will probably set $^H{autodie}
725 # to "autodie @args", like "autodie :all" or "autodie open"
726 # so we can/should check for "open" or "new"
727 }
728 }
729 $lvl > 1 ? die $msg : warn $msg;
730 }
731105221µs return;
732 }
733 return $context ? @diag : $diag[1];
734 } # error_diag
735
736sub record_number {
737 my $self = shift;
738 return $self->{'_RECNO'};
739 } # record_number
740
741# string
742#
743# object method returning the result of the most recent combine () or the
744# input to the most recent parse (), whichever is more recent. there are
745# no side-effects.
746
747sub string {
748 my $self = shift;
749 return ref $self->{'_STRING'} ? ${$self->{'_STRING'}} : undef;
750 } # string
751
752# fields
753#
754# object method returning the result of the most recent parse () or the
755# input to the most recent combine (), whichever is more recent. there
756# are no side-effects.
757
758sub fields {
759 my $self = shift;
760 return ref $self->{'_FIELDS'} ? @{$self->{'_FIELDS'}} : undef;
761 } # fields
762
763# meta_info
764#
765# object method returning the result of the most recent parse () or the
766# input to the most recent combine (), whichever is more recent. there
767# are no side-effects. meta_info () returns (if available) some of the
768# field's properties
769
770sub meta_info {
771 my $self = shift;
772 return ref $self->{'_FFLAGS'} ? @{$self->{'_FFLAGS'}} : undef;
773 } # meta_info
774
775sub is_quoted {
776 my ($self, $idx) = @_;
777 ref $self->{'_FFLAGS'} &&
778 $idx >= 0 && $idx < @{$self->{'_FFLAGS'}} or return;
779 $self->{'_FFLAGS'}[$idx] & CSV_FLAGS_IS_QUOTED () ? 1 : 0;
780 } # is_quoted
781
782sub is_binary {
783 my ($self, $idx) = @_;
784 ref $self->{'_FFLAGS'} &&
785 $idx >= 0 && $idx < @{$self->{'_FFLAGS'}} or return;
786 $self->{'_FFLAGS'}[$idx] & CSV_FLAGS_IS_BINARY () ? 1 : 0;
787 } # is_binary
788
789sub is_missing {
790 my ($self, $idx) = @_;
791 $idx < 0 || !ref $self->{'_FFLAGS'} and return;
792 $idx >= @{$self->{'_FFLAGS'}} and return 1;
793 $self->{'_FFLAGS'}[$idx] & CSV_FLAGS_IS_MISSING () ? 1 : 0;
794 } # is_missing
795
796# combine
797#
798# Object method returning success or failure. The given arguments are
799# combined into a single comma-separated value. Failure can be the
800# result of no arguments or an argument containing an invalid character.
801# side-effects include:
802# setting status ()
803# setting fields ()
804# setting string ()
805# setting error_input ()
806
807sub combine {
808 my $self = shift;
809 my $str = "";
810 $self->{'_FIELDS'} = \@_;
811 $self->{'_STATUS'} = (@_ > 0) && $self->Combine (\$str, \@_, 0);
812 $self->{'_STRING'} = \$str;
813 $self->{'_STATUS'};
814 } # combine
815
816# parse
817#
818# Object method returning success or failure. The given argument is
819# expected to be a valid comma-separated value. Failure can be the
820# result of no arguments or an argument containing an invalid sequence
821# of characters. Side-effects include:
822# setting status ()
823# setting fields ()
824# setting meta_info ()
825# setting string ()
826# setting error_input ()
827
828sub parse {
829 my ($self, $str) = @_;
830
831 ref $str and croak ($self->SetDiag (1500));
832
833 my $fields = [];
834 my $fflags = [];
835 $self->{'_STRING'} = \$str;
836 if (defined $str && $self->Parse ($str, $fields, $fflags)) {
837 $self->{'_FIELDS'} = $fields;
838 $self->{'_FFLAGS'} = $fflags;
839 $self->{'_STATUS'} = 1;
840 }
841 else {
842 $self->{'_FIELDS'} = undef;
843 $self->{'_FFLAGS'} = undef;
844 $self->{'_STATUS'} = 0;
845 }
846 $self->{'_STATUS'};
847 } # parse
848
849
# spent 1.07ms within Text::CSV_XS::column_names which was called 105 times, avg 10µs/call: # 105 times (1.07ms+0s) by Text::CSV_XS::csv at line 1467, avg 10µs/call
sub column_names {
850105179µs my ($self, @keys) = @_;
851 @keys or
85210528µs return defined $self->{'_COLUMN_NAMES'} ? @{$self->{'_COLUMN_NAMES'}} : ();
853
854 @keys == 1 && ! defined $keys[0] and
85510568µs return $self->{'_COLUMN_NAMES'} = undef;
856
857105160µs if (@keys == 1 && ref $keys[0] eq "ARRAY") {
858 @keys = @{$keys[0]};
859 }
860 elsif (join "", map { defined $_ ? ref $_ : "" } @keys) {
861 croak ($self->SetDiag (3001));
862 }
863
86410549µs $self->{'_BOUND_COLUMNS'} && @keys != @{$self->{'_BOUND_COLUMNS'}} and
865 croak ($self->SetDiag (3003));
866
867105246µs $self->{'_COLUMN_NAMES'} = [ map { defined $_ ? $_ : "\cAUNDEF\cA" } @keys ];
868105224µs @{$self->{'_COLUMN_NAMES'}};
869 } # column_names
870
871sub header {
872 my ($self, $fh, @args) = @_;
873
874 $fh or croak ($self->SetDiag (1014));
875
876 my (@seps, %args);
877 for (@args) {
878 if (ref $_ eq "ARRAY") {
879 push @seps, @{$_};
880 next;
881 }
882 if (ref $_ eq "HASH") {
883 %args = %{$_};
884 next;
885 }
886 croak ('usage: $csv->header ($fh, [ seps ], { options })');
887 }
888
889 defined $args{'munge'} && !defined $args{'munge_column_names'} and
890 $args{'munge_column_names'} = $args{'munge'}; # munge as alias
891 defined $args{'detect_bom'} or $args{'detect_bom'} = 1;
892 defined $args{'set_column_names'} or $args{'set_column_names'} = 1;
893 defined $args{'munge_column_names'} or $args{'munge_column_names'} = "lc";
894
895 # Reset any previous leftovers
896 $self->{'_RECNO'} = 0;
897 $self->{'_AHEAD'} = undef;
898 $self->{'_COLUMN_NAMES'} = undef if $args{'set_column_names'};
899 $self->{'_BOUND_COLUMNS'} = undef if $args{'set_column_names'};
900
901 if (defined $args{'sep_set'}) {
902 ref $args{'sep_set'} eq "ARRAY" or
903 croak ($self->_SetDiagInfo (1500, "sep_set should be an array ref"));
904 @seps = @{$args{'sep_set'}};
905 }
906
907 $^O eq "MSWin32" and binmode $fh;
908 my $hdr = <$fh>;
909 # check if $hdr can be empty here, I don't think so
910 defined $hdr && $hdr ne "" or croak ($self->SetDiag (1010));
911
912 my %sep;
913 @seps or @seps = (",", ";");
914 foreach my $sep (@seps) {
915 index ($hdr, $sep) >= 0 and $sep{$sep}++;
916 }
917
918 keys %sep >= 2 and croak ($self->SetDiag (1011));
919
920 $self->sep (keys %sep);
921 my $enc = "";
922 if ($args{'detect_bom'}) { # UTF-7 is not supported
923 if ($hdr =~ s/^\x00\x00\xfe\xff//) { $enc = "utf-32be" }
924 elsif ($hdr =~ s/^\xff\xfe\x00\x00//) { $enc = "utf-32le" }
925 elsif ($hdr =~ s/^\xfe\xff//) { $enc = "utf-16be" }
926 elsif ($hdr =~ s/^\xff\xfe//) { $enc = "utf-16le" }
927 elsif ($hdr =~ s/^\xef\xbb\xbf//) { $enc = "utf-8" }
928 elsif ($hdr =~ s/^\xf7\x64\x4c//) { $enc = "utf-1" }
929 elsif ($hdr =~ s/^\xdd\x73\x66\x73//) { $enc = "utf-ebcdic" }
930 elsif ($hdr =~ s/^\x0e\xfe\xff//) { $enc = "scsu" }
931 elsif ($hdr =~ s/^\xfb\xee\x28//) { $enc = "bocu-1" }
932 elsif ($hdr =~ s/^\x84\x31\x95\x33//) { $enc = "gb-18030" }
933 elsif ($hdr =~ s/^\x{feff}//) { $enc = "" }
934
935 $self->{'ENCODING'} = $enc ? uc $enc : undef;
936
937 $hdr eq "" and croak ($self->SetDiag (1010));
938
939 if ($enc) {
940 $ebcdic && $enc eq "utf-ebcdic" and $enc = "";
941 if ($enc =~ m/([13]).le$/) {
942 my $l = 0 + $1;
943 my $x;
944 $hdr .= "\0" x $l;
945 read $fh, $x, $l;
946 }
947 if ($enc) {
948 if ($enc ne "utf-8") {
949 require Encode;
950 $hdr = Encode::decode ($enc, $hdr);
951 }
952 binmode $fh, ":encoding($enc)";
953 }
954 }
955 }
956
957 my ($ahead, $eol);
958 if ($hdr and $hdr =~ s/\Asep=(\S)([\r\n]+)//i) { # Also look in xs:Parse
959 $self->sep ($1);
960 length $hdr or $hdr = <$fh>;
961 }
962 if ($hdr =~ s/^([^\r\n]+)([\r\n]+)([^\r\n].+)\z/$1/s) {
963 $eol = $2;
964 $ahead = $3;
965 }
966
967 my $hr = \$hdr; # Will cause croak on perl-5.6.x
968 open my $h, "<", $hr or croak ($self->SetDiag (1010));
969
970 my $row = $self->getline ($h) or croak ();
971 close $h;
972
973 if ( $args{'munge_column_names'} eq "lc") {
974 $_ = lc for @{$row};
975 }
976 elsif ($args{'munge_column_names'} eq "uc") {
977 $_ = uc for @{$row};
978 }
979 elsif ($args{'munge_column_names'} eq "db") {
980 for (@{$row}) {
981 s/\W+/_/g;
982 s/^_+//;
983 $_ = lc;
984 }
985 }
986
987 if ($ahead) { # Must be after getline, which creates the cache
988 $self->_cache_set ($_cache_id{'_has_ahead'}, 1);
989 $self->{'_AHEAD'} = $ahead;
990 $eol =~ m/^\r([^\n]|\z)/ and $self->eol ($eol);
991 }
992
993 my @hdr = @{$row};
994 ref $args{'munge_column_names'} eq "CODE" and
995 @hdr = map { $args{'munge_column_names'}->($_) } @hdr;
996 ref $args{'munge_column_names'} eq "HASH" and
997 @hdr = map { $args{'munge_column_names'}->{$_} || $_ } @hdr;
998 my %hdr; $hdr{$_}++ for @hdr;
999 exists $hdr{""} and croak ($self->SetDiag (1012));
1000 unless (keys %hdr == @hdr) {
1001 croak ($self->_SetDiagInfo (1013, join ", " =>
1002 map { "$_ ($hdr{$_})" } grep { $hdr{$_} > 1 } keys %hdr));
1003 }
1004 $args{'set_column_names'} and $self->column_names (@hdr);
1005 wantarray ? @hdr : $self;
1006 } # header
1007
1008sub bind_columns {
1009 my ($self, @refs) = @_;
1010 @refs or
1011 return defined $self->{'_BOUND_COLUMNS'} ? @{$self->{'_BOUND_COLUMNS'}} : undef;
1012
1013 if (@refs == 1 && ! defined $refs[0]) {
1014 $self->{'_COLUMN_NAMES'} = undef;
1015 return $self->{'_BOUND_COLUMNS'} = undef;
1016 }
1017
1018 $self->{'_COLUMN_NAMES'} && @refs != @{$self->{'_COLUMN_NAMES'}} and
1019 croak ($self->SetDiag (3003));
1020
1021 join "", map { ref $_ eq "SCALAR" ? "" : "*" } @refs and
1022 croak ($self->SetDiag (3004));
1023
1024 $self->_set_attr_N ("_is_bound", scalar @refs);
1025 $self->{'_BOUND_COLUMNS'} = [ @refs ];
1026 @refs;
1027 } # bind_columns
1028
1029sub getline_hr {
1030 my ($self, @args, %hr) = @_;
1031 $self->{'_COLUMN_NAMES'} or croak ($self->SetDiag (3002));
1032 my $fr = $self->getline (@args) or return;
1033 if (ref $self->{'_FFLAGS'}) { # missing
1034 $self->{'_FFLAGS'}[$_] = CSV_FLAGS_IS_MISSING ()
1035 for (@{$fr} ? $#{$fr} + 1 : 0) .. $#{$self->{'_COLUMN_NAMES'}};
1036 @{$fr} == 1 && (!defined $fr->[0] || $fr->[0] eq "") and
1037 $self->{'_FFLAGS'}[0] ||= CSV_FLAGS_IS_MISSING ();
1038 }
1039 @hr{@{$self->{'_COLUMN_NAMES'}}} = @{$fr};
1040 \%hr;
1041 } # getline_hr
1042
1043
# spent 53714s (31.9ms+53714) within Text::CSV_XS::getline_hr_all which was called 105 times, avg 512s/call: # 105 times (31.9ms+53714s) by Text::CSV_XS::csv at line 1489, avg 512s/call
sub getline_hr_all {
104410541µs my ($self, @args) = @_;
104510551µs $self->{'_COLUMN_NAMES'} or croak ($self->SetDiag (3002));
104610597µs my @cn = @{$self->{'_COLUMN_NAMES'}};
104738768.26s710325107433s [ map { my %h; @h{@cn} = @{$_}; \%h } @{$self->getline_all (@args)} ];
# spent 53714s making 105 calls to Text::CSV_XS::getline_all, avg 512s/call # spent 53705s making 133035 calls to Text::CSV_XS::__ANON__[Text/CSV_XS.pm:1460], avg 404ms/call # spent 5.96s making 153300 calls to IO::Handle::getline, avg 39µs/call # spent 5.31s making 153300 calls to Text::CSV_XS::CORE:readline, avg 35µs/call # spent 2.08s making 135240 calls to Encode::utf8::decode, avg 15µs/call # spent 778ms making 135240 calls to Encode::Encoding::renewed, avg 6µs/call # spent 2.25ms making 105 calls to Text::CSV_XS::error_diag, avg 21µs/call
1048 } # getline_hr_all
1049
1050sub say {
1051 my ($self, $io, @f) = @_;
1052 my $eol = $self->eol ();
1053 $eol eq "" and $self->eol ($\ || $/);
1054 # say ($fh, undef) does not propage actual undef to print ()
1055 my $state = $self->print ($io, @f == 1 && !defined $f[0] ? undef : @f);
1056 $self->eol ($eol);
1057 return $state;
1058 } # say
1059
1060sub print_hr {
1061 my ($self, $io, $hr) = @_;
1062 $self->{'_COLUMN_NAMES'} or croak ($self->SetDiag (3009));
1063 ref $hr eq "HASH" or croak ($self->SetDiag (3010));
1064 $self->print ($io, [ map { $hr->{$_} } $self->column_names () ]);
1065 } # print_hr
1066
1067sub fragment {
1068 my ($self, $io, $spec) = @_;
1069
1070 my $qd = qr{\s* [0-9]+ \s* }x; # digit
1071 my $qs = qr{\s* (?: [0-9]+ | \* ) \s*}x; # digit or star
1072 my $qr = qr{$qd (?: - $qs )?}x; # range
1073 my $qc = qr{$qr (?: ; $qr )*}x; # list
1074 defined $spec && $spec =~ m{^ \s*
1075 \x23 ? \s* # optional leading #
1076 ( row | col | cell ) \s* =
1077 ( $qc # for row and col
1078 | $qd , $qd (?: - $qs , $qs)? # for cell (ranges)
1079 (?: ; $qd , $qd (?: - $qs , $qs)? )* # and cell (range) lists
1080 ) \s* $}xi or croak ($self->SetDiag (2013));
1081 my ($type, $range) = (lc $1, $2);
1082
1083 my @h = $self->column_names ();
1084
1085 my @c;
1086 if ($type eq "cell") {
1087 my @spec;
1088 my $min_row;
1089 my $max_row = 0;
1090 for (split m/\s*;\s*/ => $range) {
1091 my ($tlr, $tlc, $brr, $brc) = (m{
1092 ^ \s* ([0-9]+ ) \s* , \s* ([0-9]+ ) \s*
1093 (?: - \s* ([0-9]+ | \*) \s* , \s* ([0-9]+ | \*) \s* )?
1094 $}x) or croak ($self->SetDiag (2013));
1095 defined $brr or ($brr, $brc) = ($tlr, $tlc);
1096 $tlr == 0 || $tlc == 0 ||
1097 ($brr ne "*" && ($brr == 0 || $brr < $tlr)) ||
1098 ($brc ne "*" && ($brc == 0 || $brc < $tlc))
1099 and croak ($self->SetDiag (2013));
1100 $tlc--;
1101 $brc-- unless $brc eq "*";
1102 defined $min_row or $min_row = $tlr;
1103 $tlr < $min_row and $min_row = $tlr;
1104 $brr eq "*" || $brr > $max_row and
1105 $max_row = $brr;
1106 push @spec, [ $tlr, $tlc, $brr, $brc ];
1107 }
1108 my $r = 0;
1109 while (my $row = $self->getline ($io)) {
1110 ++$r < $min_row and next;
1111 my %row;
1112 my $lc;
1113 foreach my $s (@spec) {
1114 my ($tlr, $tlc, $brr, $brc) = @{$s};
1115 $r < $tlr || ($brr ne "*" && $r > $brr) and next;
1116 !defined $lc || $tlc < $lc and $lc = $tlc;
1117 my $rr = $brc eq "*" ? $#{$row} : $brc;
1118 $row{$_} = $row->[$_] for $tlc .. $rr;
1119 }
1120 push @c, [ @row{sort { $a <=> $b } keys %row } ];
1121 if (@h) {
1122 my %h; @h{@h} = @{$c[-1]};
1123 $c[-1] = \%h;
1124 }
1125 $max_row ne "*" && $r == $max_row and last;
1126 }
1127 return \@c;
1128 }
1129
1130 # row or col
1131 my @r;
1132 my $eod = 0;
1133 for (split m/\s*;\s*/ => $range) {
1134 my ($from, $to) = m/^\s* ([0-9]+) (?: \s* - \s* ([0-9]+ | \* ))? \s* $/x
1135 or croak ($self->SetDiag (2013));
1136 $to ||= $from;
1137 $to eq "*" and ($to, $eod) = ($from, 1);
1138 # $to cannot be <= 0 due to regex and ||=
1139 $from <= 0 || $to < $from and croak ($self->SetDiag (2013));
1140 $r[$_] = 1 for $from .. $to;
1141 }
1142
1143 my $r = 0;
1144 $type eq "col" and shift @r;
1145 $_ ||= 0 for @r;
1146 while (my $row = $self->getline ($io)) {
1147 $r++;
1148 if ($type eq "row") {
1149 if (($r > $#r && $eod) || $r[$r]) {
1150 push @c, $row;
1151 if (@h) {
1152 my %h; @h{@h} = @{$c[-1]};
1153 $c[-1] = \%h;
1154 }
1155 }
1156 next;
1157 }
1158 push @c, [ map { ($_ > $#r && $eod) || $r[$_] ? $row->[$_] : () } 0..$#{$row} ];
1159 if (@h) {
1160 my %h; @h{@h} = @{$c[-1]};
1161 $c[-1] = \%h;
1162 }
1163 }
1164
1165 return \@c;
1166 } # fragment
1167
11681100nsmy $csv_usage = q{usage: my $aoa = csv (in => $file);};
1169
1170
# spent 35.1ms (8.90+26.2) within Text::CSV_XS::_csv_attr which was called 105 times, avg 335µs/call: # 105 times (8.90ms+26.2ms) by Text::CSV_XS::csv at line 1329, avg 335µs/call
sub _csv_attr {
1171105508µs my %attr = (@_ == 1 && ref $_[0] eq "HASH" ? %{$_[0]} : @_) or croak ();
1172
117310564µs $attr{'binary'} = 1;
1174
1175105100µs my $enc = delete $attr{'enc'} || delete $attr{'encoding'} || "";
117610532µs $enc eq "auto" and ($attr{'detect_bom'}, $enc) = (1, "");
1177105963µs105589µs my $stack = $enc =~ s/(:\w.*)// ? $1 : "";
# spent 589µs making 105 calls to Text::CSV_XS::CORE:subst, avg 6µs/call
1178105706µs105438µs $enc =~ m/^[-\w.]+$/ and $enc = ":encoding($enc)";
# spent 438µs making 105 calls to Text::CSV_XS::CORE:match, avg 4µs/call
117910533µs $enc .= $stack;
1180
118110514µs my $fh;
118210517µs my $sink = 0;
118310518µs my $cls = 0; # If I open a file, I have to close it
118410557µs my $in = delete $attr{'in'} || delete $attr{'file'} or croak ($csv_usage);
1185 my $out = exists $attr{'out'} && !$attr{'out'} ? \"skip"
118610585µs : delete $attr{'out'} || delete $attr{'file'};
1187
118810559µs ref $in eq "CODE" || ref $in eq "ARRAY" and $out ||= \*STDOUT;
1189
119010531µs $in && $out && !ref $in && !ref $out and croak (join "\n" =>
1191 qq{Cannot use a string for both in and out. Instead use:},
1192 qq{ csv (in => csv (in => "$in"), out => "$out");\n});
1193
119410516µs if ($out) {
1195 if (ref $out and ("ARRAY" eq ref $out or "HASH" eq ref $out)) {
1196 delete $attr{'out'};
1197 $sink = 1;
1198 }
1199 elsif ((ref $out and "SCALAR" ne ref $out) or "GLOB" eq ref \$out) {
1200 $fh = $out;
1201 }
1202 elsif (ref $out and "SCALAR" eq ref $out and defined ${$out} and ${$out} eq "skip") {
1203 delete $attr{'out'};
1204 $sink = 1;
1205 }
1206 else {
1207 open $fh, ">", $out or croak ("$out: $!");
1208 $cls = 1;
1209 }
1210 if ($fh) {
1211 if ($enc) {
1212 binmode $fh, $enc;
1213 my $fn = fileno $fh; # This is a workaround for a bug in PerlIO::via::gzip
1214 }
1215 unless (defined $attr{'eol'}) {
1216 my @layers = eval { PerlIO::get_layers ($fh) };
1217 $attr{'eol'} = (grep m/crlf/ => @layers) ? "\n" : "\r\n";
1218 }
1219 }
1220 }
1221
1222105337µs if ( ref $in eq "CODE" or ref $in eq "ARRAY") {
1223 # All done
1224 }
1225 elsif (ref $in eq "SCALAR") {
1226 # Strings with code points over 0xFF may not be mapped into in-memory file handles
1227 # "<$enc" does not change that :(
1228 open $fh, "<", $in or croak ("Cannot open from SCALAR using PerlIO");
1229 $cls = 1;
1230 }
1231 elsif (ref $in or "GLOB" eq ref \$in) {
1232 if (!ref $in && $] < 5.008005) {
1233 $fh = \*{$in}; # uncoverable statement ancient perl version required
1234 }
1235 else {
1236 $fh = $in;
1237 }
1238 }
1239 else {
12401075.64ms42121.0ms open $fh, "<$enc", $in or croak ("$in: $!");
# spent 12.7ms making 105 calls to Text::CSV_XS::CORE:open, avg 121µs/call # spent 6.16ms making 105 calls to Encode::find_encoding, avg 59µs/call # spent 1.57ms making 105 calls to Encode::Encoding::renew, avg 15µs/call # spent 309µs making 1 call to PerlIO::import # spent 227µs making 105 calls to Encode::Encoding::needs_lines, avg 2µs/call
124110543µs $cls = 1;
1242 }
124310530µs $fh || $sink or croak (qq{No valid source passed. "in" is required});
1244
124510563µs my $hdrs = delete $attr{'headers'};
124610526µs my $frag = delete $attr{'fragment'};
124710534µs my $key = delete $attr{'key'};
124810525µs my $val = delete $attr{'value'};
1249 my $kh = delete $attr{'keep_headers'} ||
1250 delete $attr{'keep_column_names'} ||
125110574µs delete $attr{'kh'};
1252
1253 my $cbai = delete $attr{'callbacks'}{'after_in'} ||
1254 delete $attr{'after_in'} ||
1255 delete $attr{'callbacks'}{'after_parse'} ||
125610592µs delete $attr{'after_parse'};
1257 my $cbbo = delete $attr{'callbacks'}{'before_out'} ||
125810535µs delete $attr{'before_out'};
1259 my $cboi = delete $attr{'callbacks'}{'on_in'} ||
126010540µs delete $attr{'on_in'};
1261
1262 my $hd_s = delete $attr{'sep_set'} ||
1263105209µs delete $attr{'seps'};
1264 my $hd_b = delete $attr{'detect_bom'} ||
126510537µs delete $attr{'bom'};
1266 my $hd_m = delete $attr{'munge'} ||
126710531µs delete $attr{'munge_column_names'};
126810528µs my $hd_c = delete $attr{'set_column_names'};
1269
1270105401µs for ([ 'quo' => "quote" ],
1271 [ 'esc' => "escape" ],
1272 [ 'escape' => "escape_char" ],
1273 ) {
1274315100µs my ($f, $t) = @{$_};
1275315130µs exists $attr{$f} and !exists $attr{$t} and $attr{$t} = delete $attr{$f};
1276 }
1277
127810530µs my $fltr = delete $attr{'filter'};
1279 my %fltr = (
1280 'not_blank' => sub { @{$_[1]} > 1 or defined $_[1][0] && $_[1][0] ne "" },
1281 'not_empty' => sub { grep { defined && $_ ne "" } @{$_[1]} },
1282 'filled' => sub { grep { defined && m/\S/ } @{$_[1]} },
12831052.23ms );
1284 defined $fltr && !ref $fltr && exists $fltr{$fltr} and
128510547µs $fltr = { '0' => $fltr{$fltr} };
1286105109µs ref $fltr eq "CODE" and $fltr = { 0 => $fltr };
128710532µs ref $fltr eq "HASH" or $fltr = undef;
1288
128910535µs my $form = delete $attr{'formula'};
1290
129110576µs defined $attr{'auto_diag'} or $attr{'auto_diag'} = 1;
129210554µs defined $attr{'escape_null'} or $attr{'escape_null'} = 0;
1293105813µs10512.5ms my $csv = delete $attr{'csv'} || Text::CSV_XS->new (\%attr)
# spent 12.5ms making 105 calls to Text::CSV_XS::new, avg 119µs/call
1294 or croak ($last_new_err);
129510520µs defined $form and $csv->formula ($form);
1296
129710518µs $kh && !ref $kh && $kh =~ m/^(?:1|yes|true|internal|auto)$/i and
1298 $kh = \@internal_kh;
1299
1300 return {
13011051.76ms 'csv' => $csv,
1302 'attr' => { %attr },
1303 'fh' => $fh,
1304 'cls' => $cls,
1305 'in' => $in,
1306 'sink' => $sink,
1307 'out' => $out,
1308 'enc' => $enc,
1309 'hdrs' => $hdrs,
1310 'key' => $key,
1311 'val' => $val,
1312 'kh' => $kh,
1313 'frag' => $frag,
1314 'fltr' => $fltr,
1315 'cbai' => $cbai,
1316 'cbbo' => $cbbo,
1317 'cboi' => $cboi,
1318 'hd_s' => $hd_s,
1319 'hd_b' => $hd_b,
1320 'hd_m' => $hd_m,
1321 'hd_c' => $hd_c,
1322 };
1323 } # _csv_attr
1324
1325
# spent 53715s (24.1ms+53714) within Text::CSV_XS::csv which was called 105 times, avg 512s/call: # 105 times (24.1ms+53714s) by Gradescope::Translate::read_csv at line 48 of /home/hejohns/documentsNoSync/22f/490/gradescope-utils/lib/Gradescope/Translate.pm, avg 512s/call
sub csv {
132610595µs @_ && ref $_[0] eq __PACKAGE__ and splice @_, 0, 0, "csv";
132710525µs @_ or croak ($csv_usage);
1328
1329105498µs10535.1ms my $c = _csv_attr (@_);
# spent 35.1ms making 105 calls to Text::CSV_XS::_csv_attr, avg 335µs/call
1330
1331105153µs my ($csv, $in, $fh, $hdrs) = @{$c}{qw( csv in fh hdrs )};
133210521µs my %hdr;
133310533µs if (ref $hdrs eq "HASH") {
1334 %hdr = %{$hdrs};
1335 $hdrs = "auto";
1336 }
1337
133810552µs if ($c->{'out'} && !$c->{'sink'}) {
1339 !$hdrs && ref $c->{'kh'} && $c->{'kh'} == \@internal_kh and
1340 $hdrs = $c->{'kh'};
1341
1342 if (ref $in eq "CODE") {
1343 my $hdr = 1;
1344 while (my $row = $in->($csv)) {
1345 if (ref $row eq "ARRAY") {
1346 $csv->print ($fh, $row);
1347 next;
1348 }
1349 if (ref $row eq "HASH") {
1350 if ($hdr) {
1351 $hdrs ||= [ map { $hdr{$_} || $_ } keys %{$row} ];
1352 $csv->print ($fh, $hdrs);
1353 $hdr = 0;
1354 }
1355 $csv->print ($fh, [ @{$row}{@{$hdrs}} ]);
1356 }
1357 }
1358 }
1359 elsif (@{$in} == 0 or ref $in->[0] eq "ARRAY") { # aoa
1360 ref $hdrs and $csv->print ($fh, $hdrs);
1361 for (@{$in}) {
1362 $c->{'cboi'} and $c->{'cboi'}->($csv, $_);
1363 $c->{'cbbo'} and $c->{'cbbo'}->($csv, $_);
1364 $csv->print ($fh, $_);
1365 }
1366 }
1367 else { # aoh
1368 my @hdrs = ref $hdrs ? @{$hdrs} : keys %{$in->[0]};
1369 defined $hdrs or $hdrs = "auto";
1370 ref $hdrs || $hdrs eq "auto" and @hdrs and
1371 $csv->print ($fh, [ map { $hdr{$_} || $_ } @hdrs ]);
1372 for (@{$in}) {
1373 local %_;
1374 *_ = $_;
1375 $c->{'cboi'} and $c->{'cboi'}->($csv, $_);
1376 $c->{'cbbo'} and $c->{'cbbo'}->($csv, $_);
1377 $csv->print ($fh, [ @{$_}{@hdrs} ]);
1378 }
1379 }
1380
1381 $c->{'cls'} and close $fh;
1382 return 1;
1383 }
1384
138510523µs my @row1;
1386105104µs if (defined $c->{'hd_s'} || defined $c->{'hd_b'} || defined $c->{'hd_m'} || defined $c->{'hd_c'}) {
1387 my %harg;
1388 defined $c->{'hd_s'} and $harg{'sep_set'} = $c->{'hd_s'};
1389 defined $c->{'hd_d'} and $harg{'detect_bom'} = $c->{'hd_b'};
1390 defined $c->{'hd_m'} and $harg{'munge_column_names'} = $hdrs ? "none" : $c->{'hd_m'};
1391 defined $c->{'hd_c'} and $harg{'set_column_names'} = $hdrs ? 0 : $c->{'hd_c'};
1392 @row1 = $csv->header ($fh, \%harg);
1393 my @hdr = $csv->column_names ();
1394 @hdr and $hdrs ||= \@hdr;
1395 }
1396
139710516µs if ($c->{'kh'}) {
1398 @internal_kh = ();
1399 ref $c->{'kh'} eq "ARRAY" or croak ($csv->SetDiag (1501));
1400 $hdrs ||= "auto";
1401 }
1402
140310533µs my $key = $c->{'key'};
140410535µs if ($key) {
140510591µs !ref $key or ref $key eq "ARRAY" && @{$key} > 1 or croak ($csv->SetDiag (1501));
140610536µs $hdrs ||= "auto";
1407 }
140810525µs my $val = $c->{'val'};
140910539µs if ($val) {
141010515µs $key or croak ($csv->SetDiag (1502));
1411105278µs !ref $val or ref $val eq "ARRAY" && @{$val} > 0 or croak ($csv->SetDiag (1503));
1412 }
1413
1414105531µs10568µs $c->{'fltr'} && grep m/\D/ => keys %{$c->{'fltr'}} and $hdrs ||= "auto";
# spent 68µs making 105 calls to Text::CSV_XS::CORE:match, avg 650ns/call
141510543µs if (defined $hdrs) {
141610567µs if (!ref $hdrs) {
141710559µs if ($hdrs eq "skip") {
1418 $csv->getline ($fh); # discard;
1419 }
1420 elsif ($hdrs eq "auto") {
14211053.71ms5259.44ms my $h = $csv->getline ($fh) or return;
# spent 3.76ms making 105 calls to Text::CSV_XS::getline, avg 36µs/call # spent 2.40ms making 105 calls to IO::Handle::getline, avg 23µs/call # spent 2.22ms making 105 calls to Text::CSV_XS::CORE:readline, avg 21µs/call # spent 928µs making 105 calls to Encode::utf8::decode, avg 9µs/call # spent 129µs making 105 calls to Encode::Encoding::renewed, avg 1µs/call
1422105368µs $hdrs = [ map { $hdr{$_} || $_ } @{$h} ];
1423 }
1424 elsif ($hdrs eq "lc") {
1425 my $h = $csv->getline ($fh) or return;
1426 $hdrs = [ map { lc ($hdr{$_} || $_) } @{$h} ];
1427 }
1428 elsif ($hdrs eq "uc") {
1429 my $h = $csv->getline ($fh) or return;
1430 $hdrs = [ map { uc ($hdr{$_} || $_) } @{$h} ];
1431 }
1432 }
1433 elsif (ref $hdrs eq "CODE") {
1434 my $h = $csv->getline ($fh) or return;
1435 my $cr = $hdrs;
1436 $hdrs = [ map { $cr->($hdr{$_} || $_) } @{$h} ];
1437 }
143810533µs $c->{'kh'} and $hdrs and @{$c->{'kh'}} = @{$hdrs};
1439 }
1440
144110564µs if ($c->{'fltr'}) {
1442105145µs my %f = %{$c->{'fltr'}};
1443 # convert headers to index
144410512µs my @hdr;
144510545µs if (ref $hdrs) {
1446105108µs @hdr = @{$hdrs};
1447105136µs for (0 .. $#hdr) {
1448630206µs exists $f{$hdr[$_]} and $f{$_ + 1} = delete $f{$hdr[$_]};
1449 }
1450 }
1451
# spent 53705s (3.76+53701) within Text::CSV_XS::__ANON__[/home/hejohns/perl5/lib/perl5/x86_64-linux-gnu-thread-multi/Text/CSV_XS.pm:1460] which was called 133035 times, avg 404ms/call: # 133035 times (3.76s+53701s) by Text::CSV_XS::getline_all at line 1047, avg 404ms/call
$csv->callbacks ('after_parse' => sub {
145213303577.3ms my ($CSV, $ROW) = @_; # lexical sub-variables in caps
1453133035697ms133035109ms foreach my $FLD (sort keys %f) {
# spent 109ms making 133035 calls to Text::CSV_XS::CORE:sort, avg 820ns/call
1454133035218ms local $_ = $ROW->[$FLD - 1];
145513303559.8ms local %_;
1456133035520ms @hdr and @_{@hdr} = @{$ROW};
14571330352.74s13303553701s $f{$FLD}->($CSV, $ROW) or return \"skip";
# spent 53701s making 133035 calls to main::__ANON__[split.pl:90], avg 404ms/call
1458125712.4ms $ROW->[$FLD - 1] = $_;
1459 }
1460105850µs1053.33ms });
# spent 3.33ms making 105 calls to Text::CSV_XS::callbacks, avg 32µs/call
1461 }
1462
146310539µs my $frag = $c->{'frag'};
1464 my $ref = ref $hdrs
1465 ? # aoh
146610563µs do {
1467105340µs1051.07ms my @h = $csv->column_names ($hdrs);
# spent 1.07ms making 105 calls to Text::CSV_XS::column_names, avg 10µs/call
1468210358µs my %h; $h{$_}++ for @h;
146910526µs exists $h{""} and croak ($csv->SetDiag (1012));
147010545µs unless (keys %h == @h) {
1471 croak ($csv->_SetDiagInfo (1013, join ", " =>
1472 map { "$_ ($h{$_})" } grep { $h{$_} > 1 } keys %h));
1473 }
1474 $frag ? $csv->fragment ($fh, $frag) :
1475105857µs $key ? do {
1476105110µs my ($k, $j, @f) = ref $key ? (undef, @{$key}) : ($key);
1477105152µs if (my @mk = grep { !exists $h{$_} } grep { defined } $k, @f) {
1478 croak ($csv->_SetDiagInfo (4001, join ", " => @mk));
1479 }
1480 +{ map {
14811257131µs my $r = $_;
14821257610µs my $K = defined $k ? $r->{$k} : join $j => @{$r}{@f};
1483 ( $K => (
1484 $val
1485 ? ref $val
1486 ? { map { $_ => $r->{$_} } @{$val} }
148712573.33ms : $r->{$val}
1488 : $r ));
14891052.91ms10553714s } @{$csv->getline_hr_all ($fh)} }
# spent 53714s making 105 calls to Text::CSV_XS::getline_hr_all, avg 512s/call
1490 }
1491 : $csv->getline_hr_all ($fh);
1492 }
1493 : # aoa
1494 $frag ? $csv->fragment ($fh, $frag)
1495 : $csv->getline_all ($fh);
149610553µs if ($ref) {
1497 @row1 && !$c->{'hd_c'} && !ref $hdrs and unshift @{$ref}, \@row1;
1498 }
1499 else {
1500 Text::CSV_XS->auto_diag ();
1501 }
15021052.17ms1051.88ms $c->{'cls'} and close $fh;
# spent 1.88ms making 105 calls to Text::CSV_XS::CORE:close, avg 18µs/call
1503105113µs if ($ref and $c->{'cbai'} || $c->{'cboi'}) {
1504 # Default is ARRAYref, but with key =>, you'll get a hashref
1505 foreach my $r (ref $ref eq "ARRAY" ? @{$ref} : values %{$ref}) {
1506 local %_;
1507 ref $r eq "HASH" and *_ = $r;
1508 $c->{'cbai'} and $c->{'cbai'}->($csv, $r);
1509 $c->{'cboi'} and $c->{'cboi'}->($csv, $r);
1510 }
1511 }
1512
151310542µs if ($c->{'sink'}) {
1514 my $ro = ref $c->{'out'} or return;
1515
1516 $ro eq "SCALAR" && ${$c->{'out'}} eq "skip" and
1517 return;
1518
1519 $ro eq ref $ref or
1520 croak ($csv->_SetDiagInfo (5001, "Output type mismatch"));
1521
1522 if ($ro eq "ARRAY") {
1523 if (@{$c->{'out'}} and @$ref and ref $c->{'out'}[0] eq ref $ref->[0]) {
1524 push @{$c->{'out'}} => @$ref;
1525 return $c->{'out'};
1526 }
1527 croak ($csv->_SetDiagInfo (5001, "Output type mismatch"));
1528 }
1529
1530 if ($ro eq "HASH") {
1531 @{$c->{'out'}}{keys %{$ref}} = values %{$ref};
1532 return $c->{'out'};
1533 }
1534
1535 croak ($csv->_SetDiagInfo (5002, "Unsupported output type"));
1536 }
1537
1538 defined wantarray or
1539 return csv (
1540 'in' => $ref,
1541 'headers' => $hdrs,
154210531µs %{$c->{'attr'}},
1543 );
1544
154510511.1ms return $ref;
1546 } # csv
1547
1548114µs1;
1549
1550__END__
 
# spent 1.88ms within Text::CSV_XS::CORE:close which was called 105 times, avg 18µs/call: # 105 times (1.88ms+0s) by Text::CSV_XS::csv at line 1502, avg 18µs/call
sub Text::CSV_XS::CORE:close; # opcode
# spent 2.12ms within Text::CSV_XS::CORE:match which was called 2520 times, avg 842ns/call: # 630 times (476µs+0s) by Text::CSV_XS::new at line 193, avg 756ns/call # 630 times (136µs+0s) by Text::CSV_XS::new at line 213, avg 216ns/call # 630 times (85µs+0s) by Text::CSV_XS::new at line 215, avg 135ns/call # 105 times (641µs+0s) by Text::CSV_XS::callbacks at line 659, avg 6µs/call # 105 times (438µs+0s) by Text::CSV_XS::_csv_attr at line 1178, avg 4µs/call # 105 times (233µs+0s) by Text::CSV_XS::_check_sanity at line 162, avg 2µs/call # 105 times (68µs+0s) by Text::CSV_XS::csv at line 1414, avg 650ns/call # 105 times (23µs+0s) by Text::CSV_XS::_check_sanity at line 167, avg 221ns/call # 105 times (20µs+0s) by Text::CSV_XS::_check_sanity at line 171, avg 190ns/call
sub Text::CSV_XS::CORE:match; # opcode
# spent 12.7ms (4.44+8.26) within Text::CSV_XS::CORE:open which was called 105 times, avg 121µs/call: # 105 times (4.44ms+8.26ms) by Text::CSV_XS::_csv_attr at line 1240, avg 121µs/call
sub Text::CSV_XS::CORE:open; # opcode
# spent 5.31s (3.23+2.08) within Text::CSV_XS::CORE:readline which was called 153405 times, avg 35µs/call: # 153300 times (3.23s+2.08s) by IO::Handle::getline at line 1047, avg 35µs/call # 105 times (1.29ms+929µs) by IO::Handle::getline at line 1421, avg 21µs/call
sub Text::CSV_XS::CORE:readline; # opcode
# spent 109ms within Text::CSV_XS::CORE:sort which was called 133035 times, avg 820ns/call: # 133035 times (109ms+0s) by Text::CSV_XS::__ANON__[/home/hejohns/perl5/lib/perl5/x86_64-linux-gnu-thread-multi/Text/CSV_XS.pm:1460] at line 1453, avg 820ns/call
sub Text::CSV_XS::CORE:sort; # opcode
# spent 589µs within Text::CSV_XS::CORE:subst which was called 105 times, avg 6µs/call: # 105 times (589µs+0s) by Text::CSV_XS::_csv_attr at line 1177, avg 6µs/call
sub Text::CSV_XS::CORE:subst; # opcode
# spent 223µs within Text::CSV_XS::SetDiag which was called 211 times, avg 1µs/call: # 105 times (145µs+0s) by Text::CSV_XS::new at line 185, avg 1µs/call # 105 times (76µs+0s) by Text::CSV_XS::new at line 255, avg 725ns/call # once (2µs+0s) by Text::CSV::BEGIN@1 at line 126
sub Text::CSV_XS::SetDiag; # xsub
# spent 300ns within Text::CSV_XS::__ANON__ which was called: # once (300ns+0s) by Text::CSV_XS::BEGIN@25 at line 25
sub Text::CSV_XS::__ANON__; # xsub
# spent 90µs within Text::CSV_XS::_cache_set which was called 105 times, avg 862ns/call: # 105 times (90µs+0s) by Text::CSV_XS::_set_attr_X at line 313, avg 862ns/call
sub Text::CSV_XS::_cache_set; # xsub
# spent 3.76ms (1.36+2.40) within Text::CSV_XS::getline which was called 105 times, avg 36µs/call: # 105 times (1.36ms+2.40ms) by Text::CSV_XS::csv at line 1421, avg 36µs/call
sub Text::CSV_XS::getline; # xsub
# spent 53714s (3.70+53711) within Text::CSV_XS::getline_all which was called 105 times, avg 512s/call: # 105 times (3.70s+53711s) by Text::CSV_XS::getline_hr_all at line 1047, avg 512s/call
sub Text::CSV_XS::getline_all; # xsub
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.