SL::Helper::Csv bekommt Klasse im Profil mitgeteilt.

diff --git a/SL/Controller/CsvImport/Base.pm b/SL/Controller/CsvImport/Base.pm
index b3b9368..c072bb2 100644 (file)
--- a/SL/Controller/CsvImport/Base.pm
+++ b/SL/Controller/CsvImport/Base.pm
@@ -31,8 +31,7 @@ sub run {
   my $profile = $self->profile;
   $self->csv(SL::Helper::Csv->new(file                   => $self->file->file_name,
                                   encoding               => $self->controller->profile->get('charset'),
-                                  class                  => $self->class,
-                                  profile                => $profile,
+                                  profile                => { profile => $profile, class => $self->class },
                                   ignore_unknown_columns => 1,
                                   strict_profile         => 1,
                                   case_insensitive_header => 1,

diff --git a/SL/Helper/Csv.pm b/SL/Helper/Csv.pm
index 3f4eaaa..01312fe 100644 (file)
--- a/SL/Helper/Csv.pm
+++ b/SL/Helper/Csv.pm
@@ -9,7 +9,7 @@ use IO::File;
 use Params::Validate qw(:all);
 use Text::CSV_XS;
 use Rose::Object::MakeMethods::Generic scalar => [ qw(
-  file encoding sep_char quote_char escape_char header profile class
+  file encoding sep_char quote_char escape_char header profile
   numberformat dateformat ignore_unknown_columns strict_profile _io _csv
   _objects _parsed _data _errors all_cvar_configs case_insensitive_header
 ) ];
@@ -29,7 +29,6 @@ sub new {
     profile                => { type    => HASHREF,  optional => 1 },
     file                   => 1,
     encoding               => 0,
-    class                  => 0,
     numberformat           => 0,
     dateformat             => 0,
     ignore_unknown_columns => 0,
@@ -71,7 +70,6 @@ sub get_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;
@@ -188,13 +186,11 @@ 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 }) {
-    my $tmp_obj = $self->class->new;
-    $self->dispatcher->dispatch($tmp_obj, $line);
+    my $tmp_obj = $self->dispatcher->dispatch($line);
     push @objs, $tmp_obj;
   }
 
@@ -248,8 +244,7 @@ SL::Helper::Csv - take care of csv file uploads
     quote_char  => '\'',    # default '"'
     escape_char => '"',     # default '"'
     header      => [qw(id text sellprice word)], # see later
-    profile     => { sellprice => 'sellprice_as_number' },
-    class       => 'SL::DB::CsvLine',   # if present, map lines to this
+    profile     => { profile => { sellprice => 'sellprice_as_number'}, class => SL::DB::Part },
   );
 
   my $status  = $csv->parse;
@@ -348,11 +343,14 @@ Same as in L<Text::CSV>
 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<profile> \%ACCESSORS
+=item C<profile> {profile => \%ACCESSORS, class => class}
 
-May be used to map header fields to custom accessors. Example:
+This is a HASHREF to hash which may contain the keys C<profile> and C<class>.
 
-  { listprice => listprice_as_number }
+The C<profile> is a HASHREF which may be used to map header fields to custom
+accessors. Example:
+
+  {profile => { listprice => listprice_as_number }}
 
 In this case C<listprice_as_number> will be used to read in values from the
 C<listprice> column.
@@ -360,7 +358,7 @@ C<listprice> column.
 In case of a One-To-One relationsship these can also be set over
 relationsships by sparating the steps with a dot (C<.>). This will work:
 
-  { customer => 'customer.name' }
+  {profile => { customer => 'customer.name' }}
 
 And will result in something like this:
 
@@ -373,15 +371,7 @@ these information are unique, and should be connected to preexisting data, you
 will have to do that for yourself. Since you provided the profile, it is
 assumed you know what to do in this case.
 
-If no profile is given, any header field found will be taken as is.
-
-If the path in a profile entry is empty, the field will be subjected to
-C<strict_profile> and C<case_insensitive_header> checking, will be parsed into
-C<get_data>, but will not be attempted to be dispatched into objects.
-
-=item C<class>
-
-If present, the line will be handed to the new sub of this class,
+If C<class> is present, the line will be handed to the new sub of this class,
 and the return value used instead of the line itself.
 
 =item C<ignore_unknown_columns>
@@ -442,18 +432,20 @@ Encoding errors are not dealt with properly.
 Dispatch to child objects, like this:
 
  $csv = SL::Helper::Csv->new(
-   file  => ...
-   class => SL::DB::Part,
-   profile => [
-     makemodel => {
-       make_1  => make,
-       model_1 => model,
-     },
-     makemodel => {
-       make_2  => make,
-       model_2 => model,
-     },
-   ]
+   file    => ...
+   profile => {
+     profile => [
+       makemodel => {
+         make_1  => make,
+         model_1 => model,
+       },
+       makemodel => {
+         make_2  => make,
+         model_2 => model,
+       },
+     ],
+     class   => SL::DB::Part,
+   }
  );
 
 =head1 AUTHOR

diff --git a/SL/Helper/Csv/Dispatcher.pm b/SL/Helper/Csv/Dispatcher.pm
index add444b..c24356d 100644 (file)
--- a/SL/Helper/Csv/Dispatcher.pm
+++ b/SL/Helper/Csv/Dispatcher.pm
@@ -22,11 +22,16 @@ sub new {
 }
 
 sub dispatch {
-  my ($self, $obj, $line) = @_;
+  my ($self, $line) = @_;
+
+  eval "require " . $self->_csv->profile->{class};
+  my $obj = $self->_csv->profile->{class}->new;
 
   for my $spec (@{ $self->_specs }) {
     $self->apply($obj, $spec, $line->{$spec->{key}});
   }
+
+  return $obj;
 }
 
 sub apply {
@@ -66,7 +71,7 @@ sub parse_profile {
   my ($self, %params) = @_;
 
   my $header  = $self->_csv->header;
-  my $profile = $self->_csv->profile;
+  my $profile = $self->_csv->profile->{profile};
   my @specs;
 
   for my $col (@$header) {
@@ -98,7 +103,7 @@ sub make_spec {
 
   return unless $path;
 
-  my $cur_class = $self->_csv->class;
+  my $cur_class = $self->_csv->profile->{class};
 
   return unless $cur_class;
 

diff --git a/t/helper/csv.t b/t/helper/csv.t
index 088ed68..972b3ad 100644 (file)
--- a/t/helper/csv.t
+++ b/t/helper/csv.t
@@ -11,9 +11,9 @@ use_ok 'SL::Helper::Csv';
 Support::TestSetup::login();
 
 my $csv = SL::Helper::Csv->new(
-  file   => \"Kaffee\n",
-  header => [ 'description' ],
-  class  => 'SL::DB::Part',
+  file    => \"Kaffee\n",
+  header  => [ 'description' ],
+  profile => { class  => 'SL::DB::Part', },
 );
 
 isa_ok $csv->_csv, 'Text::CSV_XS';
@@ -28,10 +28,10 @@ $::myconfig{numberformat} = '1.000,00';
 $::myconfig{dateformat} = 'dd.mm.yyyy';
 
 $csv = SL::Helper::Csv->new(
-  file   => \"Kaffee;0.12;12,2;1,5234\n",
-  header => [ 'description', 'sellprice', 'lastcost_as_number', 'listprice' ],
-  profile => { listprice => 'listprice_as_number' },
-  class  => 'SL::DB::Part',
+  file    => \"Kaffee;0.12;12,2;1,5234\n",
+  header  => [ 'description', 'sellprice', 'lastcost_as_number', 'listprice' ],
+  profile => {profile => { listprice => 'listprice_as_number' },
+              class   => 'SL::DB::Part',},
 );
 $csv->parse;
 
@@ -49,8 +49,8 @@ Kaffee,0.12,'12,2','1,5234'
 EOL
   sep_char => ',',
   quote_char => "'",
-  profile => { listprice => 'listprice_as_number' },
-  class  => 'SL::DB::Part',
+  profile => {profile => { listprice => 'listprice_as_number' },
+              class   => 'SL::DB::Part',}
 );
 $csv->parse;
 is scalar @{ $csv->get_objects }, 1, 'auto header works';
@@ -64,7 +64,7 @@ $csv = SL::Helper::Csv->new(
 ;;description;sellprice;lastcost_as_number;
 #####;Puppy;Kaffee;0.12;12,2;1,5234
 EOL
-  class  => 'SL::DB::Part',
+  profile => {class  => 'SL::DB::Part'},
 );
 $csv->parse;
 is scalar @{ $csv->get_objects }, 1, 'bozo header doesn\'t blow things up';
@@ -77,7 +77,7 @@ 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',
+  profile => {class  => 'SL::DB::Part'},
 );
 $csv->parse;
 is scalar @{ $csv->get_objects }, 2, 'multiple objects work';
@@ -93,7 +93,7 @@ Kaffee;;0.12;1,221.52
 Beer;1123245;0.12;1.5234
 EOL
   numberformat => '1,000.00',
-  class  => 'SL::DB::Part',
+  profile => {class  => 'SL::DB::Part'},
 );
 $csv->parse;
 is $csv->get_objects->[0]->lastcost, '1221.52', 'formatnumber';
@@ -107,7 +107,7 @@ Kaffee;;0.12;1,221.52
 Beer;1123245;0.12;1.5234
 EOL
   numberformat => '1,000.00',
-  class  => 'SL::DB::Part',
+  profile => {class  => 'SL::DB::Part'},
 );
 is $csv->parse, undef, 'broken csv header won\'t get parsed';
 
@@ -120,7 +120,7 @@ description;partnumber;sellprice;lastcost_as_number;
 Beer;1123245;0.12;1.5234
 EOL
   numberformat => '1,000.00',
-  class  => 'SL::DB::Part',
+  profile => {class  => 'SL::DB::Part'},
 );
 is $csv->parse, undef, 'broken csv content won\'t get parsed';
 is_deeply $csv->errors, [ '"Kaf"fee";;0.12;1,221.52'."\n", 2023, 'EIQ - QUO character not allowed', 5, 2 ], 'error';
