[libcatmandu-perl] 37/101: autonaming of imported CSV data

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to branch master
in repository libcatmandu-perl.

commit 621e16a605ac2cf7810911fd41afa19f794f9a89
Author: Nicolas Steenlant <nicolas.steenlant at ugent.be>
Date:   Mon Dec 21 15:11:20 2015 +0100

    autonaming of imported CSV data
---
 lib/Catmandu/Importer/CSV.pm | 25 +++++++++++++++++++++----
 t/Catmandu-Importer-CSV.t    | 16 +++++++++++++++-
 2 files changed, 36 insertions(+), 5 deletions(-)

diff --git a/lib/Catmandu/Importer/CSV.pm b/lib/Catmandu/Importer/CSV.pm
index 277accb..4866b4c 100644
--- a/lib/Catmandu/Importer/CSV.pm
+++ b/lib/Catmandu/Importer/CSV.pm
@@ -5,6 +5,7 @@ use Catmandu::Sane;
 our $VERSION = '0.9505';
 
 use Text::CSV;
+use List::Util qw(reduce);
 use Moo;
 use namespace::clean;
 
@@ -18,7 +19,7 @@ has allow_loose_quotes => (is => 'ro', default => sub { 0 });
 has allow_loose_escapes => (is => 'ro', default => sub { 0 });
 has header => (is => 'ro', default => sub { 1 });
 has fields => (
-    is     => 'rw',
+    is     => 'rwp',
     coerce => sub {
         my $fields = $_[0];
         if (ref $fields eq 'ARRAY') { return $fields }
@@ -48,12 +49,27 @@ sub generator {
                 if ($self->fields) {
                     $self->csv->getline($fh);
                 } else {
-                    $self->fields($self->csv->getline($fh));
+                    $self->_set_fields($self->csv->getline($fh));
                 }
             }
-            $self->csv->column_names($self->fields);
+            if ($self->fields) {
+                $self->csv->column_names($self->fields);
+            }
             $self->csv;
         };
+
+        # generate field names if needed
+        unless ($self->fields) {
+            my $row = $csv->getline($fh) // return;
+            my $fields = [0 .. (@$row -1)];
+            $self->_set_fields($fields);
+            $csv->column_names($fields);
+            return reduce {
+               $a->{$b} = $row->[$b] if length $row->[$b];
+               $a;
+            } +{}, @$fields;
+        }
+
         $csv->getline_hr($fh);
     };
 }
@@ -122,7 +138,8 @@ An ARRAY of one or more fixes or file scripts to be applied to imported items.
 =item fields
 
 List of fields to be used as columns, given as array reference, comma-separated
-string, or hash reference.
+string, or hash reference. If C<header> is C<0> and C<fields> is C<undef> the
+fields will be named by column index ("0", "1", "2", ...).
 
 =item header
 
diff --git a/t/Catmandu-Importer-CSV.t b/t/Catmandu-Importer-CSV.t
index 80e4519..3af6528 100644
--- a/t/Catmandu-Importer-CSV.t
+++ b/t/Catmandu-Importer-CSV.t
@@ -29,5 +29,19 @@ isa_ok $importer, $pkg;
 
 is_deeply $importer->to_array, $data;
 
-done_testing 4;
+$data = [
+   {0=>'Patrick',1=>'39'},
+   {0=>'Nicolas',1=>'34'},
+];
+
+$csv = <<EOF;
+"Patrick","39"
+"Nicolas","34"
+EOF
+
+$importer = $pkg->new(file => \$csv, header => 0);
+
+is_deeply $importer->to_array, $data;
+
+done_testing;
 

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-perl.git