our
$VERSION
=
'0.26'
;
sub
new {
my
(
$class
,
%options
) =
@_
;
my
$expression
=
$options
{query} // croak
"query required"
;
my
$ns
=
$options
{ns} // RDF::NS->new;
my
$decoder
=
$options
{decoder} // RDF::aREF::Decoder->new(
ns
=>
$ns
);
my
$self
=
bless
{
items
=> [],
decoder
=>
$decoder
},
$class
;
my
@items
=
split
/\s*\|\s*/,
$expression
;
foreach
my
$expr
(
@items
?
@items
:
''
) {
my
$type
=
'any'
;
my
(
$language
,
$datatype
);
if
(
$expr
=~ /^(.*)\.$/) {
$type
=
'resource'
;
$expr
= $1;
}
elsif
(
$expr
=~ /^([^@]*)@([^@]*)$/ ) {
(
$expr
,
$language
) = ($1, $2);
if
(
$language
eq
''
or
$language
=~ languageTag ) {
$type
=
'literal'
;
}
else
{
croak
'invalid languageTag in aREF query'
;
}
}
elsif
(
$expr
=~ /^([^^]*)\^([^^]*)$/ ) {
(
$expr
,
$datatype
) = ($1, $2);
if
(
$datatype
=~ qName ) {
$type
=
'literal'
;
$datatype
=
$decoder
->prefixed_name(
split
'_'
,
$datatype
);
$datatype
=
undef
if
$datatype
eq
$decoder
->prefixed_name(
'xsd'
,
'string'
);
}
else
{
croak
'invalid datatype qName in aREF query'
;
}
}
my
@path
=
split
/\./,
$expr
;
foreach
(
@path
) {
croak
"invalid aref path expression: $_"
if
$_
!~ qName and
$_
ne
'a'
;
}
push
@{
$self
->{items}}, {
path
=> \
@path
,
type
=>
$type
,
language
=>
$language
,
datatype
=>
$datatype
,
};
}
$self
;
}
sub
query {
my
(
$self
) =
@_
;
join
'|'
,
map
{
my
$q
=
join
'.'
, @{
$_
->{path}};
if
(
$_
->{type} eq
'literal'
) {
if
(
$_
->{datatype}) {
$q
.=
'^'
.
$_
->{datatype};
}
else
{
$q
.=
'@'
. (
$_
->{language} //
''
);
}
}
elsif
(
$_
->{type} eq
'resource'
) {
$q
.=
'.'
;
}
$q
;
} @{
$self
->{items}}
}
sub
apply {
my
(
$self
,
$rdf
,
$subject
) =
@_
;
map
{
$self
->_apply_item(
$_
,
$rdf
,
$subject
) } @{
$self
->{items}};
}
sub
_apply_item {
my
(
$self
,
$item
,
$rdf
,
$subject
) =
@_
;
my
$decoder
=
$self
->{decoder};
my
@current
=
$rdf
;
if
(
$subject
) {
if
(
$rdf
->{_id}) {
return
if
$rdf
->{_id} ne
$subject
;
}
else
{
@current
= (
$rdf
->{
$subject
});
}
}
my
@path
= @{
$item
->{path}};
if
(!
@path
and
$item
->{type} ne
'resource'
) {
if
(
$item
->{type} eq
'any'
) {
return
(
$subject
?
$subject
:
$rdf
->{_id});
}
}
while
(
my
$field
=
shift
@path
) {
@current
=
grep
{
defined
}
map
{ (
ref
$_
and
ref
$_
eq
'ARRAY'
) ?
@$_
:
$_
}
map
{
$_
->{
$field
} }
@current
;
return
if
!
@current
;
if
(
@path
or
$item
->{type} eq
'resource'
) {
@current
=
grep
{
defined
}
map
{
$decoder
->resource(
$_
) }
@current
;
if
(
@path
) {
@current
=
grep
{
defined
}
map
{
$rdf
->{
$_
} }
@current
;
}
}
}
@current
=
grep
{
defined
}
map
{
$decoder
->object(
$_
) }
@current
;
if
(
$item
->{type} eq
'literal'
) {
@current
=
grep
{
@$_
> 1 }
@current
;
if
(
$item
->{language}) {
@current
=
grep
{
$_
->[1] and
$_
->[1] eq
$item
->{language} }
@current
;
}
elsif
(
$item
->{datatype}) {
@current
=
grep
{
$_
->[2] and
$_
->[2] eq
$item
->{datatype} }
@current
;
}
}
map
{
$_
->[0] }
@current
;
}
1;