[libcatmandu-perl] 14/101: TabularExporter

[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 1eb531bf3bb522ccec6e6eecf7976d9b395ba537
Author: Nicolas Steenlant <nicolas.steenlant at ugent.be>
Date:   Thu Dec 10 16:36:35 2015 +0100

    TabularExporter
---
 lib/Catmandu/Exporter/CSV.pm    | 35 ++++-------------
 lib/Catmandu/TabularExporter.pm | 85 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 92 insertions(+), 28 deletions(-)

diff --git a/lib/Catmandu/Exporter/CSV.pm b/lib/Catmandu/Exporter/CSV.pm
index 8d7ec3c..0672417 100644
--- a/lib/Catmandu/Exporter/CSV.pm
+++ b/lib/Catmandu/Exporter/CSV.pm
@@ -8,34 +8,14 @@ use Text::CSV;
 use Moo;
 use namespace::clean;
 
-with 'Catmandu::Exporter';
+with 'Catmandu::TabularExporter';
 
-has csv          => (is => 'ro', lazy => 1, builder => 1);
+has csv          => (is => 'lazy');
 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',
-    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];
-}
+has header       => (is => 'ro', default => sub { 1 });
 
 sub _build_csv {
     my ($self) = @_;
@@ -51,8 +31,6 @@ sub _build_csv {
 
 sub add {
     my ($self, $data) = @_;
-    return undef unless defined $data;
-    $self->fields([ sort keys %$data ]) unless $self->fields;
     my $fields = $self->fields;
     my $row = [map {
         my $val = $data->{$_} // "";
@@ -62,11 +40,12 @@ sub add {
         $val;
     } @$fields];
     my $fh = $self->fh;
-    # we need to wait for the first row that can be printed to provide us with
-    # a header
+
+    # header
     if (!$self->count && $self->header) {
-        $self->csv->print($fh, ref $self->header ? $self->header : $fields);
+        $self->csv->print($fh, $self->columns || $fields);
     }
+
     $self->csv->print($fh, $row);
 }
 
diff --git a/lib/Catmandu/TabularExporter.pm b/lib/Catmandu/TabularExporter.pm
new file mode 100644
index 0000000..e49bbc8
--- /dev/null
+++ b/lib/Catmandu/TabularExporter.pm
@@ -0,0 +1,85 @@
+package Catmandu::TabularExporter;
+
+use Catmandu::Sane;
+
+our $VERSION = '0.9505';
+
+use Moo::Role;
+
+sub _coerce_array {
+    my $fields = $_[0];
+    if (ref $fields eq 'ARRAY') { return $fields }
+    if (ref $fields eq 'HASH')  { return [sort keys %$fields] }
+    [split ',', $fields];
+}
+
+use namespace::clean;
+
+with 'Catmandu::Exporter';
+
+has fields => (
+    is => 'rwp',
+    coerce => \&_coerce_array,
+);
+
+has columns => (
+    is => 'rwp',
+    coerce => \&_coerce_array,
+);
+
+has collect_fields => (
+    is => 'ro',
+);
+
+around add => sub {
+    my ($orig, $self, $data) = @_;
+    $self->_set_fields([sort keys %$data]) unless $self->fields;
+    $orig->($self, $data);
+};
+
+around add_many => sub {
+    my ($orig, $self, $many) = @_;
+
+    if ($self->collect_fields && !$self->fields) {
+        my $coll;
+
+        if (is_array_ref($many)) {
+            $coll = $many;
+        } elsif (is_hash_ref($many)) {
+            $coll = [$many];
+        } else {
+            if (is_invocant($many)) {
+                $many = check_able($many, 'generator')->generator;
+            }
+            check_code_ref($many);
+            $coll = [];
+            while (defined(my $data = $many->())) {
+                push @$coll, $data;
+            }
+        }
+
+        my %keys;
+        for my $data (@$coll) {
+            for my $key (keys %$data) {
+                $keys{$key} ||= 1;
+            }
+        }
+        $self->_set_fields([sort keys %keys]);
+
+        $many = $coll;
+    }
+
+    $orig->($self, $many);
+};
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catmandu::TabularExporter - base role for exporters that export a tabular format like CSV
+
+=cut

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