File Coverage

blib/lib/Text/CSV_PP/Iterator.pm
Criterion Covered Total %
statement 56 70 80.0
branch 4 12 33.3
condition n/a
subroutine 14 14 100.0
pod 2 3 66.6
total 76 99 76.7


line stmt bran cond sub pod time code
1             package Text::CSV_PP::Iterator;
2              
3             # Documentation:
4             # POD-style documentation is at the end. Extract it with pod2html.*.
5             #
6             # Note:
7             # tab = 4 spaces || die.
8             #
9             # History Info:
10             # Rev Author Date Comment
11             # 1.00 Ron Savage 20070612 Initial version
12              
13 3     3   3712 use base 'Text::CSV_PP';
  3     1   7  
  3         2356  
14 3     3   49088 use strict;
  3         9  
  3         76  
15 3     3   17 use warnings;
  3         7  
  3         108  
16 3     3   18 no warnings 'redefine'; # This line is for t/test.t.
  3         7  
  3         124  
17              
18 3     3   1374 use Iterator;
  3         29298  
  3         108  
19 3     3   1356 use Iterator::IO;
  3         3998  
  3         324  
20             use Exception::Class
21             (
22 3         41 'Iterator::X::ColumnCountMismatch' =>
23             {
24             description => 'Heading column count does not match record column count',
25             fields => 'info',
26             isa => 'Iterator::X',
27             },
28             'Iterator::X::NoHeadingsInFile' =>
29             {
30             description => 'No headings in empty file',
31             isa => 'Iterator::X',
32             },
33 3     3   28 );
  3         7  
