SL/Helper/Csv.pm

   1 package SL::Helper::Csv;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp;
   7 use IO::File;
   8 use Text::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 header_acc class
  12    numberformat dateformat _io _csv _objects _parsed _data _errors
  13 ) ];
  14
  15
  16 # public interface
  17
  18 sub new {
  19   my $class  = shift;
  20   my %params = validate(@_, {
  21     sep_char      => { default => ';' },
  22     quote_char    => { default => '"' },
  23     escape_char   => { default => '"' },
  24     header        => { type    => ARRAYREF, optional => 1 },
  25     header_acc    => { type    => HASHREF,  optional => 1 },
  26     file          => 1,
  27     encoding      => 0,
  28     class         => 0,
  29     numberformat  => 0,
  30     dateformat    => 0,
  31   });
  32   my $self = bless {}, $class;
  33
  34   $self->$_($params{$_}) for keys %params;
  35
  36   $self->_io(IO::File->new);
  37   $self->_csv(Text::CSV->new({
  38     binary => 1,
  39     sep_char    => $self->sep_char,
  40     quote_char  => $self->quote_char,
  41     escape_char => $self->escape_char,
  42
  43   }));
  44   $self->_errors([]);
  45
  46   return $self;
  47 }
  48
  49 sub parse {
  50   my ($self, %params) = @_;
  51
  52   $self->_open_file;
  53   return unless $self->_check_header;
  54   return unless $self->_parse_data;
  55
  56   $self->_parsed(1);
  57   return $self;
  58 }
  59
  60 sub get_data {
  61   $_[0]->_data;
  62 }
  63
  64 sub get_objects {
  65   my ($self, %params) = @_;
  66   croak 'no class given'   unless $self->class;
  67   croak 'must parse first' unless $self->_parsed;
  68
  69   $self->_make_objects unless $self->_objects;
  70   return wantarray ? @{ $self->_objects } : $self->_objects;
  71 }
  72
  73 sub errors {
  74   @{ $_[0]->_errors }
  75 }
  76
  77 # private stuff
  78
  79 sub _open_file {
  80   my ($self, %params) = @_;
  81
  82   $self->encoding($self->_guess_encoding) if !$self->encoding;
  83
  84   $self->_io->open($self->file, '<' . $self->_encode_layer)
  85     or die "could not open file " . $self->file;
  86
  87   return $self->_io;
  88 }
  89
  90 sub _check_header {
  91   my ($self, %params) = @_;
  92   return $self->header if $self->header;
  93
  94   my $header = $self->_csv->getline($self->_io);
  95
  96   $self->header($header);
  97 }
  98
  99 sub _parse_data {
 100   my ($self, %params) = @_;
 101   my (@data, @errors);
 102
 103   $self->_csv->column_names(@{ $self->header });
 104
 105   while (1) {
 106     my $row = $self->_csv->getline($self->_io);
 107     last if $self->_csv->eof;
 108
 109     if ($row) {
 110       my %hr;
 111       @hr{@{ $self->header }} = @$row;
 112       push @data, \%hr;
 113     } else {
 114       push @errors, [
 115         $self->_csv->error_input,
 116         $self->_csv->error_diag,
 117         $self->_io->input_line_number,
 118       ];
 119     }
 120   }
 121
 122   $self->_data(\@data);
 123   $self->_errors(\@errors);
 124
 125   return if @errors;
 126   return \@data;
 127 }
 128
 129 sub _encode_layer {
 130   ':encoding(' . $_[0]->encoding . ')';
 131 }
 132
 133 sub _make_objects {
 134   my ($self, %params) = @_;
 135   my @objs;
 136
 137   eval "require " . $self->class;
 138   local $::myconfig{numberformat} = $self->numberformat if $self->numberformat;
 139   local $::myconfig{dateformat}   = $self->dateformat   if $self->dateformat;
 140
 141   for my $line (@{ $self->_data }) {
 142     push @objs, $self->class->new(
 143       map {
 144         ($self->header_acc && $self->header_acc->{$_}) || $_ => $line->{$_}
 145       } grep { $_ } keys %$line
 146     );
 147   }
 148
 149   $self->_objects(\@objs);
 150 }
 151
 152 sub _guess_encoding {
 153   # won't fix
 154   'utf-8';
 155 }
 156
 157
 158 1;
 159
 160 __END__
 161
 162 =encoding utf-8
 163
 164 =head1 NAME
 165
 166 SL::Helper::Csv - take care of csv file uploads
 167
 168 =head1 SYNOPSIS
 169
 170   use SL::Helper::Csv;
 171
 172   my $csv = SL::Helper::Csv->new(
 173     file        => \$::form->{upload_file},
 174     encoding    => 'utf-8', # undef means utf8
 175     sep_char    => ',',     # default ';'
 176     quote_char  => ''',     # default '"'
 177     header      => [qw(id text sellprice word)] # see later
 178     header_acc  => { sellprice => 'sellprice_as_number' }
 179     class       => 'SL::DB::CsvLine',   # if present, map lines to this
 180   )
 181
 182   my $status  = $csv->parse;
 183   my $hrefs   = $csv->get_data;
 184   my @objects = $scv->get_objects;
 185
 186 =head1 DESCRIPTION
 187
 188 See Synopsis.
 189
 190 Text::CSV offeres already good functions to get lines out of a csv file, but in
 191 most cases you will want those line to be parsed into hashes or even objects,
 192 so this model just skips ahead and gives you objects.
 193
 194 Encoding autodetection is not easy, and should not be trusted. Try to avoid it if possible.
 195
 196 =head1 METHODS
 197
 198 =over 4
 199
 200 =item C<new> PARAMS
 201
 202 Standard constructor. You can use this to set most of the data.
 203
 204 =item C<parse>
 205
 206 Do the actual work. Will return true ($self actually) if success, undef if not.
 207
 208 =item C<get_objects>
 209
 210 Parse the data into objects and return those.
 211
 212 This method will return list or arrayref depending on context.
 213
 214 =item C<get_data>
 215
 216 Returns an arrayref of the raw lines as hashrefs.
 217
 218 =item C<errors>
 219
 220 Return all errors that came up druing parsing. See error handling for detailed
 221 information.
 222
 223 =back
 224
 225 =head1 PARAMS
 226
 227 =over 4
 228
 229 =item C<file>
 230
 231 The file which contents are to be read. Can be a name of a physical file or a
 232 scalar ref for memory data.
 233
 234 =item C<encoding>
 235
 236 Encoding of the CSV file. Note that this module does not do any encoding guessing.
 237 Know what your data ist. Defaults to utf-8.
 238
 239 =item C<sep_char>
 240
 241 =item C<quote_char>
 242
 243 =item C<escape_char>
 244
 245 Same as in L<Text::CSV>
 246
 247 =item C<header> \@FIELDS
 248
 249 can be an array of columns, in this case the first line is not used as a
 250 header. Empty header fields will be ignored in objects.
 251
 252 =item C<header_acc> \%ACCESSORS
 253
 254 May be used to map header fields to custom accessors. Example:
 255
 256   { listprice => listprice_as_number }
 257
 258 In this case C<listprice_as_number> will be used to read in values from the
 259 C<listprice> column.
 260
 261 =item C<class>
 262
 263 If present, the line will be handed to the new sub of this class,
 264 and the return value used instead of the line itself.
 265
 266 =back
 267
 268 =head1 ERROR HANDLING
 269
 270 After parsing a file all errors will be accumulated into C<errors>.
 271
 272 Each entry is an arrayref with the following structure:
 273
 274  [
 275    offending raw input,
 276    Text::CSV error code if present,
 277    Text::CSV error diagnostics if present,
 278    position in line,
 279    estimated line in file,
 280  ]
 281
 282 Note that the last entry can be off, but will give an estimate.
 283
 284 =head1 CAVEATS
 285
 286 =over 4
 287
 288 =item *
 289
 290 sep_char, quote_char, and escape_char are passed to Text::CSV on creation.
 291 Changing them later has no effect currently.
 292
 293 =item *
 294
 295 Encoding errors are not dealt with properly.
 296
 297 =item *
 298
 299 Errors are not gathered.
 300
 301 =back
 302
 303 =head1 AUTHOR
 304
 305 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 306
 307 =cut