Csv Helper Modul.
authorSven Schöling <s.schoeling@linet-services.de>
Wed, 16 Feb 2011 17:16:24 +0000 (18:16 +0100)
committerMoritz Bunkus <m.bunkus@linet-services.de>
Thu, 16 Jun 2011 06:43:56 +0000 (08:43 +0200)
SL/Helper/Csv.pm [new file with mode: 0644]
t/helper/csv.t [new file with mode: 0644]

diff --git a/SL/Helper/Csv.pm b/SL/Helper/Csv.pm
new file mode 100644 (file)
index 0000000..0336ff3
--- /dev/null
@@ -0,0 +1,230 @@
+package SL::Helper::Csv;
+
+use strict;
+use warnings;
+
+use Carp;
+use IO::File;
+use Text::CSV;
+use Params::Validate qw(:all);
+use Rose::Object::MakeMethods::Generic scalar => [ qw(
+   file encoding sep_char quote_char header header_acc class numberformat
+   dateformat _io _csv _objects _parsed _data
+) ];
+
+
+# public interface
+
+sub new {
+  my $class  = shift;
+  my %params = validate(@_, {
+    sep_char      => { default => ';' },
+    quote_char    => { default => '"' },
+    header        => { type    => ARRAYREF, optional => 1 },
+    header_acc    => { type    => HASHREF,  optional => 1 },
+    file          => 1,
+    encoding      => 0,
+    class         => 0,
+    numberformat  => 0,
+    dateformat    => 0,
+  });
+  my $self = bless {}, $class;
+
+  $self->$_($params{$_}) for keys %params;
+
+  $self->_io(IO::File->new);
+  $self->_csv(Text::CSV->new({
+    binary => 1,
+    sep_char   => $self->sep_char,
+    quote_char => $self->quote_char,
+
+  }));
+
+  return $self;
+}
+
+sub parse {
+  my ($self, %params) = @_;
+
+  $self->_open_file;
+  return unless $self->_check_header;
+  return unless $self->_parse_data;
+
+  $self->_parsed(1);
+  return $self;
+}
+
+sub get_data {
+  $_[0]->_data;
+}
+
+sub get_objects {
+  my ($self, %params) = @_;
+  croak 'no class given'   unless $self->class;
+  croak 'must parse first' unless $self->_parsed;
+
+  $self->_make_objects unless $self->_objects;
+  return wantarray ? @{ $self->_objects } : $self->_objects;
+}
+
+# private stuff
+
+sub _open_file {
+  my ($self, %params) = @_;
+
+  $self->encoding($self->_guess_encoding) if !$self->encoding;
+
+  $self->_io->open($self->file, '<' . $self->_encode_layer)
+    or die "could not open file " . $self->file;
+
+  return $self->_io;
+}
+
+sub _check_header {
+  my ($self, %params) = @_;
+  return $self->header if $self->header;
+
+  my $header = $self->_csv->getline($self->_io);
+
+  $self->header($header);
+}
+
+sub _parse_data {
+  my ($self, %params) = @_;
+  my @data;
+
+  $self->_csv->column_names(@{ $self->header });
+
+  push @data, $self->_csv->getline_hr($self->_io)
+    while !$self->_csv->eof;
+
+  $self->_data(\@data);
+}
+
+sub _encode_layer {
+  ':encoding(' . $_[0]->encoding . ')';
+}
+
+sub _make_objects {
+  my ($self, %params) = @_;
+  my @objs;
+
+  eval "require " . $self->class;
+  local $::myconfig{numberformat} = $self->numberformat if $self->numberformat;
+  local $::myconfig{dateformat}   = $self->dateformat   if $self->dateformat;
+
+  for my $line (@{ $self->_data }) {
+    push @objs, $self->class->new(
+      map {
+        ($self->header_acc && $self->header_acc->{$_}) || $_ => $line->{$_}
+      } grep { $_ } keys %$line
+    );
+  }
+
+  $self->_objects(\@objs);
+}
+
+sub _guess_encoding {
+  # won't fix
+  'utf-8';
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+SL::Helper::Csv - take care of csv file uploads
+
+=head1 SYNOPSIS
+
+  use SL::Helper::Csv;
+
+  my $csv = SL::Helper::Csv->new(
+    file        => \$::form->{upload_file},
+    encoding    => 'utf-8', # undef means utf8
+    sep_char    => ',',     # default ';'
+    quote_char  => ''',     # default '"'
+    header      => [qw(id text sellprice word)] # see later
+    header_acc  => { sellprice => 'sellprice_as_number' }
+    class       => 'SL::DB::CsvLine',   # if present, map lines to this
+  )
+
+  my $status  = $csv->parse;
+  my @hrefs   = $csv->get_data;
+  my @objects = $scv->get_objects;
+
+=head1 DESCRIPTION
+
+See Synopsis.
+
+Text::CSV offeres already good functions to get lines out of a csv file, but in
+most cases you will want those line to be parsed into hashes or even objects,
+so this model just skips ahead and gives you objects.
+
+Encoding autodetection is not easy, and should not be trusted. Try to avoid it if possible.
+
+=head1 METHODS
+
+=over 4
+
+=item C<new> PARAMS
+
+Standard constructor. You can use this to set most of the data.
+
+=item C<parse>
+
+Do the actual work. Will return true ($self actually) if success, undef if not.
+
+=item C<get_objects>
+
+Parse the data into objects and return those.
+
+=item C<get_data>
+
+Returns an arrayref of the raw lines as hashrefs.
+
+=item C<file>
+
+The file which contents are to be read. Can be a name of a physical file or a
+scalar ref for memory data.
+
+=item C<encoding>
+
+Encoding of the CSV file. Note that this module does not do any encoding guessing.
+Know what your data ist. Defaults to utf-8.
+
+=item C<sep_char>
+
+=item C<quote_char>
+
+Same as in L<Text::CSV>
+
+=item C<header> \@FIELDS
+
+can be an array of columns, in this case the first line is not used as a
+header. Empty header fields will be ignored in objects.
+
+=item C<header_acc> \%ACCESSORS
+
+May be used to map header fields to custom accessors. Example:
+
+  { listprice => listprice_as_number }
+
+In this case C<listprice_as_number> will be used to read in values from the
+C<listprice> column.
+
+=item C<class>
+
+If present, the line will be handed to the new sub of this class,
+and the return value used instead of the line itself.
+
+=back
+
+=head1 BUGS
+
+=head1 AUTHOR
+
+=cut
diff --git a/t/helper/csv.t b/t/helper/csv.t
new file mode 100644 (file)
index 0000000..6de4e72
--- /dev/null
@@ -0,0 +1,116 @@
+use Test::More;
+use SL::Dispatcher;
+use utf8;
+
+use_ok 'SL::Helper::Csv';
+my $csv;
+
+$csv = SL::Helper::Csv->new(
+  file   => \"Kaffee;\n",
+  header => [ 'description' ],
+);
+
+isa_ok $csv->_csv, 'Text::CSV';
+isa_ok $csv->_io, 'IO::File';
+isa_ok $csv->parse, 'SL::Helper::Csv', 'parsing returns self';
+is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'simple case works';
+
+$csv->class('SL::DB::Part');
+
+is $csv->get_objects->[0]->description, 'Kaffee', 'get_object works';
+####
+
+SL::Dispatcher::pre_startup_setup();
+
+$::form = Form->new;
+$::myconfig{numberformat} = '1.000,00';
+$::myconfig{dateformat} = 'dd.mm.yyyy';
+$::locale = Locale->new('de');
+
+$csv = SL::Helper::Csv->new(
+  file   => \"Kaffee;0.12;12,2;1,5234\n",
+  header => [ 'description', 'sellprice', 'lastcost_as_number', 'listprice' ],
+  header_acc => { listprice => 'listprice_as_number' },
+  class  => 'SL::DB::Part',
+);
+$csv->parse;
+
+is $csv->get_objects->[0]->sellprice, 0.12, 'numeric attr works';
+is $csv->get_objects->[0]->lastcost, 12.2, 'attr helper works';
+is $csv->get_objects->[0]->listprice, 1.5234, 'header_acc works';
+
+#####
+
+
+$csv = SL::Helper::Csv->new(
+  file   => \<<EOL,
+description,sellprice,lastcost_as_number,listprice,
+Kaffee,0.12,'12,2','1,5234'
+EOL
+  sep_char => ',',
+  quote_char => "'",
+  header_acc => { listprice => 'listprice_as_number' },
+  class  => 'SL::DB::Part',
+);
+$csv->parse;
+is scalar @{ $csv->get_objects }, 1, 'auto header works';
+is $csv->get_objects->[0]->description, 'Kaffee', 'get_object works on auto header';
+
+#####
+
+
+$csv = SL::Helper::Csv->new(
+  file   => \<<EOL,
+;;description;sellprice;lastcost_as_number;
+#####;Puppy;Kaffee;0.12;12,2;1,5234
+EOL
+  class  => 'SL::DB::Part',
+);
+$csv->parse;
+is scalar @{ $csv->get_objects }, 1, 'bozo header doesn\'t blow things up';
+
+#####
+
+$csv = SL::Helper::Csv->new(
+  file   => \<<EOL,
+description;partnumber;sellprice;lastcost_as_number;
+Kaffee;;0.12;12,2;1,5234
+Beer;1123245;0.12;12,2;1,5234
+EOL
+  class  => 'SL::DB::Part',
+);
+$csv->parse;
+is scalar @{ $csv->get_objects }, 2, 'multiple objects work';
+is $csv->get_objects->[0]->description, 'Kaffee', 'first object';
+is $csv->get_objects->[1]->partnumber, '1123245', 'second object';
+
+####
+
+$csv = SL::Helper::Csv->new(
+  file   => \<<EOL,
+description;partnumber;sellprice;lastcost_as_number;
+Kaffee;;0.12;1,221.52
+Beer;1123245;0.12;1.5234
+EOL
+  numberformat => '1,000.00',
+  class  => 'SL::DB::Part',
+);
+$csv->parse;
+is $csv->get_objects->[0]->lastcost, '1221.52', 'formatnumber';
+
+######
+
+$csv = SL::Helper::Csv->new(
+  file   => \<<EOL,
+"description;partnumber;sellprice;lastcost_as_number;
+Kaffee;;0.12;1,221.52
+Beer;1123245;0.12;1.5234
+EOL
+  numberformat => '1,000.00',
+  class  => 'SL::DB::Part',
+);
+is $csv->parse, undef, 'broken csv header won\'t get parsed';
+
+
+done_testing();
+# vim: ft=perl