File Coverage

blib/lib/Text/CSV/Slurp.pm
Criterion Covered Total %
statement 62 68 91.1
branch 12 18 66.6
condition 2 6 33.3
subroutine 10 10 100.0
pod 3 3 100.0
total 89 105 84.7


line stmt bran cond sub pod time code
1             package Text::CSV::Slurp;
2              
3 4     4   168179 use strict;
  4         6  
  4         93  
4 4     4   10 use warnings;
  4         6  
  4         86  
5              
6 4     4   1803 use Text::CSV;
  4         31333  
  4         17  
7 4     4   1715 use IO::File;
  4         24865  
  4         348  
8 4     4   1655 use IO::Scalar;
  4         10638  
  4         146  
9              
10 4     4   61 use vars qw/$VERSION/;
  4         9  
  4         1797  
11              
12             $VERSION = 1.03;
13              
14             sub new {
15 1     1 1 9 my $class = shift;
16 1         3 return bless {}, $class;
17             }
18              
19             sub load {
20 5     5 1 13058 my $class = shift;
21 5         13 my %opt = @_;
22              
23 5         9 my %default = ( binary => 1 );
24 5         15 %opt = (%default, %opt);
25              
26 5         7 my $io;
27 5 50       18 if (defined $opt{filehandle}) {
    100          
    50          
28 0         0 $io = $opt{filehandle};
29 0         0 delete $opt{filehandle};
30             }
31             elsif (defined $opt{file}) {
32 4         14 $io = new IO::File;
33 4 100       199 open($io, "<$opt{file}") || die "Could not open $opt{file} $!";
34 3         5 delete $opt{file};
35 3         6 return _from_handle($io,\%opt);
36             }
37             elsif (defined $opt{string}) {
38 1         9 $io = IO::Scalar->new(\$opt{string});
39 1         84 delete $opt{string};
40             }
41             else {
42 0         0 die "Need either a file, filehandle or string to work with";
43             }
44 1         3 return _from_handle($io,\%opt);
45             }
46              
47             sub create {
48 1     1 1 29 my ( undef, %arg ) = @_;
49              
50             die "Need an an array of hashes input to create CSV from"
51             unless exists $arg{input} &&
52             ref( $arg{input} ) eq 'ARRAY' &&
53 1 50 33     7 ref( @{ $arg{input} }[0] ) eq 'HASH';
  1   33     7  
54              
55 1         2 my $list = $arg{input};
56 1         1 delete $arg{input};
57              
58             # get the field names
59             my @names = defined $arg{field_order}
60 1         3 ? @{ $arg{field_order} }
61 1 50       3 : sort keys %{ $list->[0] };
  0         0  
62              
63 1         1 delete $arg{field_order};
64              
65 1         3 %arg = ( binary => 1, %arg );
66              
67 1         5 my $csv = Text::CSV->new( \%arg );
68              
69 1 50       75 unless ( $csv->combine( @names ) ) {
70 0         0 die "Failed to create the header row because of this invalid input: " . $csv->error_input;
71             }
72              
73 1         171 my @string = $csv->string;
74              
75 1         6 for my $row ( @$list ) {
76 2         5 my @data;
77 2         3 for my $name ( @names ) {
78 24         29 push @data, $row->{$name};
79             }
80              
81 2 50       4 unless ( $csv->combine( @data ) ) {
82 0         0 die "Failed to create a data row because of this invalid input: " . $csv->error_input;
83             }
84              
85 2         240 push @string, $csv->string;
86             }
87              
88 1         16 return join "\n", @string;
89             }
90              
91             sub _from_handle {
92 4     4   4 my $io = shift;
93 4         5 my $opt = shift;
94              
95 4         16 my $csv = Text::CSV->new($opt);
96              
97 4 100       251 if ( my $head = $csv->getline($io) ) {
98 3         1397 $csv->column_names( $head );
99             }
100             else {
101 1         247 die $csv->error_diag();
102             }
103              
104 3         66 my @results;
105 3         7 while (my $ref = $csv->getline_hr($io)) {
106 4         976 push @results, $ref;
107             }
108              
109 3         192 return \@results;
110             }
111              
112             return qw/Open hearts and empty minds/;
113              
114             =pod
115              
116             =encoding UTF-8
117              
118             =head1 NAME
119              
120             Text::CSV::Slurp - Text::CSV::Slurp - convert CSV into an array of hashes, or an array of hashes into CSV
121              
122             =head1 VERSION
123              
124             version 1.03
125              
126             =head1 SUMMARY
127              
128             I often need to take a CSV file that has a header row and turn it into
129             a perl data structure for further manipulation. This package does that
130             in as few steps as possible.
131              
132             I added a C method in version 0.8 because sometimes you just
133             want to create some bog standard CSV from an array of hashes.
134              
135             =head1 USAGE
136              
137             use Text::CSV::Slurp;
138             use strict;
139              
140             # load data from CSV input
141              
142             my $data = Text::CSV::Slurp->load(file => $filename [,%options]);
143             my $data = Text::CSV::Slurp->load(filehandle => $filehandle [,%options]);
144             my $data = Text::CSV::Slurp->load(string => $string [,%options]);
145              
146             # create a string of CSV from an array of hashes
147             my $csv = Text::CSV::Slurp->create( input => \@array_of_hashes [,%options]);
148              
149             =head1 METHODS
150              
151             =head2 new
152              
153             my $slurp = Text::CSV::Slurp->new();
154              
155             Instantiate an object.
156              
157             =head2 load
158              
159             my $data = Text::CSV::Slurp->load(file => $filename);
160             my $data = $slurp->load(file => $filename);
161              
162             Returns an arrayref of hashrefs. Any extra arguments are passed to L.
163             The first line of the CSV is assumed to be a header row. Its fields are
164             used as the keys for each of the hashes.
165              
166             =head2 create
167              
168             my $csv = Text::CSV::Slurp->create( input => \@array_of_hashes [,%options]);
169             my $csv = $slurp->create( input => \@array_of_hashes [,%options]);
170              
171             my $file = "/path/to/output/file.csv";
172              
173             open( FH, ">$file" ) || die "Couldn't open $file $!";
174             print FH $csv;
175             close FH;
176              
177             Creates CSV from an arrayref of hashrefs and returns it as a string. All optional
178             arguments are passed to L except for C.
179              
180             =head3 field_order
181              
182             C which is used to determine the fields and order in which they
183             appear in the CSV. For example:
184              
185             my $csv = Text::CSV::Slurp->create( input => \@array_of_hashes,
186             field_order => ['one','three','two'] );
187              
188             If field_order is not supplied then the sorted keys of the first hash in the
189             input are used instead.
190              
191             =head1 DEPENDENCIES
192              
193             L
194              
195             L
196              
197             L - for tests only
198              
199             =head1 LICENCE
200              
201             GNU General Public License v3
202              
203             =head1 SOURCE
204              
205             Available at L
206              
207             =head1 SEE ALSO
208              
209             L
210              
211             L
212              
213             =head1 THANKS
214              
215             To Kyle Albritton for suggesting and testing the L method
216             To Tomas Pokorny for the L patch for the L method
217              
218             =head1 AUTHOR
219              
220             BABF
221              
222             =head1 COPYRIGHT AND LICENSE
223              
224             This software is copyright (c) 2016 by BABF.
225              
226             This is free software; you can redistribute it and/or modify it under
227             the same terms as the Perl 5 programming language system itself.
228              
229             =cut
230              
231             __END__