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 header header_acc class numberformat
  12    dateformat _io _csv _objects _parsed _data
  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     header        => { type    => ARRAYREF, optional => 1 },
  24     header_acc    => { type    => HASHREF,  optional => 1 },
  25     file          => 1,
  26     encoding      => 0,
  27     class         => 0,
  28     numberformat  => 0,
  29     dateformat    => 0,
  30   });
  31   my $self = bless {}, $class;
  32
  33   $self->$_($params{$_}) for keys %params;
  34
  35   $self->_io(IO::File->new);
  36   $self->_csv(Text::CSV->new({
  37     binary => 1,
  38     sep_char   => $self->sep_char,
  39     quote_char => $self->quote_char,
  40
  41   }));
  42
  43   return $self;
  44 }
  45
  46 sub parse {
  47   my ($self, %params) = @_;
  48
  49   $self->_open_file;
  50   return unless $self->_check_header;
  51   return unless $self->_parse_data;
  52
  53   $self->_parsed(1);
  54   return $self;
  55 }
  56
  57 sub get_data {
  58   $_[0]->_data;
  59 }
  60
  61 sub get_objects {
  62   my ($self, %params) = @_;
  63   croak 'no class given'   unless $self->class;
  64   croak 'must parse first' unless $self->_parsed;
  65
  66   $self->_make_objects unless $self->_objects;
  67   return wantarray ? @{ $self->_objects } : $self->_objects;
  68 }
  69
  70 # private stuff
  71
  72 sub _open_file {
  73   my ($self, %params) = @_;
  74
  75   $self->encoding($self->_guess_encoding) if !$self->encoding;
  76
  77   $self->_io->open($self->file, '<' . $self->_encode_layer)
  78     or die "could not open file " . $self->file;
  79
  80   return $self->_io;
  81 }
  82
  83 sub _check_header {
  84   my ($self, %params) = @_;
  85   return $self->header if $self->header;
  86
  87   my $header = $self->_csv->getline($self->_io);
  88
  89   $self->header($header);
  90 }
  91
  92 sub _parse_data {
  93   my ($self, %params) = @_;
  94   my @data;
  95
  96   $self->_csv->column_names(@{ $self->header });
  97
  98   push @data, $self->_csv->getline_hr($self->_io)
  99     while !$self->_csv->eof;
 100
 101   $self->_data(\@data);
 102 }
 103
 104 sub _encode_layer {
 105   ':encoding(' . $_[0]->encoding . ')';
 106 }
 107
 108 sub _make_objects {
 109   my ($self, %params) = @_;
 110   my @objs;
 111
 112   eval "require " . $self->class;
 113   local $::myconfig{numberformat} = $self->numberformat if $self->numberformat;
 114   local $::myconfig{dateformat}   = $self->dateformat   if $self->dateformat;
 115
 116   for my $line (@{ $self->_data }) {
 117     push @objs, $self->class->new(
 118       map {
 119         ($self->header_acc && $self->header_acc->{$_}) || $_ => $line->{$_}
 120       } grep { $_ } keys %$line
 121     );
 122   }
 123
 124   $self->_objects(\@objs);
 125 }
 126
 127 sub _guess_encoding {
 128   # won't fix
 129   'utf-8';
 130 }
 131
 132
 133 1;
 134
 135 __END__
 136
 137 =head1 NAME
 138
 139 SL::Helper::Csv - take care of csv file uploads
 140
 141 =head1 SYNOPSIS
 142
 143   use SL::Helper::Csv;
 144
 145   my $csv = SL::Helper::Csv->new(
 146     file        => \$::form->{upload_file},
 147     encoding    => 'utf-8', # undef means utf8
 148     sep_char    => ',',     # default ';'
 149     quote_char  => ''',     # default '"'
 150     header      => [qw(id text sellprice word)] # see later
 151     header_acc  => { sellprice => 'sellprice_as_number' }
 152     class       => 'SL::DB::CsvLine',   # if present, map lines to this
 153   )
 154
 155   my $status  = $csv->parse;
 156   my @hrefs   = $csv->get_data;
 157   my @objects = $scv->get_objects;
 158
 159 =head1 DESCRIPTION
 160
 161 See Synopsis.
 162
 163 Text::CSV offeres already good functions to get lines out of a csv file, but in
 164 most cases you will want those line to be parsed into hashes or even objects,
 165 so this model just skips ahead and gives you objects.
 166
 167 Encoding autodetection is not easy, and should not be trusted. Try to avoid it if possible.
 168
 169 =head1 METHODS
 170
 171 =over 4
 172
 173 =item C<new> PARAMS
 174
 175 Standard constructor. You can use this to set most of the data.
 176
 177 =item C<parse>
 178
 179 Do the actual work. Will return true ($self actually) if success, undef if not.
 180
 181 =item C<get_objects>
 182
 183 Parse the data into objects and return those.
 184
 185 =item C<get_data>
 186
 187 Returns an arrayref of the raw lines as hashrefs.
 188
 189 =item C<file>
 190
 191 The file which contents are to be read. Can be a name of a physical file or a
 192 scalar ref for memory data.
 193
 194 =item C<encoding>
 195
 196 Encoding of the CSV file. Note that this module does not do any encoding guessing.
 197 Know what your data ist. Defaults to utf-8.
 198
 199 =item C<sep_char>
 200
 201 =item C<quote_char>
 202
 203 Same as in L<Text::CSV>
 204
 205 =item C<header> \@FIELDS
 206
 207 can be an array of columns, in this case the first line is not used as a
 208 header. Empty header fields will be ignored in objects.
 209
 210 =item C<header_acc> \%ACCESSORS
 211
 212 May be used to map header fields to custom accessors. Example:
 213
 214   { listprice => listprice_as_number }
 215
 216 In this case C<listprice_as_number> will be used to read in values from the
 217 C<listprice> column.
 218
 219 =item C<class>
 220
 221 If present, the line will be handed to the new sub of this class,
 222 and the return value used instead of the line itself.
 223
 224 =back
 225
 226 =head1 BUGS
 227
 228 =head1 AUTHOR
 229
 230 =cut