| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package ETL::Yertl::Format::csv; |
|
2
|
|
|
|
|
|
|
our $VERSION = '0.035'; |
|
3
|
|
|
|
|
|
|
# ABSTRACT: CSV read/write support for Yertl |
|
4
|
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
82518
|
use ETL::Yertl; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
5
|
|
|
6
|
1
|
|
|
1
|
|
28
|
use base 'ETL::Yertl::Format'; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
259
|
|
|
7
|
1
|
|
|
1
|
|
6
|
use Module::Runtime qw( use_module ); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
4
|
|
|
8
|
1
|
|
|
1
|
|
41
|
use List::Util qw( pairs pairkeys pairfirst ); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
709
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub new { |
|
11
|
11
|
|
|
11
|
0
|
55881
|
my ( $class, %args ) = @_; |
|
12
|
11
|
|
100
|
|
|
55
|
$args{delimiter} ||= ','; |
|
13
|
11
|
|
|
|
|
45
|
return $class->SUPER::new( %args ); |
|
14
|
|
|
|
|
|
|
} |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
#pod =attr format_module |
|
17
|
|
|
|
|
|
|
#pod |
|
18
|
|
|
|
|
|
|
#pod The module being used for this format. Possible modules, in order of importance: |
|
19
|
|
|
|
|
|
|
#pod |
|
20
|
|
|
|
|
|
|
#pod =over 4 |
|
21
|
|
|
|
|
|
|
#pod |
|
22
|
|
|
|
|
|
|
#pod =item L (any version) |
|
23
|
|
|
|
|
|
|
#pod |
|
24
|
|
|
|
|
|
|
#pod =item L (any version) |
|
25
|
|
|
|
|
|
|
#pod |
|
26
|
|
|
|
|
|
|
#pod =back |
|
27
|
|
|
|
|
|
|
#pod |
|
28
|
|
|
|
|
|
|
#pod =cut |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# Pairs of module => supported version |
|
31
|
|
|
|
|
|
|
our @FORMAT_MODULES = ( |
|
32
|
|
|
|
|
|
|
'Text::CSV_XS' => 0, |
|
33
|
|
|
|
|
|
|
'Text::CSV' => 0, |
|
34
|
|
|
|
|
|
|
); |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub format_module { |
|
37
|
11
|
|
|
11
|
1
|
22
|
my ( $self ) = @_; |
|
38
|
11
|
50
|
|
|
|
27
|
return $self->{_format_module} if $self->{_format_module}; |
|
39
|
11
|
|
|
|
|
70
|
for my $format_module ( pairs @FORMAT_MODULES ) { |
|
40
|
13
|
|
|
|
|
22
|
eval { |
|
41
|
|
|
|
|
|
|
# Prototypes on use_module() make @$format_module not work correctly |
|
42
|
13
|
|
|
|
|
44
|
use_module( $format_module->[0], $format_module->[1] ); |
|
43
|
|
|
|
|
|
|
}; |
|
44
|
13
|
100
|
|
|
|
1069
|
if ( !$@ ) { |
|
45
|
10
|
|
|
|
|
70
|
return $format_module->[0]; |
|
46
|
|
|
|
|
|
|
} |
|
47
|
|
|
|
|
|
|
} |
|
48
|
|
|
|
|
|
|
die "Could not load a formatter for CSV. Please install one of the following modules:\n" |
|
49
|
|
|
|
|
|
|
. join( "", |
|
50
|
1
|
100
|
|
|
|
10
|
map { sprintf "\t%s (%s)", $_->[0], $_->[1] ? "version $_->[1]" : "Any version" } |
|
|
3
|
|
|
|
|
19
|
|
|
51
|
|
|
|
|
|
|
pairs @FORMAT_MODULES |
|
52
|
|
|
|
|
|
|
) |
|
53
|
|
|
|
|
|
|
. "\n"; |
|
54
|
|
|
|
|
|
|
} |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub _field_names { |
|
57
|
20
|
|
|
20
|
|
35
|
my ( $self, $new_names ) = @_; |
|
58
|
20
|
100
|
|
|
|
43
|
if ( $new_names ) { |
|
59
|
10
|
|
|
|
|
16
|
$self->{_field_names} = $new_names; |
|
60
|
|
|
|
|
|
|
} |
|
61
|
20
|
|
100
|
|
|
66
|
return $self->{_field_names} || []; |
|
62
|
|
|
|
|
|
|
} |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub _csv { |
|
65
|
10
|
|
|
10
|
|
20
|
my ( $self ) = @_; |
|
66
|
|
|
|
|
|
|
return $self->{_csv} ||= $self->format_module->new({ |
|
67
|
|
|
|
|
|
|
binary => 1, eol => $\, |
|
68
|
|
|
|
|
|
|
sep_char => $self->{delimiter}, |
|
69
|
10
|
|
33
|
|
|
30
|
}); |
|
70
|
|
|
|
|
|
|
} |
|
71
|
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
#pod =method write( DOCUMENTS ) |
|
73
|
|
|
|
|
|
|
#pod |
|
74
|
|
|
|
|
|
|
#pod Convert the given C to CSV. Returns a CSV string. |
|
75
|
|
|
|
|
|
|
#pod |
|
76
|
|
|
|
|
|
|
#pod =cut |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub write { |
|
79
|
5
|
|
|
5
|
1
|
31
|
my ( $self, @docs ) = @_; |
|
80
|
5
|
|
|
|
|
15
|
my $csv = $self->_csv; |
|
81
|
5
|
|
|
|
|
557
|
my $str = ''; |
|
82
|
5
|
|
|
|
|
8
|
my @names = @{ $self->_field_names }; |
|
|
5
|
|
|
|
|
11
|
|
|
83
|
|
|
|
|
|
|
|
|
84
|
5
|
50
|
|
|
|
15
|
if ( !@names ) { |
|
85
|
5
|
|
|
|
|
6
|
@names = sort keys %{ $docs[0] }; |
|
|
5
|
|
|
|
|
24
|
|
|
86
|
5
|
|
|
|
|
20
|
$csv->combine( @names ); |
|
87
|
5
|
|
|
|
|
120
|
$str .= $csv->string . $/; |
|
88
|
5
|
|
|
|
|
44
|
$self->_field_names( \@names ); |
|
89
|
|
|
|
|
|
|
} |
|
90
|
|
|
|
|
|
|
|
|
91
|
5
|
|
|
|
|
11
|
for my $doc ( @docs ) { |
|
92
|
10
|
|
|
|
|
51
|
$csv->combine( map { $doc->{ $_ } } @names ); |
|
|
30
|
|
|
|
|
62
|
|
|
93
|
10
|
|
|
|
|
109
|
$str .= $csv->string . $/; |
|
94
|
|
|
|
|
|
|
} |
|
95
|
|
|
|
|
|
|
|
|
96
|
5
|
|
|
|
|
46
|
return $str; |
|
97
|
|
|
|
|
|
|
} |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
#pod =method read() |
|
100
|
|
|
|
|
|
|
#pod |
|
101
|
|
|
|
|
|
|
#pod Read a CSV string from L and return all the documents. |
|
102
|
|
|
|
|
|
|
#pod |
|
103
|
|
|
|
|
|
|
#pod =cut |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub read { |
|
106
|
5
|
|
|
5
|
1
|
23
|
my ( $self ) = @_; |
|
107
|
5
|
|
50
|
|
|
18
|
my $fh = $self->{input} || die "No input filehandle"; |
|
108
|
5
|
|
|
|
|
11
|
my $csv = $self->_csv; |
|
109
|
5
|
|
|
|
|
673
|
my @names = @{ $self->_field_names }; |
|
|
5
|
|
|
|
|
14
|
|
|
110
|
|
|
|
|
|
|
|
|
111
|
5
|
50
|
|
|
|
13
|
if ( !@names ) { |
|
112
|
5
|
|
|
|
|
14
|
@names = @{ $csv->getline( $fh ) }; |
|
|
5
|
|
|
|
|
202
|
|
|
113
|
5
|
|
|
|
|
222
|
$self->_field_names( \@names ); |
|
114
|
|
|
|
|
|
|
} |
|
115
|
|
|
|
|
|
|
|
|
116
|
5
|
|
|
|
|
7
|
my @docs; |
|
117
|
5
|
|
|
|
|
98
|
while ( my $row = $csv->getline( $fh ) ) { |
|
118
|
10
|
|
|
|
|
279
|
push @docs, { map {; $names[ $_ ] => $row->[ $_ ] } 0..$#{ $row } }; |
|
|
30
|
|
|
|
|
246
|
|
|
|
10
|
|
|
|
|
20
|
|
|
119
|
|
|
|
|
|
|
} |
|
120
|
|
|
|
|
|
|
|
|
121
|
5
|
|
|
|
|
147
|
return @docs; |
|
122
|
|
|
|
|
|
|
} |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
1; |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
__END__ |