@@ -136,7 +136,7 @@ Beer;1123245;0.12;1.5234;nein kein wieder
 EOL
   numberformat => '1,000.00',
   ignore_unknown_columns => 1,
-  class  => 'SL::DB::Part',
+  profile => {class  => 'SL::DB::Part'},
 );
 $csv->parse;
 is $csv->get_objects->[0]->lastcost, '1221.52', 'ignore_unkown_columns works';
@@ -150,9 +150,9 @@ Kaffee;;0.12;1,221.52;Standard 7%
 Beer;1123245;0.12;1.5234;16 %
 EOL
   numberformat => '1,000.00',
-  class  => 'SL::DB::Part',
   profile => {
-    buchungsgruppe => "buchungsgruppen.description",
+    profile => {buchungsgruppe => "buchungsgruppen.description"},
+    class  => 'SL::DB::Part',
   }
 );
 $csv->parse;
@@ -169,11 +169,13 @@ description;partnumber;sellprice;lastcost_as_number;make_1;model_1;
 Beer;1123245;0.12;1.5234;
 EOL
   numberformat => '1,000.00',
-  class  => 'SL::DB::Part',
   profile => {
-    make_1 => "makemodels.0.make",
-    model_1 => "makemodels.0.model",
-  }
+    profile => {
+      make_1 => "makemodels.0.make",
+      model_1 => "makemodels.0.model",
+    },
+    class  => 'SL::DB::Part',
+  },
 );
 $csv->parse;
 my @mm = $csv->get_objects->[0]->makemodel;
