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__ |