From 2f6ebd89e1d3580613f5fc6db5c49552fcc90947 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Sven=20Sch=C3=B6ling?= Date: Wed, 16 Feb 2011 18:16:24 +0100 Subject: [PATCH] Csv Helper Modul. --- SL/Helper/Csv.pm | 230 +++++++++++++++++++++++++++++++++++++++++++++++ t/helper/csv.t | 116 ++++++++++++++++++++++++ 2 files changed, 346 insertions(+) create mode 100644 SL/Helper/Csv.pm create mode 100644 t/helper/csv.t diff --git a/SL/Helper/Csv.pm b/SL/Helper/Csv.pm new file mode 100644 index 000000000..0336ff393 --- /dev/null +++ b/SL/Helper/Csv.pm @@ -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 PARAMS + +Standard constructor. You can use this to set most of the data. + +=item C + +Do the actual work. Will return true ($self actually) if success, undef if not. + +=item C + +Parse the data into objects and return those. + +=item C + +Returns an arrayref of the raw lines as hashrefs. + +=item C + +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 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 + +=item C + +Same as in L + +=item C
\@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 \%ACCESSORS + +May be used to map header fields to custom accessors. Example: + + { listprice => listprice_as_number } + +In this case C will be used to read in values from the +C column. + +=item C + +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 index 000000000..6de4e7216 --- /dev/null +++ b/t/helper/csv.t @@ -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 => \< ',', + 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 => \< 'SL::DB::Part', +); +$csv->parse; +is scalar @{ $csv->get_objects }, 1, 'bozo header doesn\'t blow things up'; + +##### + +$csv = SL::Helper::Csv->new( + file => \< '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 => \< '1,000.00', + class => 'SL::DB::Part', +); +$csv->parse; +is $csv->get_objects->[0]->lastcost, '1221.52', 'formatnumber'; + +###### + +$csv = SL::Helper::Csv->new( + file => \< '1,000.00', + class => 'SL::DB::Part', +); +is $csv->parse, undef, 'broken csv header won\'t get parsed'; + + +done_testing(); +# vim: ft=perl -- 2.20.1