File Coverage

blib/lib/Text/CSV/Simple.pm
Criterion Covered Total %
statement 62 64 96.8
branch 22 26 84.6
condition n/a
subroutine 12 12 100.0
pod 4 4 100.0
total 100 106 94.3


line stmt bran cond sub pod time code
1             package Text::CSV::Simple::__::Base;
2              
3 1     1   1227 use Class::Trigger;
  1         1408  
  1         6  
4              
5             __PACKAGE__->add_trigger(on_failure => sub {
6             my ($self, $csv) = @_;
7             warn "Failed on " . $csv->error_input . "\n";
8             });
9              
10             package Text::CSV::Simple;
11              
12 1     1   108 use base 'Text::CSV::Simple::__::Base';
  1         1  
  1         566  
13              
14             $VERSION = '1.00';
15              
16 1     1   6 use strict;
  1         2  
  1         29  
17              
18 1     1   1247 use Text::CSV_XS;
  1         9101  
  1         59  
19 1     1   852 use File::Slurp ();
  1         13440  
  1         477  
20              
21             =head1 NAME
22              
23             Text::CSV::Simple - Simpler parsing of CSV files
24              
25             =head1 SYNOPSIS
26              
27             my $parser = Text::CSV::Simple->new;
28             my @data = $parser->read_file($datafile);
29             print @$_ foreach @data;
30              
31             # Only want certain fields?
32             my $parser = Text::CSV::Simple->new;
33             $parser->want_fields(1, 2, 4, 8);
34             my @data = $parser->read_file($datafile);
35              
36             # Map the fields to a hash?
37             my $parser = Text::CSV::Simple->new;
38             $parser->field_map(qw/id name null town/);
39             my @data = $parser->read_file($datafile);
40              
41             =head1 DESCRIPTION
42              
43             Parsing CSV files is nasty. It seems so simple, but it usually isn't.
44             Thankfully Text::CSV_XS takes care of most of that nastiness for us.
45              
46             Like many modules which have to deal with all manner of nastiness and
47             edge cases, however, it can be clumsy to work with in the simple case.
48              
49             Thus this module.
50              
51             We simply provide a little wrapper around Text::CSV_XS to streamline the
52             common case scenario. (Or at least B common case scenario; feel free
53             to write your own wrapper if this one doesn't do what you want).
54              
55             =head1 METHODS
56              
57             =head2 new
58              
59             my $parser = Text::CSV::Simple->new(\%options);
60              
61             Construct a new parser. This takes all the same options as Text::CSV_XS.
62              
63             =head2 read_file
64              
65             my @data = $parser->read_file($filename);
66              
67             Read the data in the given file, parse it, and return it as a list of
68             data.
69              
70             Each entry in the returned list will be a listref of parsed CSV data.
71              
72             =head2 want_fields
73              
74             $parser->want_fields(1, 2, 4, 8);
75              
76             If you only want to extract certain fields from the CSV, you can set up
77             the list of fields you want, and, hey presto, those are the only ones
78             that will be returned in each listref. The fields, as with Perl arrays,
79             are zero based (i.e. the above example returns the second, third, fifth
80             and ninth entries for each line)
81              
82             =head2 field_map
83              
84             $parser->field_map(qw/id name null town null postcode/);
85              
86             Rather than getting back a listref for each entry in your CSV file, you
87             often want a hash of data with meaningful names. If you set up a field_map
88             giving the name you'd like for each field, then we do the right thing
89             for you! Fields named 'null' vanish into the ether.
90              
91             =head1 TRIGGER POINTS
92              
93             To enable you to make this module do things that I haven't dreamed off
94             (without you having to bother me with requests to extend the
95             functionality), we use Class::Trigger to provide a variety of points at
96             which you can hook in and do what you need. In general these should be
97             attached to the $parser object you've already created, although you
98             could also subclass this module and set these up as class data.
99              
100             Each time we call a trigger we wrap it in an eval block. If the eval
101             block catches an error we simply call 'next' on the loop. These can
102             therefore be used for short-circuiting.on certain conditions.
103              
104             =head2 before_parse
105              
106             $parser->add_trigger(before_parse => sub {
107             my ($self, $line) = @_;
108             die unless $line =~ /wanted/i;
109             });
110              
111             Before we call Text::CSV_XS 'parse' on each line of input text, we call
112             the before_parse trigger with that line of text.
113              
114             =head2 after_parse
115              
116             $parser->add_trigger(after_parse => sub {
117             my ($self, $data) = @_;
118             die unless $wanted{$data->[0]};
119             });
120              
121             After we sucessfully call Text::CSV_XS 'parse' on each line of input text,
122             we call the after_parse trigger with a list ref of the values
123              
124             =head2 error
125              
126             Currenly, for each line that we can't parse, we call the 'failure'
127             trigger (with the Text::CSV_XS parser object), which emits a warning
128             and moves on. This happens in an invisible superclass, so you can supply
129             your own behaviour here:
130              
131             $parser->add_trigger(on_failure => sub {
132             my ($self, $csv) = @_;
133             warn "Failed on " . $csv->error_input . "\n";
134             });
135              
136             =cut
137              
138             sub new {
139 6     6 1 6904 my $class = shift;
140 6         37 return bless { _parser => Text::CSV_XS->new(@_), } => $class;
141             }
142              
143 6     6   13 sub _parser { shift->{_parser} }
144              
145             sub _file {
146 12     12   15 my $self = shift;
147 12 100       36 $self->{_file} = shift if @_;
148 12         35 return $self->{_file};
149             }
150              
151             sub _contents {
152 6     6   7 my $self = shift;
153 6 50       11 my @lines = File::Slurp::read_file($self->_file)
154             or die "Can't read " . $self->_file;
155 6         843 return @lines;
156             }
157              
158             sub want_fields {
159 19     19 1 89 my $self = shift;
160 19 100       38 if (@_) {
161 1         4 $self->{_wanted} = [@_];
162             }
163 19 100       33 return @{ $self->{_wanted} || [] };
  19         95  
164             }
165              
166             sub field_map {
167 17     17 1 136 my $self = shift;
168 17 100       34 if (@_) {
169 2         7 $self->{_map} = [@_];
170             }
171 17 100       19 return @{ $self->{_map} || [] };
  17         81  
172             }
173              
174             sub read_file {
175 6     6 1 340 my ($self, $file) = @_;
176 6         17 $self->_file($file);
177 6         14 my @lines = $self->_contents;
178 6         9 my @return;
179 6         17 my $csv = $self->_parser;
180 6         12 foreach my $line (@lines) {
181 18         24 eval { $self->call_trigger(before_parse => $line) };
  18         52  
182 18 100       599 next if $@;
183 17 50       32 next unless $line;
184 17 50       43 unless ($csv->parse($line)) {
185 0         0 $self->call_trigger(on_failure => $csv);
186 0         0 next;
187             }
188 17         360 my @fields = $csv->fields;
189 17         117 eval { $self->call_trigger(after_parse => \@fields) };
  17         41  
190 17 100       590 next if $@;
191 15 100       23 if (my @wanted = $self->want_fields) {
192 3         33 @fields = @fields[ $self->want_fields ];
193             }
194 15         38 my $addition = [ @fields ];
195 15 100       30 if (my @map = $self->field_map) {
196 6         8 my $hash = { map { $_ => shift @fields } @map };
  18         39  
197 6         11 delete $hash->{null};
198 6         9 $addition = $hash;
199             }
200 15         26 eval { $self->call_trigger(after_processing => $addition) };
  15         39  
201 15 50       462 next if $@;
202 15         40 push @return, $addition;
203             }
204 6         29 return @return;
205             }
206              
207             =head1 AUTHOR
208              
209             Tony Bowden
210              
211             =head1 BUGS
212              
213             This doesn't cope with multi-line fields. Technically the CSV format
214             allows this, but this is meant to be a ::Simple module, and coping with
215             that is currently outside the cope of this module.
216              
217             =head1 SEE ALSO
218              
219             Text::CSV_XS
220              
221             =head1 BUGS and QUERIES
222              
223             Please direct all correspondence regarding this module to:
224             bug-Text-CSV-Simple@rt.cpan.org
225              
226             =head1 COPYRIGHT AND LICENSE
227              
228             Copyright (C) 2004-2005 Tony Bowden.
229              
230             This program is free software; you can redistribute it and/or modify
231             it under the terms of the GNU General Public License; either version
232             2 of the License, or (at your option) any later version.
233              
234             This program is distributed in the hope that it will be useful,
235             but WITHOUT ANY WARRANTY; without even the implied warranty of
236             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
237              
238             =cut
239