34              
35             our $VERSION = '1.04';
36              
37             # -----------------------------------------------
38              
39             # Encapsulated class data.
40              
41             {
42             my(%_attr_data) =
43             (
44             _column_names => [],
45             _file_name => '',
46             );
47              
48             sub _get_default_for
49             {
50 5     5   258 my($self, $attr_name) = @_;
51              
52 5         20 return $_attr_data{$attr_name};
53             }
54              
55             sub _set_default_for
56             {
57 3     3   51 my($self, $attr_name, $attr_value) = @_;
58              
59 3         11 $_attr_data{$attr_name} = $attr_value;
60             }
61              
62             sub _standard_keys
63             {
64 3     3   10 return keys %_attr_data;
65             }
66             }
67              
68             # -----------------------------------------------
69              
70             sub column_names
71             {
72 3     3 1 29 my($self) = @_;
73              
74 3         11 return $self -> _get_default_for('_column_names');
75              
76             } # End of column_names.
77              
78             # -----------------------------------------------
79              
80             sub fetchrow_hashref
81             {
82 2     2 0 776 my($self) = @_;
83 2         39 my($heading_count) = scalar @{$self -> column_names()};
  2         9  
84              
85 2         4 my($line);
86              
87             # If the parameter column_names was not supplied to the constructor,
88             # we must get its value from the first line of the user's file.
89              
90 2 50       42 if (scalar @{$self -> column_names()} == 0)
  2         10  
91             {
92 2         6 eval{$line = $$self{'_iterator'} -> value()};
  2         44  
93              
94             # When exhausted return something more specific.
95              
96 2 50       518 if (Iterator::X::Exhausted -> caught() )
97             {
98 2         30 Iterator::X::NoHeadingsInFile -> throw(message => "No headings in empty file. \n");
99             }
100              
101 1         103 $self -> parse($line);
102 1         7 $self -> _set_default_for('_column_names', [$self -> fields()]);
103              
104 1         2 $heading_count = scalar @{$self -> column_names()};
  1         14  
105             }
106              
107 0         0 eval{$line = $$self{'_iterator'} -> value()};
  0         0  
108              
109 0 0       0 if (Iterator::X -> caught() )
110             {
111             # Return undef at EOF to make while($h = $p -> fetchrow_hashref() ) nice to use.
112              
113 0 0       0 if (Iterator::X::Exhausted -> caught() )
114             {
115 0         0 return undef;
116             }
117             else
118             {
119 0         0 Iterator::X -> rethrow();
120             }
121             }
122              
123 0         0 $self -> parse($line);
124              
125 0         0 $line = [$self -> fields()];
126 0         0 my($column_count) = scalar @$line;
127              
128 0 0       0 ($heading_count != $column_count) && Iterator::X::ColumnCountMismatch -> throw(message => "Header/record column count mismatch. \n", info => "Headings: $heading_count. Columns: $column_count. Line: $line");
129              
130 0         0 my(%hash);
131              
132 0         0 $hash{$_} = shift @$line for @{$self -> column_names()};
  0         0  
133              
134 0         0 return \%hash;
135              
136             } # End of fetchrow_hashref.
137              
138             # -----------------------------------------------
139              
140             sub new
141             {
142 1     2 1 10 my($class, $arg) = @_;
143              
144             # Keep this class happy.
145              
146 1         2 my($hash);
147              
148 1         3 for my $attr_name ($class -> _standard_keys() )
149             {
150 2         12 my($arg_name) = $attr_name =~ /^_(.*)/;
151              
152 2 100       30 if (exists($$arg{$arg_name}) )
153             {
154 1         12 $$hash{$attr_name} = $$arg{$arg_name};
155              
156             # Keep the super class happy.
157              
158 1         3 delete $$arg{$arg_name};
159             }
160             else
161             {
162 1         4 $$hash{$attr_name} = $class -> _get_default_for($attr_name);
163             }
164             }
165              
166 1         6 my($self) = $class -> SUPER::new($arg);
167 1         169 $self = bless($self, $class); # Reconsecrate.
168              
169 1         3 for my $attr_name ($class -> _standard_keys() )
170             {
171 2         5 $self -> _set_default_for($attr_name, $$hash{$attr_name});
172             }
173              
174 1         3 $$self{'_iterator'} = ifile($self -> _get_default_for('_file_name') );
175              
176 1         1026 return $self;
177              
178             } # End of new.
179              
180             # -----------------------------------------------
181              
182             1;
183              
184             =head1 NAME
185              
186             C - Provide fetchrow_hashref() for CSV files
187              
188             =head1 Synopsis
189              
190             use Text::CSV_PP::Iterator;
191              
192             my($parser) = Text::CSV_PP::Iterator -> new
193             ({
194             column_names => [qw/One Two Three Four Five/],
195             file_name => 'no.heading.in.file.csv',
196             });
197              
198             my($hashref);
199              
200             while ($hashref = $parser -> fetchrow_hashref() )
201             {
202             print map{"$_ => $$hashref{$_}. "} sort keys %$hashref;
203             print "\n";
204             }
205              
206              
207             =head1 Description
208              
209             C is a pure Perl module.
210              
211             It is a convenient wrapper around Text::CSV_PP. Points of interest:
212              
213             o Text::CSV_PP::Iterator reads the file for you, using Iterator::IO.
214             Warning: Iterator::IO V 0.02 has 3 bugs in it, where it does not
215             call throw() properly. I've reported this via http://rt.cpan.org
216             o All of Text::CSV_PP's new() parameters are supported by the fact
217             that Text::CSV_PP::Iterator subclasses Text::CSV_PP
218             o All data is returned as a hashref just like DBI's fetchrow_hashref(),
219             using Text::CSV_PP::Iterator's only method, fetchrow_hashref()
220             o The module reads the column headers from the first record in the file, or ...
221             o The column headers can be passed in to new() if the file has none
222             o Non-existent file errors throw the exception Iterator::X::IO_Error,
223             which stringifies to a nice error message if you don't catch it
224             o EOF returns undef to allow this neat construct:
225             while ($hashref = $parser -> fetchrow_hashref() ){...}
226             o Dependencies:
227             - Iterator::IO
228             - Text::CSV_PP
229             o Example code: t/test.t demonstrates:
230             - How to call fetchrow_hashref in isolation and in a loop
231             - How to call fetchrow_hashref in eval{...} and catch exceptions
232              
233             =head1 Distributions
234              
235             This module is available both as a Unix-style distro (*.tgz) and an
236             ActiveState-style distro (*.ppd). The latter is shipped in a *.zip file.
237              
238             See http://savage.net.au/Perl-modules.html for details.
239              
240             See http://savage.net.au/Perl-modules/html/installing-a-module.html for
241             help on unpacking and installing each type of distro.
242              
243             =head1 Constructor and initialization
244              
245             new(...) returns a C object.
246              
247             This is the class's contructor.
248              
249             Usage: Text::CSV_PP::Iterator -> new({...}).
250              
251             This method takes a hashref of parameters. Only the file_name parameter is mandatory.
252              
253             For each parameter you wish to use, call new as new({param_1 => value_1, ...}).
254              
255             =over 4
256              
257             =item file_name
258              
259             This is the name of the file that this module will read for you.
260              
261             One record will be returned each time you call C.
262              
263             There is no default value for file_name.
264              
265             This parameter is mandatory.
266              
267             =back
268              
269             =head1 Method: fetchrow_hashref()
270              
271             Returns an hashref ref of column data from the next record in the input file.
272              
273             =head1 Example code
274              
275             See the file t/test.t in the distro.
276              
277             =head1 Similar Modules
278              
279             There are quite a few modules on CPAN which offer ways of processing CSV (and similar) files:
280              
281             =over 4
282              
283             =item Text::CSV
284              
285             The original, and pure-Perl, way of doing things.
286              
287             The major drawback is the lack of options to C.
288              
289             =item Text::CSV_PP
290              
291             A pure-Perl version of the next module, and the parent of my module.
292              
293             Allows the column separator to be surrounded by tabs or spaces. Nice.
294              
295             Does not allow the column headers to be provided to C.
296              
297             =item Text::CSV_XS
298              
299             A compiled module, with many options.
300              
301             Does not allow the column separator to be surrounded by tabs or spaces.
302              
303             Does not allow the column headers to be provided to C.
304              
305             I always use this module if I have a compiler available. But that was before I wrote the current module.
306              
307             =item Text::CSV::LibCSV
308              
309             Requires the external, compiled, library C, which is written in C.
310              
311             I did not test this module.
312              
313             =item Text::CSV::Simple
314              
315             This is a wrapper around the compiled code in C.
316              
317             I did not test this module.
318              
319             =item Text::LooseCSV
320              
321             I did not test this module.
322              
323             =item Text::RecordParser
324              
325             This module has a fake C, which does not list any dependencies. However,
326             when you try to install it, you get:
327              
328             - ERROR: Test::Exception is not installed
329             - ERROR: IO::Scalar is not installed
330             - ERROR: Class::Accessor is not installed
331             - ERROR: Readonly is not installed
332             - ERROR: List::MoreUtils is not installed
333             * Optional prerequisite Text::TabularDisplay is not installed
334             * Optional prerequisite Readonly::XS is not installed
335              
336             I did not test this module.
337              
338             =item Tie::CSV_File
339              
340             A different way of viewing CSV files.
341              
342             This is a wrapper around the compiled code in C.
343              
344             It supports some of the same options as C.
345              
346             I did not test this module.
347              
348             =item Text::xSV
349              
350             This module has a huge, and I do mean huge, number of methods. If only they worked...
351              
352             Unfortunately, in one set of tests this module kept overwriting my input file, which is very nasty.
353              
354             In another set, the method C did not work. Now, that method calls C,
355             which looks for the field $self->{header}, but you have to have called C, which does
356             not set $self->{header}. Rather C is aliased to C, which calls C,
357             which does not set $self->{header} either. It sets $self->{field_pos}. Oh, dear. Forget it.
358              
359             =back
360              
361             =head1 Repository
362              
363             L
364              
365             =head1 Support
366              
367             Bugs should be reported via the CPAN bug tracker at
368              
369             L
370              
371             =head1 Author
372              
373             C was written by Ron Savage Iron@savage.net.auE> in 2007.
374              
375             Home page: http://savage.net.au/index.html
376              
377             =head1 Copyright
378              
379             Australian copyright (c) 2007, Ron Savage.
380             All Programs of mine are 'OSI Certified Open Source Software';
381             you can redistribute them and/or modify them under the terms of
382             The Artistic License, a copy of which is available at:
383             http://www.opensource.org/licenses/index.html
384              
385             =cut