[libcatmandu-perl] 05/46: better support custom column names in CSV exporter

[Jonas Smedegaard]

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

js pushed a commit to tag 0.9205
in repository libcatmandu-perl.

commit 1436946042380de8d439aa843fd706e01a6d4fb6
Author: Jakob Voss <voss at gbv.de>
Date:   Wed Jun 25 11:17:44 2014 +0200

    better support custom column names in CSV exporter
---
 lib/Catmandu/Exporter/CSV.pm | 73 ++++++++++++++++++++++----------------------
 t/Catmandu-Exporter-CSV.t    | 20 ++++++------
 2 files changed, 48 insertions(+), 45 deletions(-)

diff --git a/lib/Catmandu/Exporter/CSV.pm b/lib/Catmandu/Exporter/CSV.pm
index ee19250..27eb23f 100644
--- a/lib/Catmandu/Exporter/CSV.pm
+++ b/lib/Catmandu/Exporter/CSV.pm
@@ -7,27 +7,40 @@ use Moo;
 
 with 'Catmandu::Exporter';
 
-has csv         => (is => 'ro', lazy => 1, builder => 1);
-has sep_char    => (is => 'ro', default => sub { ',' });
-has quote_char  => (is => 'ro', default => sub { '"' });
-has escape_char => (is => 'ro', default => sub { '"' });
-has header      => (is => 'rw', default => sub { 1 });
+has csv          => (is => 'ro', lazy => 1, builder => 1);
+has sep_char     => (is => 'ro', default => sub { ',' });
+has quote_char   => (is => 'ro', default => sub { '"' });
+has escape_char  => (is => 'ro', default => sub { '"' });
+has always_quote => (is => 'ro');
+has header       => (is => 'lazy', default => sub { 1 });
+
 has fields => (
-    is     => 'rw',
-    coerce => sub {
-        my $fields = $_[0];
-        if (ref $fields eq 'ARRAY') { return $fields }
-        if (ref $fields eq 'HASH')  { return [sort keys %$fields] }
-        return [split ',', $fields];
+    is      => 'rw',
+    trigger => sub {
+        my ($self, $fields) = @_;
+        $self->{fields} = _coerce_list($fields);
+        if (ref $fields and ref $fields eq 'HASH') {
+            $self->{header} = [
+                map { $fields->{$_} // $_ } @{$self->{fields}} 
+            ];
+        }
     },
 );
 
+sub _coerce_list {
+    my $fields = $_[0];
+    if (ref $fields eq 'ARRAY') { return $fields }
+    if (ref $fields eq 'HASH')  { return [sort keys %$fields] }
+    return [split ',', $fields];
+}
+
 sub _build_csv {
     my ($self) = @_;
     Text::CSV->new({
         binary => 1,
         eol => "\n",
         sep_char => $self->sep_char,
+        always_quote => $self->always_quote,        
         quote_char => $self->quote_char ? $self->quote_char : undef,
         escape_char => $self->escape_char ? $self->escape_char : undef,
     });
@@ -35,7 +48,8 @@ sub _build_csv {
 
 sub add {
     my ($self, $data) = @_;
-    my $fields = $self->fields || $self->fields($data);
+    $self->fields([ sort keys %$data ]) unless $self->fields;
+    my $fields = $self->fields;
     my $row = [map {
         my $val = $data->{$_} // "";
         $val =~ s/\t/\\t/g;
@@ -45,9 +59,7 @@ sub add {
     } @$fields];
     my $fh = $self->fh;
     if ($self->count == 0 && $self->header) {
-        $self->csv->print($fh, ref $self->header
-            ? [map { $self->header->{$_} // $_ } @$fields]
-            : $fields);
+        $self->csv->print($fh, ref $self->header ? $self->header : $fields);
     }
     $self->csv->print($fh, $row);
 }
@@ -61,17 +73,16 @@ Catmandu::Exporter::CSV - a CSV exporter
     use Catmandu::Exporter::CSV;
 
     my $exporter = Catmandu::Exporter::CSV->new(
-				fix => 'myfix.txt'
-				quote_char => '"' ,
-				sep_char => ',' ,
+				fix => 'myfix.txt',
+				quote_char => '"',
+				sep_char => ',',
+                escape_char => '"' ,
+                always_quote => 1,
 				header => 1);
 
     $exporter->fields("f1,f2,f3");
     $exporter->fields([qw(f1 f2 f3)]);
 
-    # add custom header labels
-    $exporter->header({f2 => 'field two'});
-
     $exporter->add_many($arrayref);
     $exporter->add_many($iterator);
     $exporter->add_many(sub { });
@@ -104,24 +115,14 @@ Character for escaping inside quoted field (C<"> by default)
 
 =item fields
 
-List of fields to be used as columns, given as array reference, comma-separated string, or hash reference.
-
-=head2 fields($arrayref)
-
-Set the field names by an ARRAY reference.
-
-=head2 fields($hashref)
-
-Set the field names by the keys of a HASH reference.
-
-=head2 fields($string)
-
-Set the fields by a comma delimited string.
+List of fields to be used as columns, given as array reference, comma-separated
+string, or hash reference.
 
 =item header
 
-Include a header line with the field names, if set to C<1> (the default).
-Custom field names can be supplied as has reference.
+Include a header line with the column names, if set to C<1> (the default).
+Custom field names can be supplied as has reference. By default field names
+are used as as column names.
 
 =back
 
diff --git a/t/Catmandu-Exporter-CSV.t b/t/Catmandu-Exporter-CSV.t
index 99ca448..0fa51bc 100644
--- a/t/Catmandu-Exporter-CSV.t
+++ b/t/Catmandu-Exporter-CSV.t
@@ -1,5 +1,3 @@
-#!/usr/bin/env perl
-
 use strict;
 use warnings;
 use Test::More;
@@ -13,10 +11,9 @@ BEGIN {
 require_ok $pkg;
 
 my $data = [{'a' => 'moose', b => '1'}, {'a' => 'pony', b => '2'}, {'a' => 'shrimp', b => '3'}];
-my $file = "";
-
-my $exporter = $pkg->new(file => \$file);
+my $out = "";
 
+my $exporter = $pkg->new(file => \$out);
 isa_ok $exporter, $pkg;
 
 $exporter->add($_) for @$data;
@@ -29,8 +26,13 @@ pony,2
 shrimp,3
 EOF
 
-is($file, $csv, "CSV strings ok");
-
-is($exporter->count,3, "Count ok");
+is $out, $csv, "CSV strings ok";
+is $exporter->count,3, "Count ok";
+ 
+$out = "";
+$exporter = $pkg->new( fields => { a => 'Longname', x => 'X' }, file => \$out );
+$exporter->add( { a => 'Hello', b => 'World' } );
+$csv = "Longname,X\nHello,\n";
+is $out, $csv, "custom column names as HASH";
 
-done_testing 5;
+done_testing;

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