From 45c7c4c20ed60825bad7001dc46287b8f93fd778 Mon Sep 17 00:00:00 2001 From: Wolfgang Pecho Date: Wed, 18 May 2016 16:33:26 +0200 Subject: [PATCH] Turned Data::AsObject::Array into a function object. This allows to use the objects as subroutine objects to ease access to nested arrays. - Tests and pod added. - No break of existing interfaces. Changes to be committed: modified: lib/Data/AsObject.pm modified: lib/Data/AsObject/Array.pm new file: t/05-function-objects.t --- lib/Data/AsObject.pm | 32 ++++++++++++++++-- lib/Data/AsObject/Array.pm | 18 +++++++++++ t/05-function-objects.t | 66 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 113 insertions(+), 3 deletions(-) create mode 100644 t/05-function-objects.t diff --git a/lib/Data/AsObject.pm b/lib/Data/AsObject.pm index 309ec55..829cf6e 100644 --- a/lib/Data/AsObject.pm +++ b/lib/Data/AsObject.pm @@ -197,8 +197,6 @@ If a hash key contains one or more colons or dashes, you can access its value by =head2 Working with arrays -To access array items pass the item index as an argument to the hash that contains the array: - my $data = dao { uk => ["one", "two", "three", "four"], spain => [ @@ -207,10 +205,24 @@ To access array items pass the item index as an argument to the hash that contai ]; }; +For accessing array items you can pass the item index as an argument to the hash that contains the array: + print $data->en(1) # two print $data->spain(0)->numbers(3); # cuatro -Array of array structures are a little bit clumsier to work with. You will need to use the C method of C and pass it the index of the item you want to access: +You can use the C method of C and pass it the index of the item you want to access: + + print $data->en->get(1) # two + print $data->spain->get(0)->numbers->(3); # cuatro + + +Or you can use a functional style: + + print $data->en->(1) # two + print $data->spain->(0)->numbers->(3); # cuatro + + +Array of array structures are easy to work with. You can use all styles to access array elements. my $data = dao [ ["one", "two", "three", "four"] @@ -219,6 +231,20 @@ Array of array structures are a little bit clumsier to work with. You will need ]; print $data->get(2)->get(0); # un + print $data(2)->get(0); # un + print $data->get(2)->(0); # un + print $data->(2)->get(0); # un + print $data->(2)->(0); # un + print $data->(2)(0); # un + + NOTE: the calls $data->get(2), $data(2), $data->(2) in the example above + return an object representing the array. + + Because of the way perl parses expressions + $data->get(2)(0) + and + $data(2)(0) + are syntax errors. Arrayrefs have a dereferencing C method. For example: diff --git a/lib/Data/AsObject/Array.pm b/lib/Data/AsObject/Array.pm index a50459a..9b22a0c 100644 --- a/lib/Data/AsObject/Array.pm +++ b/lib/Data/AsObject/Array.pm @@ -10,6 +10,24 @@ use Data::AsObject qw(); use namespace::clean -except => [qw/get/]; +# Define what happens if objects of this class are used as subroutine references, +# i.e. if called like this: $obj->(@args). We define: +# +# $obj->(@args) <=> $obj->get(@args) +# +use overload '&{}' => sub { + my $self = shift; + return sub { + return $self->get(@_); + }; + }, + # activate default behaviour for all other contexts + # if you do not, things like if (! $obj) will throw + # strange errors: Operation "bool": no method found, ... + 'fallback' => 1, +; + + sub get { my $self = shift; my $index = shift; diff --git a/t/05-function-objects.t b/t/05-function-objects.t new file mode 100644 index 0000000..86777be --- /dev/null +++ b/t/05-function-objects.t @@ -0,0 +1,66 @@ +#!perl -T + +use strict; +use warnings; + +use lib q(lib); + +use Test::More ; +use Test::Exception; +use Test::Warn; + +use Data::AsObject qw(dao); + +plan (); + +my $data = { + blah => [1,2,3], + bing => [ + { town => 'sliven', + matrix => [ + [ 11, 12 ], + [ 21, 22 ], + ] + }, + ], + 'xml:thingy' => 2, + 'meaning-of-life' => 42, +}; + +#-- construct from hashref +my $dao = dao $data; +isa_ok($dao, "Data::AsObject::Hash"); + + +my $idx = 2; +my $expected = 3; + +#-- check the old interface for array access +ok( $dao->blah($idx) == $expected, "array access via blah($idx) works" ); +ok( $dao->blah->get($idx) == $expected, "array access via blah->get($idx) works" ); + + +#-- check the new interface for array access +ok( $dao->blah->($idx) == $expected, "array access via blah->($idx) works" ); + +$expected = 12; +ok( $dao->bing->(0)->matrix->(0)->(1) == $expected, "array access bing->(0)->matrix->(0)->(1) works" ); +ok( $dao->bing(0)->matrix->(0)->(1) == $expected, "array access bing(0)->matrix->(0)->(1) works" ); +ok( $dao->bing->get(0)->matrix->(0)->(1) == $expected, "array access bing->get(0)->matrix->(0)->(1) works" ); + +# combining old and new interface +ok( $dao->bing->(0)->matrix->(0)(1) == $expected, "array access bing->(0)->matrix->(0)(1) works" ); +ok( $dao->bing->(0)->matrix(0)->(1) == $expected, "array access bing->(0)->matrix(0)->(1) works" ); +ok( $dao->bing->(0)->matrix->(0)->get(1) == $expected, "array access bing->(0)->matrix->(0)->get(1) works" ); + +# Syntax error: +# ok( $dao->bing->(0)->matrix->get(0)(1) == $expected, "array access bing->(0)->matrix->get(0)(1) works" ); +# ok( $dao->bing->(0)->matrix(0)(1) == $expected, "array access bing->(0)->matrix->(0)(1) works" ); + +#-- check if default contexts for array objects still work +my $obj = $dao->blah; + +ok( "$obj" =~ /^Data::AsObject::Array::Strict=ARRAY/, "string context of array object works" ); +ok( !! $obj, "boolean context of array object works" ); + +done_testing();