[libcatmandu-perl] 27/101: Fixing data isn't a Catmandu::Iterable bug
Jonas Smedegaard
dr at jones.dk
Tue Feb 23 13:43:50 UTC 2016
This is an automated email from the git hooks/post-receive script.
js pushed a commit to branch master
in repository libcatmandu-perl.
commit 917698c186585d8c08be0901fc6662f966acb376
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Fri Dec 11 15:00:23 2015 +0100
Fixing data isn't a Catmandu::Iterable bug
---
lib/Catmandu/Fix.pm | 9 +++++----
t/Catmandu-ArrayIterator.t | 2 +-
t/Catmandu-Cmd-convert.t | 2 +-
t/Catmandu-Fix.t | 9 ++++++++-
4 files changed, 15 insertions(+), 7 deletions(-)
diff --git a/lib/Catmandu/Fix.pm b/lib/Catmandu/Fix.pm
index 7288c76..1eff3cb 100644
--- a/lib/Catmandu/Fix.pm
+++ b/lib/Catmandu/Fix.pm
@@ -45,15 +45,16 @@ sub _build_fixes {
my $fixes = [];
for my $fix (@$fixes_arg) {
+
if (is_code_ref($fix)) {
push @$fixes, require_package('Catmandu::Fix::code')->new($fix);
+ } elsif (ref $fix && ref($fix) =~ /^IO::/) {
+ my $txt = Catmandu::Util::read_io($fix);
+ push @$fixes, @{$self->parser->parse($txt)};
} elsif (is_glob_ref($fix)) {
my $fh = Catmandu::Util::io $fix , binmode => ':encoding(UTF-8)';
my $txt = Catmandu::Util::read_io($fh);
push @$fixes, @{$self->parser->parse($txt)};
- } elsif (ref $fix && ref $fix =~ /^IO::/) {
- my $txt = Catmandu::Util::read_io($fix);
- push @$fixes, @{$self->parser->parse($txt)};
} elsif (ref $fix) {
push @$fixes, $fix;
} elsif (is_string($fix)) {
@@ -104,7 +105,7 @@ sub fix {
return $d;
}
- if (is_instance($data)) {
+ if (is_instance($data) && $data->DOES('Catmandu::Iterable')) {
return $data->map(sub { $fixer->($_[0]) })
->reject(sub { $self->_is_reject($_[0]) });
}
diff --git a/t/Catmandu-ArrayIterator.t b/t/Catmandu-ArrayIterator.t
index d2923b0..2cbcc63 100644
--- a/t/Catmandu-ArrayIterator.t
+++ b/t/Catmandu-ArrayIterator.t
@@ -41,7 +41,7 @@ $it->each(sub {
$it->rewind;
-my $count = 0;
+$count = 0;
$it->each_until(sub {
is shift->{n} , ++$count , "each ($count)";
return $count == 2 ? undef : 1;
diff --git a/t/Catmandu-Cmd-convert.t b/t/Catmandu-Cmd-convert.t
index ef4c44b..9ad0a23 100644
--- a/t/Catmandu-Cmd-convert.t
+++ b/t/Catmandu-Cmd-convert.t
@@ -26,7 +26,7 @@ is $result->error, undef, 'threw no exceptions' ;
# Next test can fail on buggy Perl installations
##is $result->stderr, '', 'nothing sent to sderr' ;
-$result = test_app(qq|Catmandu::CLI| => [ qw(convert -v --start=2 --total=1 CSV --file t/planets.csv to CSV --header 0 --fields english,latin) ]);
+$result = test_app(qq|Catmandu::CLI| => [ qw(convert -v --start=2 --total=1 CSV --file t/planets.csv to CSV --header 0 --fields), "english,latin" ]);
is $result->stdout, "Moon,Luna\n", 'start and limit' ;
done_testing 6;
diff --git a/t/Catmandu-Fix.t b/t/Catmandu-Fix.t
index 0df39e4..dcce5d1 100644
--- a/t/Catmandu-Fix.t
+++ b/t/Catmandu-Fix.t
@@ -4,6 +4,7 @@ use utf8;
use warnings;
use Test::More;
use Test::Exception;
+use IO::File;
use Catmandu::Importer::Mock;
use Catmandu::Util qw(:is);
@@ -23,6 +24,8 @@ is_deeply $fixer->fix({name => 'value'}) , {name => 'value'};
is_deeply $fixer->fix({name => { name => 'value'} }) , {name => { name => 'value'} };
is_deeply $fixer->fix({name => [ { name => 'value'} ] }) , { name => [ { name => 'value'} ] };
+throws_ok { $fixer->fix(IO::File->new("<t/myfixes.fix")) } 'Catmandu::BadArg' , 'throws Catmandu::BadArg';
+
is_deeply $fixer->fix([]), [] , 'fixing arrays';
is_deeply $fixer->fix([{name => 'value'}]) , [{name => 'value'}];
is_deeply $fixer->fix([{name => { name => 'value'} }]) , [{name => { name => 'value'} }];
@@ -73,4 +76,8 @@ ok $fixer;
is_deeply $fixer->fix({}), {utf8_name => 'ვეპხის ტყაოსანი შოთა რუსთაველი'} , 'fixing utf8';
close(FH);
-done_testing 28;
\ No newline at end of file
+$fixer = Catmandu::Fix->new(fixes => [IO::File->new('< t/myfixes.fix')]);
+ok $fixer;
+is_deeply $fixer->fix({}), {utf8_name => 'ვეპხის ტყაოსანი შოთა რუსთაველი'} , 'fixing utf8';
+
+done_testing 31;
\ No newline at end of file
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-perl.git
More information about the Pkg-perl-cvs-commits
mailing list