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.steenl...@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
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