@@ -189,12 +191,14 @@ description;partnumber;sellprice;lastcost_as_number;make_1;model_1;make_2;model_
  Kaffee;;0.12;1,221.52;213;Chair 0815;523;Table 15
 EOL
   numberformat => '1,000.00',
-  class  => 'SL::DB::Part',
   profile => {
-    make_1 => "makemodels.0.make",
-    model_1 => "makemodels.0.model",
-    make_2 => "makemodels.1.make",
-    model_2 => "makemodels.1.model",
+    profile => {
+      make_1 => "makemodels.0.make",
+      model_1 => "makemodels.0.model",
+      make_2 => "makemodels.1.make",
+      model_2 => "makemodels.1.model",
+    },
+    class  => 'SL::DB::Part',
   }
 );
 $csv->parse;
@@ -215,9 +219,9 @@ $csv = SL::Helper::Csv->new(
 description;partnumber;sellprice;lastcost_as_number;buchungsgruppe;
 EOL
   numberformat => '1,000.00',
-  class  => 'SL::DB::Part',
   profile => {
-    buchungsgruppe => "buchungsgruppen.1.description",
+    profile => {buchungsgruppe => "buchungsgruppen.1.description"},
+    class  => 'SL::DB::Part',
   }
 );
 is $csv->parse, undef, 'wrong profile gets rejected';
