line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Text::CSV::Encoded; |
2
|
|
|
|
|
|
|
|
3
|
13
|
|
|
13
|
|
275314
|
use strict; |
|
13
|
|
|
|
|
30
|
|
|
13
|
|
|
|
|
398
|
|
4
|
13
|
|
|
13
|
|
71
|
use vars qw( $VERSION ); |
|
13
|
|
|
|
|
27
|
|
|
13
|
|
|
|
|
701
|
|
5
|
13
|
|
|
13
|
|
65
|
use Carp (); |
|
13
|
|
|
|
|
26
|
|
|
13
|
|
|
|
|
1990
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
$VERSION = '0.23'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
BEGIN { |
11
|
13
|
|
|
13
|
|
10878
|
require Text::CSV; |
12
|
13
|
50
|
|
|
|
191139
|
if ( Text::CSV->VERSION < 1.06 ) { |
13
|
0
|
|
|
|
|
0
|
Carp::croak "Base class Text::CSV version is less than 1.06."; |
14
|
|
|
|
|
|
|
} |
15
|
13
|
|
|
|
|
82
|
my $backend = Text::CSV->backend; |
16
|
13
|
|
|
|
|
105
|
my $version = Text::CSV->backend->VERSION; |
17
|
13
|
50
|
33
|
|
|
352
|
if ( ( $backend =~ /XS/ and $version >= 0.99 ) or ( $backend =~ /PP/ and $version >= 1.30 ) ) { |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
18
|
13
|
|
|
12
|
0
|
849
|
eval q/ sub automatic_UTF8 { 1; } /; # parse/getline return strings (UNICODE) |
|
12
|
|
|
|
|
1181
|
|
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
else { |
21
|
0
|
|
|
|
|
0
|
eval q/ sub automatic_UTF8 { 0; } /; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
13
|
|
|
13
|
|
105
|
use base qw( Text::CSV ); |
|
13
|
|
|
|
|
22
|
|
|
13
|
|
|
|
|
1890
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
my $DefaultCoderClass = $] >= 5.008 ? 'Text::CSV::Encoded::Coder::Encode' |
29
|
|
|
|
|
|
|
: 'Text::CSV::Encoded::Coder::Base'; |
30
|
|
|
|
|
|
|
my @Attrs; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
BEGIN { |
34
|
13
|
|
|
13
|
|
12236
|
@Attrs = qw( |
35
|
|
|
|
|
|
|
encoding |
36
|
|
|
|
|
|
|
encoding_in encoding_out |
37
|
|
|
|
|
|
|
encoding_io_in encoding_io_out |
38
|
|
|
|
|
|
|
encoding_to_parse encoding_to_combine |
39
|
|
|
|
|
|
|
); |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub import { |
44
|
4
|
|
|
4
|
|
2734
|
my ( $class, %args ) = @_; |
45
|
|
|
|
|
|
|
|
46
|
4
|
100
|
|
|
|
3010
|
return unless %args; |
47
|
|
|
|
|
|
|
|
48
|
1
|
50
|
|
|
|
5
|
if ( exists $args{ coder_class } ) { |
49
|
1
|
|
|
|
|
198
|
$DefaultCoderClass = $args{ coder_class }; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub new { |
56
|
10
|
|
|
10
|
1
|
49177
|
my $class = shift; |
57
|
10
|
|
100
|
|
|
68
|
my $opt = shift || {}; |
58
|
10
|
|
|
|
|
23
|
my %opt; |
59
|
|
|
|
|
|
|
|
60
|
10
|
|
|
|
|
36
|
$opt->{binary} = 1; |
61
|
|
|
|
|
|
|
|
62
|
10
|
|
|
|
|
37
|
for my $attr ( @Attrs, 'encoding', 'coder_class' ) { |
63
|
90
|
100
|
|
|
|
290
|
$opt{ $attr } = delete $opt->{ $attr } if ( exists $opt->{ $attr } ); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
10
|
|
100
|
|
|
119
|
my $self = $class->SUPER::new( $opt ) || return; |
67
|
|
|
|
|
|
|
|
68
|
9
|
50
|
66
|
|
|
1084
|
if ( my $coder_class = ( $opt{coder_class} || $DefaultCoderClass ) ) { |
69
|
9
|
|
|
|
|
43
|
$self->coder_class( $coder_class ); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
else { |
72
|
0
|
|
|
|
|
0
|
Carp::croak "Coder class is not specified."; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
9
|
|
|
|
|
33
|
for my $attr ( @Attrs, 'encoding' ) { |
76
|
72
|
100
|
|
|
|
416
|
$self->$attr( $opt{ $attr } ) if ( exists $opt{ $attr } ); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
9
|
|
|
|
|
56
|
$self; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# |
84
|
|
|
|
|
|
|
# Methods |
85
|
|
|
|
|
|
|
# |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub combine { |
88
|
21
|
|
|
21
|
1
|
22308
|
my $self = shift; |
89
|
21
|
|
|
|
|
49
|
my @fields = @_; |
90
|
|
|
|
|
|
|
|
91
|
21
|
100
|
|
|
|
672
|
$self->coder->decode_fields_ref( $self->encoding, \@fields ) if ( $self->encoding ); |
92
|
|
|
|
|
|
|
|
93
|
21
|
100
|
|
|
|
538
|
unless ( $self->encoding_out ) { |
94
|
6
|
|
|
|
|
24
|
return $self->SUPER::combine( @fields ); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
15
|
|
|
|
|
370
|
my $ret = $self->encode( $self->encoding_out, \@fields ); |
98
|
|
|
|
|
|
|
|
99
|
15
|
50
|
|
|
|
78
|
$self->{_STRING} = \$ret if ( $ret ); |
100
|
|
|
|
|
|
|
|
101
|
15
|
|
|
|
|
78
|
return $self->{_STATUS}; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub parse { |
106
|
24
|
|
|
24
|
1
|
5934
|
my $self = shift; |
107
|
24
|
|
|
|
|
453
|
my $ret; |
108
|
|
|
|
|
|
|
|
109
|
24
|
100
|
|
|
|
709
|
if ( $self->encoding_in ) { |
110
|
18
|
|
|
|
|
498
|
$ret = $self->decode( $self->encoding_in, $_[0] ); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
else { |
113
|
6
|
50
|
|
|
|
32
|
$ret = [ $self->fields ] if $self->SUPER::parse( @_ ); |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
24
|
50
|
|
|
|
1141
|
if ( $ret ) { |
117
|
24
|
50
|
|
|
|
712
|
$self->coder->encode_fields_ref( $self->encoding, $ret ) if ( $self->encoding ); |
118
|
24
|
|
|
|
|
57
|
$self->{_FIELDS} = $ret; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
24
|
|
|
|
|
120
|
return $self->{_STATUS}; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# |
126
|
|
|
|
|
|
|
# IO style |
127
|
|
|
|
|
|
|
# |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub print { # to CSV |
130
|
4
|
|
|
4
|
1
|
81
|
my ( $self, $io, $cols ) = @_; |
131
|
|
|
|
|
|
|
|
132
|
4
|
50
|
|
|
|
91
|
$self->coder->decode_fields_ref( $self->encoding, $cols ) if ( $self->encoding ); |
133
|
4
|
|
|
|
|
8
|
$self->coder->encode_fields_ref( $self->encoding_out, $cols ); |
134
|
|
|
|
|
|
|
|
135
|
4
|
|
|
|
|
22
|
$self->SUPER::print( $io, $cols ); |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub getline { # from CSV |
140
|
31
|
|
|
31
|
1
|
13832
|
my ( $self, $io ) = @_; |
141
|
31
|
|
|
|
|
90
|
my $cols = $self->SUPER::getline( $io ); |
142
|
|
|
|
|
|
|
|
143
|
31
|
100
|
|
|
|
13223
|
if ( my $binds = $self->{_BOUND_COLUMNS} ) { |
144
|
5
|
|
|
|
|
10
|
for my $val ( @$binds ) { |
145
|
10
|
|
|
|
|
21
|
$$val = $self->coder->decode( $self->encoding_in, $$val ); |
146
|
10
|
50
|
|
|
|
225
|
$$val = $self->coder->encode( $self->encoding, $$val ) if ( $self->encoding ); |
147
|
|
|
|
|
|
|
} |
148
|
5
|
|
|
|
|
14
|
return $cols; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
26
|
100
|
|
|
|
64
|
return unless $cols; |
152
|
|
|
|
|
|
|
|
153
|
21
|
|
|
|
|
45
|
$self->coder->decode_fields_ref( $self->encoding_in, $cols ); |
154
|
21
|
100
|
|
|
|
504
|
$self->coder->encode_fields_ref( $self->encoding, $cols ) if ( $self->encoding ); |
155
|
|
|
|
|
|
|
|
156
|
21
|
|
|
|
|
56
|
$cols; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
# |
161
|
|
|
|
|
|
|
# decode/encode style |
162
|
|
|
|
|
|
|
# |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub decode { |
165
|
28
|
|
|
28
|
1
|
2832
|
my ( $self, $enc, $text ) = @_; |
166
|
|
|
|
|
|
|
|
167
|
28
|
100
|
|
|
|
88
|
if ( @_ == 2 ) { |
168
|
5
|
|
|
|
|
10
|
$text = $enc, $enc = ''; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
28
|
100
|
|
|
|
71
|
$self->coder->upgrade( $text ) unless ( $enc ); # as unicode |
172
|
|
|
|
|
|
|
|
173
|
28
|
50
|
|
|
|
73
|
return unless ( defined $text ); |
174
|
28
|
50
|
|
|
|
131
|
return unless ( $self->SUPER::parse( $text ) ); |
175
|
|
|
|
|
|
|
|
176
|
28
|
100
|
|
|
|
5572
|
return $enc ? [ map { $self->coder->decode( $enc, $_ ) } $self->fields() ] : [ $self->fields() ]; |
|
37
|
|
|
|
|
247
|
|
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub encode { |
181
|
23
|
|
|
23
|
1
|
3207
|
my ( $self, $enc, $array ) = @_; |
182
|
|
|
|
|
|
|
|
183
|
23
|
100
|
|
|
|
65
|
if ( @_ == 2 ) { |
184
|
4
|
|
|
|
|
7
|
$array = $enc, $enc = ''; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
23
|
50
|
33
|
|
|
136
|
return unless ( defined $array and ref $array eq 'ARRAY' ); |
188
|
23
|
50
|
|
|
|
91
|
return unless ( $self->SUPER::combine ( @$array ) ); |
189
|
|
|
|
|
|
|
|
190
|
23
|
100
|
|
|
|
1526
|
return $enc ? $self->coder->encode( $enc, $self->string() ) : $self->string(); |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# Internal |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub _load_coder_class { |
197
|
9
|
|
|
9
|
|
24
|
my ( $class, $coder_class ) = @_; |
198
|
9
|
|
|
|
|
68
|
(my $file = "$coder_class.pm") =~ s{::}{/}g; |
199
|
|
|
|
|
|
|
|
200
|
9
|
|
|
|
|
20
|
eval { require $file }; |
|
9
|
|
|
|
|
5272
|
|
201
|
|
|
|
|
|
|
|
202
|
9
|
50
|
|
|
|
57
|
if ( $@ ) { |
203
|
0
|
|
|
|
|
0
|
Carp::croak $@; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
9
|
|
|
|
|
26
|
$coder_class; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# Accessors |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
BEGIN { |
213
|
13
|
|
|
13
|
|
45
|
for my $method ( qw( encoding encoding_in encoding_out ) ) { |
214
|
39
|
100
|
|
105
|
1
|
8319
|
eval qq| |
|
105
|
100
|
|
100
|
1
|
334
|
|
|
105
|
100
|
|
62
|
1
|
364
|
|
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
16
|
|
|
99
|
|
|
|
|
391
|
|
|
100
|
|
|
|
|
10565
|
|
|
100
|
|
|
|
|
245
|
|
|
27
|
|
|
|
|
51
|
|
|
27
|
|
|
|
|
67
|
|
|
73
|
|
|
|
|
316
|
|
|
62
|
|
|
|
|
589
|
|
|
62
|
|
|
|
|
137
|
|
|
22
|
|
|
|
|
46
|
|
|
22
|
|
|
|
|
51
|
|
|
40
|
|
|
|
|
182
|
|
215
|
|
|
|
|
|
|
sub $method { |
216
|
|
|
|
|
|
|
my ( \$self, \$encoding ) = \@_; |
217
|
|
|
|
|
|
|
if ( \@_ > 1 ) { |
218
|
|
|
|
|
|
|
\$self->{ $method } = \$encoding; |
219
|
|
|
|
|
|
|
return \$self; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
else { |
222
|
|
|
|
|
|
|
\$self->{ $method }; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
*encoding_io_in = *encoding_to_parse = *encoding_in; |
231
|
|
|
|
|
|
|
*encoding_io_out = *encoding_to_combine = *encoding_out; |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub coder { |
235
|
116
|
|
|
116
|
1
|
754
|
my $self = shift; |
236
|
116
|
|
66
|
|
|
1624
|
$self->{coder} ||= $self->coder_class->new( automatic_UTF8 => $self->automatic_UTF8, @_ ); |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
sub coder_class { |
241
|
18
|
|
|
18
|
1
|
62
|
my ( $self, $coder_class ) = @_; |
242
|
|
|
|
|
|
|
|
243
|
18
|
100
|
|
|
|
295
|
return $self->{coder_class} if ( @_ == 1 ); |
244
|
|
|
|
|
|
|
|
245
|
9
|
|
|
|
|
42
|
$self->_load_coder_class( $coder_class ); |
246
|
9
|
|
|
|
|
41
|
$self->{coder_class} = $coder_class; |
247
|
9
|
|
|
|
|
27
|
$self; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
1; |
252
|
|
|
|
|
|
|
__END__ |