This is an automated email from the git hooks/post-receive script. js pushed a commit to branch master in repository libcatmandu-perl.
commit be27eac5c8b75e6cb0e3623cde8244d24b522be5 Author: Patrick Hochstenbach <patrick.hochstenb...@ugent.be> Date: Thu Dec 10 15:50:59 2015 +0100 Adding more tests --- lib/Catmandu/Util.pm | 7 +- t/Catmandu-Util.t | 266 ++++++++++++++++++++++++++++++++++++++++++++++++++- t/russian.txt | 11 +++ t/small.json | 1 + t/small.yaml | 3 + 5 files changed, 284 insertions(+), 4 deletions(-) diff --git a/lib/Catmandu/Util.pm b/lib/Catmandu/Util.pm index ce590ff..990b6f7 100644 --- a/lib/Catmandu/Util.pm +++ b/lib/Catmandu/Util.pm @@ -123,7 +123,7 @@ sub io { sub read_file { my ($path) = @_; local $/; - open my $fh, "<", $path or Catmandu::Error->throw(qq(can't open "$path" for reading)); + open my $fh, "<:encoding(UTF-8)", $path or Catmandu::Error->throw(qq(can't open "$path" for reading)); my $str = <$fh>; close $fh; $str; @@ -131,6 +131,7 @@ sub read_file { sub read_io { my ($io) = @_; + $io->binmode("encoding(UTF-8)"); my @lines = (); while (<$io>) { push @lines, $_; @@ -142,7 +143,7 @@ sub read_io { # Deprecated use tools like File::Slurp::Tiny sub write_file { my ($path, $str) = @_; - open my $fh, ">", $path or Catmandu::Error->throw(qq(can't open "$path" for writing)); + open my $fh, ">:encoding(UTF-8)", $path or Catmandu::Error->throw(qq(can't open "$path" for writing)); print $fh $str; close $fh; $path; @@ -156,7 +157,7 @@ sub read_yaml { sub read_json { my $text = read_file($_[0]); # dies on error - JSON::XS::decode_json(read_file($_[0])); + JSON::XS->new->decode($text); } sub join_path { diff --git a/t/Catmandu-Util.t b/t/Catmandu-Util.t index 77905b7..6a31585 100644 --- a/t/Catmandu-Util.t +++ b/t/Catmandu-Util.t @@ -4,6 +4,10 @@ use strict; use warnings; use Test::More; use Test::Exception; +use IO::Handle; + +use utf8; +use feature 'state'; my $pkg; BEGIN { @@ -137,4 +141,264 @@ for my $sym (qw(xml_declaration xml_escape)) { can_ok 'T::ImportXML', $sym; } -done_testing 474; +{ + my $coderef = sub { + state $counter = 0; + return "Count: $counter\n" if $counter++ < 5; + }; + + my $io = Catmandu::Util::io($coderef, mode => 'r'); + + ok $io , 'io from code_ref read'; + is $io->getline() , "Count: 1\n" , 'getline'; +} + +{ + my $coderef = sub { + my $line = shift; + return 1; + }; + + my $io = Catmandu::Util::io($coderef, mode => 'w'); + + ok $io , 'io from code_ref write'; + ok $io->print("Test") , 'print'; +} + + +{ + my $io = Catmandu::Util::io(IO::File->new("< Changes")); + + ok $io , 'io IO::Handle instance'; +} + +{ + use Math::BigRat; + throws_ok { Catmandu::Util::io(Math::BigRat->new('3/7')) } 'Catmandu::BadArg' , 'got Catmandu::BadArg'; +} + +{ + my $test =<<EOF; +На берегу пустынных волн +Стоял он, дум великих полн, +И вдаль глядел. Пред ним широко +Река неслася; бедный чёлн +По ней стремился одиноко. +По мшистым, топким берегам +Чернели избы здесь и там, +Приют убогого чухонца; +И лес, неведомый лучам +В тумане спрятанного солнца, +Кругом шумел. +EOF + chop($test); + is Catmandu::Util::read_file("t/russian.txt") , $test , 'read_file'; +} + +{ + my $test =<<EOF; +На берегу пустынных волн +Стоял он, дум великих полн, +И вдаль глядел. Пред ним широко +Река неслася; бедный чёлн +По ней стремился одиноко. +По мшистым, топким берегам +Чернели избы здесь и там, +Приют убогого чухонца; +И лес, неведомый лучам +В тумане спрятанного солнца, +Кругом шумел. +EOF + chop($test); + my $io = IO::File->new("< t/russian.txt"); + is Catmandu::Util::read_io($io) , $test , 'read_io'; +} + +{ + my $test =<<EOF; +На берегу пустынных волн +Стоял он, дум великих полн, +И вдаль глядел. Пред ним широко +Река неслася; бедный чёлн +По ней стремился одиноко. +По мшистым, топким берегам +Чернели избы здесь и там, +Приют убогого чухонца; +И лес, неведомый лучам +В тумане спрятанного солнца, +Кругом шумел. +EOF + chop($test); + + my $filename = "$$.txt"; + ok Catmandu::Util::write_file($filename,$test) ,'write_file'; + is Catmandu::Util::read_file($filename) , $test , 'read_file'; + unlink $filename; +} + +{ + is_deeply Catmandu::Util::read_yaml("t/small.yaml") , { "hello" => "ვეპხის ტყაოსანი შოთა რუსთაველი"} , 'read_yaml'; +} + +{ + is_deeply Catmandu::Util::read_json("t/small.json") , { "hello" => "ვეპხის ტყაოსანი შოთა რუსთაველი"} , 'read_json'; +} + +is Catmandu::Util::join_path("/this/..","./is","..","./a/../weird/path","./../../isnt/../it") , "/it" , 'join_path'; +is Catmandu::Util::normalize_path("/this/../is/../a/../weird/path/../../isnt/../it") , "/it" , 'normalize_path'; +is Catmandu::Util::segmented_path("12345678",segment_size =>2,base_path=>"/x") , "/x/12/34/56/78" , 'segmented_path'; + +is_deeply [Catmandu::Util::parse_data_path("foo.bar.x")] , [ ['foo','bar'], "x" ] , "parse_data_path"; + +is Catmandu::Util::get_data({ foo => 'bar'} , 'foo') , 'bar' , 'get_data(foo)'; +is Catmandu::Util::get_data([qw(0 1 2)], 1) , '1' , 'get_data(1)'; +is Catmandu::Util::get_data([qw(0 1 2)], '$first') , '0' , 'get_data($first)'; +is Catmandu::Util::get_data([qw(0 1 2)], '$last') , '2' , 'get_data($last)'; +is_deeply [Catmandu::Util::get_data([qw(0 1 2)], '*')] , [qw(0 1 2)] , 'get_data(*)'; + +{ + my $data = { foo => 'bar'}; + Catmandu::Util::set_data($data,'foo','bar2'); + is_deeply $data , { foo => 'bar2' } , 'set_data 1'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::set_data($data, 0, 'bar'); + is_deeply $data , [qw(bar 1 2)] , 'set_data 2'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::set_data($data, '$first', 'bar'); + is_deeply $data , [qw(bar 1 2)] , 'set_data 3'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::set_data($data, '$last', 'bar'); + is_deeply $data , [qw(0 1 bar)] , 'set_data 4'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::set_data($data, '$prepend', 'bar'); + is_deeply $data , [qw(bar 0 1 2)] , 'set_data 5'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::set_data($data, '$append', 'bar'); + is_deeply $data , [qw(0 1 2 bar)] , 'set_data 6'; +} + +{ + my $data = { foo => 'bar'}; + Catmandu::Util::set_data($data,'foo','bar2'); + is_deeply $data , { foo => 'bar2' } , 'set_data 1'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::set_data($data, 0, 'bar'); + is_deeply $data , [qw(bar 1 2)] , 'set_data 2'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::set_data($data, '$first', 'bar'); + is_deeply $data , [qw(bar 1 2)] , 'set_data 3'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::set_data($data, '$last', 'bar'); + is_deeply $data , [qw(0 1 bar)] , 'set_data 4'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::set_data($data, '$prepend', 'bar'); + is_deeply $data , [qw(bar 0 1 2)] , 'set_data 5'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::set_data($data, '$append', 'bar'); + is_deeply $data , [qw(0 1 2 bar)] , 'set_data 6'; +} + +{ + my $data = { foo => 'bar'}; + Catmandu::Util::delete_data($data,'foo'); + is_deeply $data , { } , 'delete_data 1'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::delete_data($data, 0); + is_deeply $data , [qw(1 2)] , 'delete_data 2'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::delete_data($data, '$first'); + is_deeply $data , [qw(1 2)] , 'delete_data 3'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::delete_data($data, '$last'); + is_deeply $data , [qw(0 1)] , 'delete_data 4'; +} + +{ + my $data = [qw(0 1 2)]; + Catmandu::Util::delete_data($data, '*'); + is_deeply $data , [] , 'delete_data 5'; +} + +is Catmandu::Util::data_at('foo', { foo => 'bar'}) , 'bar' , 'data_at 1'; +is Catmandu::Util::data_at('foo.1', { foo => [qw(bar bar2 bar3)] }) , 'bar2' , 'data_at 2'; +is Catmandu::Util::data_at('foo.$first', { foo => [qw(bar bar2 bar3)] }) , 'bar' , 'data_at 3'; +is Catmandu::Util::data_at('foo.$last', { foo => [qw(bar bar2 bar3)] }) , 'bar3' , 'data_at 4'; + +ok Catmandu::Util::array_exists([qw(0 1 2)],0) , 'array_exists 1'; +ok ! Catmandu::Util::array_exists([qw(0 1 2)],3) , '!array_exists'; + +is_deeply Catmandu::Util::array_group_by([ + { color => 'red' , number => 1} , + { color => 'blue' , number => 2} , + { color => 'green' , number => 3} , + { number => 4} + ] , 'color') , { + red => [{ color => 'red' , number => 1}] , + blue => [{ color => 'blue' , number => 2}] , + green => [{ color => 'green' , number => 3}] , + } , 'array_group_by'; + +is_deeply Catmandu::Util::array_pluck([ { id => 1 } , { foo => 2 } , { id => 3}] , 'id') , [ 1, undef, 3] , 'array_pluck'; + +is Catmandu::Util::array_sum([1,2,3,4,5,6,7,8,9,10]) , 55 , 'array_sum'; + +ok Catmandu::Util::array_includes([{ foo => [ { bar => 1}]}] , {foo => [ { bar => 1}]} ) , 'array_includes'; + +ok Catmandu::Util::array_any([0,1,2], sub { return 1 if shift == 2}) , 'array_any'; + +is_deeply Catmandu::Util::array_rest([0,1,2]) , [1,2] , 'array_rest'; + +is_deeply Catmandu::Util::array_uniq([0,1,2,2,2,2,3,3,2,3]) , [0,1,2,3] , 'array_uniq'; + +is Catmandu::Util::capitalize("école") , "École" , 'capitalize'; + +is Catmandu::Util::human_number(64354) , "64,354" , 'human_number'; + +is Catmandu::Util::human_byte_size(10005000) , "10.01 MB" , 'human_byte_size'; + +is Catmandu::Util::human_content_type('application/x-dos_ms_excel') , 'Excel' , 'human_content_type'; + +is Catmandu::Util::xml_declaration() , qq(<?xml version="1.0" encoding="UTF-8"?>\n) , 'xml_declaration'; + +is Catmandu::Util::xml_escape("<>'&") , '<>'&' , 'xml_escape'; + +done_testing 531; \ No newline at end of file diff --git a/t/russian.txt b/t/russian.txt new file mode 100644 index 0000000..cb2bc19 --- /dev/null +++ b/t/russian.txt @@ -0,0 +1,11 @@ +На берегу пустынных волн +Стоял он, дум великих полн, +И вдаль глядел. Пред ним широко +Река неслася; бедный чёлн +По ней стремился одиноко. +По мшистым, топким берегам +Чернели избы здесь и там, +Приют убогого чухонца; +И лес, неведомый лучам +В тумане спрятанного солнца, +Кругом шумел. \ No newline at end of file diff --git a/t/small.json b/t/small.json new file mode 100644 index 0000000..e27d97d --- /dev/null +++ b/t/small.json @@ -0,0 +1 @@ +{"hello":"ვეპხის ტყაოსანი შოთა რუსთაველი"} diff --git a/t/small.yaml b/t/small.yaml new file mode 100644 index 0000000..958b95f --- /dev/null +++ b/t/small.yaml @@ -0,0 +1,3 @@ +--- +hello: ვეპხის ტყაოსანი შოთა რუსთაველი + -- 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