@@ -235,9 +239,9 @@ EOL
   numberformat => '1,000.00',
   ignore_unknown_columns => 1,
   strict_profile => 1,
-  class  => 'SL::DB::Part',
   profile => {
-    lastcost => 'lastcost_as_number',
+    profile => {lastcost => 'lastcost_as_number'},
+    class  => 'SL::DB::Part',
   }
 );
 $csv->parse;
@@ -254,9 +258,9 @@ Beer;1123245;0.12;1.5234;nein kein wieder
 EOL
   numberformat => '1,000.00',
   strict_profile => 1,
-  class  => 'SL::DB::Part',
   profile => {
-    lastcost => 'lastcost_as_number',
+    profile => {lastcost => 'lastcost_as_number'},
+    class  => 'SL::DB::Part',
   }
 );
 $csv->parse;
@@ -268,7 +272,7 @@ is_deeply( ($csv->errors)[0], [ 'description', undef, 'header field \'descriptio
 $csv = SL::Helper::Csv->new(
   file   => \"Kaffee",
   header => [ 'description' ],
-  class  => 'SL::DB::Part',
+  profile => {class  => 'SL::DB::Part'},
 );
 $csv->parse;
 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'eol bug at the end of files';
@@ -277,9 +281,8 @@ is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'eol bug at the end o
 
 $csv = SL::Helper::Csv->new(
   file   => \"Description\nKaffee",
-  class  => 'SL::DB::Part',
   case_insensitive_header => 1,
-  profile => { description => 'description' },
+  profile => {profile => { description => 'description' }, class  => 'SL::DB::Part'},
 );
 $csv->parse;
 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header from csv works';
@@ -289,9 +292,8 @@ is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive hea
 $csv = SL::Helper::Csv->new(
   file   => \"Kaffee",
   header => [ 'Description' ],
-  class  => 'SL::DB::Part',
   case_insensitive_header => 1,
-  profile => { description => 'description' },
+  profile => {profile => { description => 'description' }, class  => 'SL::DB::Part'},
 );
 $csv->parse;
 is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive header as param works';
@@ -300,7 +302,7 @@ is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'case insensitive hea
 
 $csv = SL::Helper::Csv->new(
   file   => \"\x{EF}\x{BB}\x{BF}description\nKaffee",
-  class  => 'SL::DB::Part',
+  profile => {class  => 'SL::DB::Part'},
   encoding => 'utf8',
 );
 $csv->parse;
@@ -356,4 +358,10 @@ $csv->parse;
 is_deeply $csv->get_data, [ { cvar_Groundhog => 'Phil' } ], 'using empty path to get cvars working';
 ok $csv->get_objects->[0], '...and not destorying the objects';
 
+$csv = SL::Helper::Csv->new(
+  file   => \"description\nKaffee",
+);
+$csv->parse;
+is_deeply $csv->get_data, [ { description => 'Kaffee' } ], 'without profile and class works';
+
 # vim: ft=perl