File Coverage

blib/lib/ETL/Yertl/Format/csv.pm
Criterion Covered Total %
statement 61 61 100.0
branch 9 12 75.0
condition 6 9 66.6
subroutine 10 10 100.0
pod 3 4 75.0
total 89 96 92.7


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__