1 package SL::Helper::Csv;
9 use Params::Validate qw(:all);
10 use Rose::Object::MakeMethods::Generic scalar => [ qw(
11 file encoding sep_char quote_char escape_char header dispatch class
12 numberformat dateformat _io _csv _objects _parsed _data _errors
20 my %params = validate(@_, {
21 sep_char => { default => ';' },
22 quote_char => { default => '"' },
23 escape_char => { default => '"' },
24 header => { type => ARRAYREF, optional => 1 },
25 dispatch => { type => HASHREF, optional => 1 },
32 my $self = bless {}, $class;
34 $self->$_($params{$_}) for keys %params;
36 $self->_io(IO::File->new);
37 $self->_csv(Text::CSV->new({
39 sep_char => $self->sep_char,
40 quote_char => $self->quote_char,
41 escape_char => $self->escape_char,
50 my ($self, %params) = @_;
53 return unless $self->_check_header;
54 return unless $self->_parse_data;
65 my ($self, %params) = @_;
66 croak 'no class given' unless $self->class;
67 croak 'must parse first' unless $self->_parsed;
69 $self->_make_objects unless $self->_objects;
70 return wantarray ? @{ $self->_objects } : $self->_objects;
84 my ($self, %params) = @_;
86 $self->encoding($self->_guess_encoding) if !$self->encoding;
88 $self->_io->open($self->file, '<' . $self->_encode_layer)
89 or die "could not open file " . $self->file;
95 my ($self, %params) = @_;
96 return $self->header if $self->header;
98 my $header = $self->_csv->getline($self->_io);
100 $self->header($header);
103 sub _check_header_for_class {
104 my ($self, %params) = @_;
107 return unless $self->class;
108 return $self->header;
110 for my $method (@{ $self->header }) {
111 next if $self->class->can($self->_real_method($method));
116 "header field $method is not recognized",
122 $self->_push_error(@errors);
128 my ($self, %params) = @_;
131 $self->_csv->column_names(@{ $self->header });
134 my $row = $self->_csv->getline($self->_io);
135 last if $self->_csv->eof;
139 @hr{@{ $self->header }} = @$row;
143 $self->_csv->error_input,
144 $self->_csv->error_diag,
145 $self->_io->input_line_number,
150 $self->_data(\@data);
151 $self->_push_error(@errors);
157 ':encoding(' . $_[0]->encoding . ')';
161 my ($self, %params) = @_;
164 eval "require " . $self->class;
165 local $::myconfig{numberformat} = $self->numberformat if $self->numberformat;
166 local $::myconfig{dateformat} = $self->dateformat if $self->dateformat;
168 for my $line (@{ $self->_data }) {
169 push @objs, $self->class->new(
171 $self->_real_method($_) => $line->{$_}
172 } grep { $_ } keys %$line
176 $self->_objects(\@objs);
180 my ($self, $arg) = @_;
181 ($self->dispatch && $self->dispatch->{$arg}) || $arg;
184 sub _guess_encoding {
190 my ($self, @errors) = @_;
191 my @new_errors = ($self->errors, @errors);
192 $self->_errors(\@new_errors);
204 SL::Helper::Csv - take care of csv file uploads
210 my $csv = SL::Helper::Csv->new(
211 file => \$::form->{upload_file},
212 encoding => 'utf-8', # undef means utf8
213 sep_char => ',', # default ';'
214 quote_char => ''', # default '"'
215 header => [qw(id text sellprice word)] # see later
216 dispatch => { sellprice => 'sellprice_as_number' }
217 class => 'SL::DB::CsvLine', # if present, map lines to this
220 my $status = $csv->parse;
221 my $hrefs = $csv->get_data;
222 my @objects = $scv->get_objects;
228 Text::CSV offeres already good functions to get lines out of a csv file, but in
229 most cases you will want those line to be parsed into hashes or even objects,
230 so this model just skips ahead and gives you objects.
232 Encoding autodetection is not easy, and should not be trusted. Try to avoid it
241 Standard constructor. You can use this to set most of the data.
245 Do the actual work. Will return true ($self actually) if success, undef if not.
249 Parse the data into objects and return those.
251 This method will return list or arrayref depending on context.
255 Returns an arrayref of the raw lines as hashrefs.
259 Return all errors that came up druing parsing. See error handling for detailed
270 The file which contents are to be read. Can be a name of a physical file or a
271 scalar ref for memory data.
275 Encoding of the CSV file. Note that this module does not do any encoding
276 guessing. Know what your data ist. Defaults to utf-8.
284 Same as in L<Text::CSV>
286 =item C<header> \@FIELDS
288 Can be an array of columns, in this case the first line is not used as a
289 header. Empty header fields will be ignored in objects.
291 =item C<dispatch> \%ACCESSORS
293 May be used to map header fields to custom accessors. Example:
295 { listprice => listprice_as_number }
297 In this case C<listprice_as_number> will be used to read in values from the
302 If present, the line will be handed to the new sub of this class,
303 and the return value used instead of the line itself.
307 =head1 ERROR HANDLING
309 After parsing a file all errors will be accumulated into C<errors>.
311 Each entry is an arrayref with the following structure:
315 Text::CSV error code if T:C error, 0 else,
318 estimated line in file,
321 Note that the last entry can be off, but will give an estimate.
329 sep_char, quote_char, and escape_char are passed to Text::CSV on creation.
330 Changing them later has no effect currently.
334 Encoding errors are not dealt with properly.
340 Dispatch to child objects, like this:
342 $csv = SL::Helper::Csv->new(
344 class => SL::DB::Part,
359 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>