Attean
view release on metacpan or search on metacpan
lib/Attean/Plan.pm view on Meta::CPAN
unless (all { $_->does('Attean::API::BindingSubstitutionPlan') } @{ $self->children }) {
die "Plan children do not all consume BindingSubstitutionPlan role:\n" . $self->as_string;
}
my @children = map { $_->substitute_impl($model, $b) } @{ $self->children };
return $self->_impl($model, @children);
}
sub _impl {
my $self = shift;
my $model = shift;
my @children = @_;
my $iter_variables = $self->in_scope_variables;
return sub {
if (my $current = shift(@children)) {
my $iter = $current->();
return Attean::CodeIterator->new(
item_type => 'Attean::API::Result',
variables => $iter_variables,
generator => sub {
while (blessed($iter)) {
my $row = $iter->next();
if ($row) {
return $row;
} else {
$current = shift(@children);
if ($current) {
$iter = $current->();
} else {
undef $iter;
}
}
}
},
);
} else {
return Attean::ListIterator->new( item_type => 'Attean::API::Result', variables => [], values => [], );
}
};
}
}
=item * L<Attean::Plan::Extend>
Evaluates a sub-plan, and extends each result by evaluating a set of
expressions, binding the produced values to new variables.
=cut
package Attean::Plan::Extend 0.035 {
use Moo;
use Encode;
use UUID::Tiny ':std';
use URI::Escape;
use Data::Dumper;
use I18N::LangTags;
use POSIX qw(ceil floor);
use Digest::SHA;
use Digest::MD5 qw(md5_hex);
use Scalar::Util qw(blessed looks_like_number);
use List::Util qw(uniq all);
use Types::Standard qw(ConsumerOf ArrayRef InstanceOf HashRef);
use namespace::clean;
with 'MooX::Log::Any';
with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree';
has 'expressions' => (is => 'ro', isa => HashRef[ConsumerOf['Attean::API::Expression']], required => 1);
has 'active_graphs' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::IRI']], required => 1);
sub plan_as_string {
my $self = shift;
my @strings = map { sprintf('?%s ↠%s', $_, $self->expressions->{$_}->as_string) } keys %{ $self->expressions };
return sprintf('Extend { %s }', join(', ', @strings));
}
sub tree_attributes { return qw(variable expression) };
sub BUILDARGS {
my $class = shift;
my %args = @_;
my $exprs = $args{ expressions };
my @vars = map { @{ $_->in_scope_variables } } @{ $args{ children } };
my @evars = (@vars, keys %$exprs);
if (exists $args{in_scope_variables}) {
Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor";
}
$args{in_scope_variables} = [@evars];
return $class->SUPER::BUILDARGS(%args);
}
sub evaluate_expression {
my $self = shift;
my $model = shift;
my $expr = shift;
my $r = shift;
Carp::confess unless ($expr->can('operator'));
my $op = $expr->operator;
state $true = Attean::Literal->true;
state $false = Attean::Literal->false;
state $type_roles = { qw(URI IRI IRI IRI BLANK Blank LITERAL Literal NUMERIC NumericLiteral TRIPLE Triple) };
state $type_classes = { qw(URI Attean::IRI IRI Attean::IRI STR Attean::Literal) };
if ($expr->isa('Attean::CastExpression')) {
my $datatype = $expr->datatype->value;
my ($child) = @{ $expr->children };
my $term = $self->evaluate_expression($model, $child, $r);
if ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#string$>) {
my $value = $term->value;
if ($term->does('Attean::API::IRI')) {
return Attean::Literal->new(value => $term->value);
} elsif ($term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#boolean') {
my $v = ($value eq 'true' or $value eq '1') ? 'true' : 'false';
return Attean::Literal->new(value => $v);
} elsif ($term->does('Attean::API::NumericLiteral')) {
my $v = $term->numeric_value();
if ($v == int($v)) {
return Attean::Literal->new(value => int($v));
}
}
return Attean::Literal->new(value => $value);
}
die "TypeError $op" unless (blessed($term) and $term->does('Attean::API::Literal'));
if ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#(integer|float|double|decimal)>) {
my $value = $term->value;
my $num;
if ($datatype eq 'http://www.w3.org/2001/XMLSchema#integer') {
if ($term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#boolean') {
$value = ($value eq 'true' or $value eq '1') ? '1' : '0';
} elsif ($term->does('Attean::API::NumericLiteral')) {
my $v = $term->numeric_value();
$v =~ s/[.].*$//;
$value = int($v);
} elsif ($value =~ /^[-+]\d+$/) {
my ($v) = "$value";
$v =~ s/[.].*$//;
$value = int($v);
}
$num = $value;
} elsif ($datatype eq 'http://www.w3.org/2001/XMLSchema#decimal') {
if ($term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#boolean') {
$value = ($value eq 'true') ? '1' : '0';
} elsif ($term->does('Attean::API::NumericLiteral')) {
$value = $term->numeric_value;
} elsif (looks_like_number($value)) {
if ($value =~ /[eE]/) { # double
die "cannot cast to xsd:decimal as precision would be lost";
}
$value = +$value;
}
$num = "$value";
$num =~ s/[.]0+$/.0/;
$num =~ s/[.](\d+)0*$/.$1/;
} elsif ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#(float|double)$>) {
my $typename = $1;
if ($term->datatype->value eq 'http://www.w3.org/2001/XMLSchema#boolean') {
$value = ($value eq 'true') ? '1.0' : '0.0';
} elsif ($term->does('Attean::API::NumericLiteral')) {
# no-op
} elsif (looks_like_number($value)) {
$value = +$value;
} else {
die "cannot cast unrecognized value '$value' to xsd:$typename";
}
$num = sprintf("%e", $value);
}
my $c = Attean::Literal->new(value => $num, datatype => $expr->datatype);
if (my $term = $c->canonicalized_term_strict()) {
return $term;
} else {
die "Term value is not a valid lexical form for $datatype";
}
} elsif ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#boolean$>) {
if ($term->does('Attean::API::NumericLiteral')) {
my $value = $term->numeric_value;
return ($value == 0) ? Attean::Literal->false : Attean::Literal->true;
} else {
my $value = $term->value;
if ($value =~ m/^(true|false|0|1)$/) {
return ($value eq 'true' or $value eq '1') ? Attean::Literal->true : Attean::Literal->false;
} else {
die "Bad lexical form for xsd:boolean: '$value'";
}
}
} elsif ($datatype =~ m<^http://www.w3.org/2001/XMLSchema#dateTime$>) {
my $value = $term->value;
my $c = Attean::Literal->new(value => $value, datatype => $expr->datatype);
if ($c->does('Attean::API::DateTimeLiteral') and $c->datetime) {
return $c;
} else {
die "Bad lexical form for xsd:dateTime: '$value'";
}
}
$self->log->warn("Cast expression unimplemented for $datatype: " . Dumper($expr));
} elsif ($expr->isa('Attean::ValueExpression')) {
my $node = $expr->value;
if ($node->does('Attean::API::Variable')) {
my $value = $r->value($node->value);
unless (blessed($value)) {
die "Variable " . $node->as_string . " is unbound in expression " . $expr->as_string;
}
return $value;
} else {
return $node;
}
} elsif ($expr->isa('Attean::UnaryExpression')) {
my ($child) = @{ $expr->children };
my $term = $self->evaluate_expression($model, $child, $r);
if ($op eq '!') {
return ($term->ebv) ? $false : $true;
} elsif ($op eq '-' or $op eq '+') {
die "TypeError $op" unless (blessed($term) and $term->does('Attean::API::NumericLiteral'));
my $v = $term->numeric_value;
return Attean::Literal->new( value => eval "$op$v", datatype => $term->datatype );
}
die "Unimplemented UnaryExpression evaluation: " . $expr->operator;
} elsif ($expr->isa('Attean::BinaryExpression')) {
my $op = $expr->operator;
if ($op eq '&&') {
foreach my $child (@{ $expr->children }) {
lib/Attean/Plan.pm view on Meta::CPAN
use Scalar::Util qw(blessed);
use Types::Standard qw(Bool Str);
use namespace::clean;
with 'Attean::API::Plan', 'Attean::API::NullaryQueryTree';
with 'Attean::API::UnionScopeVariablesPlan';
has 'silent' => (is => 'ro', isa => Bool, default => 0);
has 'url' => (is => 'ro', isa => Str);
sub plan_as_string {
my $self = shift;
return sprintf("Load { %s }", $self->url);
}
sub impl {
my $self = shift;
my $url = $self->url;
my $ua = LWP::UserAgent->new();
my $silent = $self->silent;
my $accept = Attean->acceptable_parsers( handles => 'Attean::API::Triple' );
$ua->default_headers->push_header( 'Accept' => $accept );
return sub {
my $resp = $ua->get( $url );
if ($resp->is_success) {
my $ct = $resp->header('Content-Type');
if (my $pclass = Attean->get_parser( media_type => $ct )) {
my $p = $pclass->new();
my $str = $resp->decoded_content;
my $bytes = encode('UTF-8', $str, Encode::FB_CROAK);
my $iter = $p->parse_iter_from_bytes( $bytes );
return $iter;
}
}
if ($silent) {
return Attean::ListIterator->new(values => [], item_type => 'Attean::API::Triple');
} else {
die "Failed to load url: " . $resp->status_line;
}
};
}
}
=item * L<Attean::Plan::Unfold>
=cut
package Attean::Plan::Unfold 0.032 {
use Moo;
use Encode;
use UUID::Tiny ':std';
use URI::Escape;
use Data::Dumper;
use I18N::LangTags;
use POSIX qw(ceil floor);
use Digest::SHA;
use Digest::MD5 qw(md5_hex);
use Scalar::Util qw(blessed looks_like_number);
use List::Util qw(uniq all);
use Types::Standard qw(ConsumerOf ArrayRef InstanceOf HashRef);
use namespace::clean;
with 'MooX::Log::Any';
with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::UnaryQueryTree';
has 'variables' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::Variable']], required => 1);
has 'expression' => (is => 'ro', isa => ConsumerOf['Attean::API::Expression'], required => 1);
has 'active_graphs' => (is => 'ro', isa => ArrayRef[ConsumerOf['Attean::API::IRI']], required => 1);
sub plan_as_string {
my $self = shift;
my @vars = map { $_->as_string } @{ $self->variables };
my $vars = '(' . join(', ', @vars) . ')';
return sprintf('Unfold { %s ↠%s }', $vars, $self->expression->as_string);
}
sub tree_attributes { return qw(variable expression) };
sub BUILDARGS {
my $class = shift;
my %args = @_;
my $exprs = $args{ expressions };
my @vars = map { @{ $_->in_scope_variables } } @{ $args{ children } };
my @evars = (@vars, keys %$exprs);
if (exists $args{in_scope_variables}) {
Carp::confess "in_scope_variables is computed automatically, and must not be specified in the $class constructor";
}
$args{in_scope_variables} = [@evars];
return $class->SUPER::BUILDARGS(%args);
}
sub substitute_impl {
my $self = shift;
my $model = shift;
my $bind = shift;
my $expr = $self->expression;
my $vars = $self->variables;
my ($impl) = map { $_->substitute_impl($model, $bind) } @{ $self->children };
# TODO: substitute variables in the expression
return $self->_impl($model, $impl, $expr, @$vars);
}
sub impl {
my $self = shift;
my $model = shift;
my $expr = $self->expression;
my $vars = $self->variables;
my ($impl) = map { $_->impl($model) } @{ $self->children };
return $self->_impl($model, $impl, $expr, @$vars);
}
sub _impl {
my $self = shift;
my $model = shift;
my $impl = shift;
Carp::confess unless (defined($impl));
my $expr = shift;
my @vars = @_;
( run in 1.499 second using v1.01-cache-2.11-cpan-39bf76dae61 )