zaphar/data-path
1
0
Fork 0
mirror of https://github.com/zaphar/data-path.git synced 2025-07-21 20:29:48 -04:00
Code Issues Packages Projects Releases Wiki Activity

added method and object referencing to the path syntax

Browse Source 
darcs-hash:20070911002740-f4041-8655167061669026b115f44cfb91965946fce7aa.gz
This commit is contained in:
jeremy 2007-09-10 19:27:40 -05:00
parent bd812b7357
commit 3929453f7b
3 changed files with 54 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Makefile.PL
View File

@ -3,8 +3,12 @@ use inc::Module::Install;
name 'Data-Path';
perl_version '5.006';
all_from 'lib/Data/Path';
all_from 'lib/Data/Path.pm';
requires 'Carp' => '0';
requires 'Scalar::Util' => '0';
build_requires 'Test::More' => '0.7';
build_requires 'Test::MockObject' => '1.08';
WriteAl;
WriteAll;

50
lib/Data/Path.pm
View File

@ -3,8 +3,10 @@ package Data::Path;
use 5.006001;
use strict;
use warnings;
use Scalar::Util 'blessed';
use Carp;
our $VERSION = '1.0';
our $VERSION = '1.1';
sub new {
my ($class,$data,$callback)=@_;
@ -17,25 +19,30 @@ sub new {
{ key_does_not_exist => $callback->{key_does_not_exist} ||
sub {
my ($data, $key, $index, $value, $rest )=@_;
die "key $key does not exists\n";
croak "key $key does not exists\n";
}
, index_does_not_exist => $callback->{index_does_not_exist} ||
sub {
my ($data, $key, $index, $value, $rest )=@_;
die "key $key\[$index\] does not exists\n";
croak "key $key\[$index\] does not exists\n";
}
, retrieve_index_from_non_array => $callback->{retrieve_index_from_non_array} ||
sub {
my ($data, $key, $index, $value, $rest )=@_;
die "trie to retrieve an index $index from a no array value (in key $key)\n";
croak "trie to retrieve an index $index from a no array value (in key $key)\n";
}
, retrieve_key_from_non_hash => $callback->{retrieve_key_from_non_hash} ||
sub {
my ($data, $key, $index, $value, $rest )=@_;
die "trie to retrieve a key from a no hash value (in key $key)\n";
croak "trie to retrieve a key from a no hash value (in key $key)\n";
}
, not_a_coderef_or_method => $callback->{not_a_coderef_or_method} ||
sub {
my ($data, $key, $index, $value, $rest )=@_;
croak "tried to retrieve from a non-existant coderef or method: $key in $data";
}
}
@ -59,16 +66,25 @@ sub get {
my $rest = $rkey;
# get key from data
my $value = $data->{$key};
my $value;
if ($key =~ s/(\(\))$//) {
$self->{callback}->{not_a_coderef_or_method}->($data, $key, $index, $value, $rest)
unless exists $data->{$key} or (blessed $data && $data->can($key));
# die if key does not exists and something after that is requested
$value = $data->{$key}->() if (exists $data->{$key});
$value = $data->$key() if blessed $data && $data->can($key);
} else {
$value = $data->{$key};
}
# croak if key does not exists and something after that is requested
$self->{callback}->{key_does_not_exist}->($data, $key, $index, $value, $rest)
if not exists $data->{$key} and $rest;
# check index
if (defined $index) {
# die if index does not exists and something after that is requested
# croak if index does not exists and something after that is requested
$self->{callback}->{index_does_not_exist}->($data, $key, $index, $value, $rest)
if not exists $value->[$index] and $rest;
@ -110,12 +126,15 @@ Data::Path - Perl extension for XPath like accessing from complex data structs
, { text => 'msg1' }
, { text => 'msg2' }
]
}
},
method => sub {'method text'}
}
my $hpath=Data::Path->new($hashdata);
my $value= $hpath->get('/result/msg[1]/text');
my $value2 = $hpath->get('/method()');
print "OK" if $value2 eq 'method text';
print "OK" if $value eq 'msg1';
@ -140,25 +159,30 @@ The default callbacks but you can overwrite this.
{ key_does_not_exist =>
sub {
my ($data, $key, $index, $value, $rest )=@_;
die "key $key does not exists\n";
croak "key $key does not exists\n";
}
, index_does_not_exist =>
sub {
my ($data, $key, $index, $value, $rest )=@_;
die "key $key\[$index\] does not exists\n";
croak "key $key\[$index\] does not exists\n";
}
, retrieve_index_from_non_array =>
sub {
my ($data, $key, $index, $value, $rest )=@_;
die "trie to retrieve an index $index from a no array value (in key $key)\n";
croak "trie to retrieve an index $index from a no array value (in key $key)\n";
}
, retrieve_key_from_non_hash =>
sub {
my ($data, $key, $index, $value, $rest )=@_;
die "trie to retrieve a key from a no hash value (in key $key)\n";
croak "trie to retrieve a key from a no hash value (in key $key)\n";
}
, not_a_coderef_or_method => $callback->{not_a_coderef_or_method} ||
sub {
my ($data, $key, $index, $value, $rest )=@_;
croak "tried to retrieve from a non-existant coderef or method";
}
}

9
t/Data-Path.t
View File

@ -1,5 +1,6 @@
use Test::More tests => 17;
use Test::MockObject;
use Test::More tests => 15;
BEGIN {
use lib qw(lib);
use_ok('Data::Path')
@ -26,6 +27,7 @@ my $hash=
}
]
}
, method => sub {return 'sub val';}
};
@ -86,4 +88,9 @@ eval {
$b->get('/complex/level2[99]/level3_0');
};
ok ( $@ =~/callback_error_index/ ," check error_msg = $@");
my $obj = Test::MockObject->new({});
$obj->mock('method2' => sub {'method2 val'});
my $b2 = Data::Path->new($obj);
is($b->get('/method()'), $hash->{method}->(), "subroutine returned");
is($b2->get('/method2()', $obj), $obj->method2(), "method returned");