Source

p5-rdf-closure-engine-notation3logic / lib / RDF / Closure / Engine / Notation3Logic / Pattern.pm

Toby Inkster b17ba61 






















Toby Inkster 11e259f 
Toby Inkster b17ba61 


Toby Inkster 11e259f 

Toby Inkster b17ba61 






















Toby Inkster 11e259f 
Toby Inkster b17ba61 



Toby Inkster 11e259f 








Toby Inkster b17ba61 




















































































































Toby Inkster 11e259f 
Toby Inkster b17ba61 


Toby Inkster 11e259f 


















Toby Inkster b17ba61 
Toby Inkster 11e259f 
Toby Inkster b17ba61 
Toby Inkster 11e259f 















































Toby Inkster b17ba61 
Toby Inkster 11e259f 















Toby Inkster b17ba61 
package RDF::Closure::Engine::Notation3Logic::Pattern;

use common::sense;

use base qw[RDF::Trine::Pattern];

use Scalar::Util qw[blessed];

sub new
{
	my $class       = shift;
	my @triples     = @_;
	foreach my $t (@triples)
	{
		unless (blessed($t) and $t->isa('RDF::Trine::Statement'))
		{
			throw RDF::Trine::Error -text => "Patterns belonging to a BGP must be triples";
		}
	}
	return bless([@triples], $class);
}


sub match
{
	my ($self, $model, $context, %args) = @_;
	
	my @names = $self->referenced_variables;
	
	# Prepare set of functions...
	my %functions = %RDF::Closure::Engine::Notation3Logic::functions;
	if ($args{'functions'})
	{
		my %extras = %{ $args{'functions'} };
		while (my ($uri, $code) = each %extras)
		{
			next unless ref($code) eq 'CODE';
			$functions{$uri} = $code;
		}
	}
	
	my $dummy  = RDF::Closure::Engine::Notation3Logic::DummyQuery->new(model => $model);
	my $smart  = [ $self->triples ];
	my $basic  = [];
	my $nonvar = [];
	my $const  = [];
	my $bound  = {};
	my $conflict  = 0;
	my $loopcount = 0;
	my $grace = 0;
	
	use Data::Dumper;
	$Data::Dumper::Sortkeys = 1;
	my $process = sub
	{
		$loopcount++;
		
#		print Dumper({
#			_count  => $loopcount,
#			smart   => $smart,
#			basic   => $basic,
#			nonvar  => $nonvar,
#			const   => $const,
#			bound   => $bound,
#			});
		
		my $done_something = 0;
		
		# Do what we can to move things from $smart to $const/$basic.
		my @tmp = ();
		ST: foreach my $st (@$smart)
		{
			$st = $st->bind_variables($bound);
			my ($s, $p, $o) = $st->nodes;
			
			if ($p->is_resource and ref($functions{$p->uri}) eq 'CODE'
			and !$st->referenced_variables)
			{
				my $f = $functions{$p->uri};
				my $r = $f->($dummy, $s, $o);
				if ($r)
				{
					push @$const, $st;
				}
				else
				{
					$conflict++;
					last LOOP;
				}				
			}
			elsif (!$st->referenced_variables)
			{
				if ($loopcount)
				{
					push @$const, $st;
				}
				else
				{
					push @$nonvar, $st;
				}
				$done_something++;
			}
			elsif ($p->is_resource and ref($functions{$p->uri}) eq 'CODE'
			and !$s->is_variable and $o->is_variable)
			{
				my $f = $functions{$p->uri};
				my $calc_o = $f->($dummy, $s);
				if (defined $calc_o)
				{
					$bound->{ $o->name } = $calc_o;
					push @tmp, RDF::Trine::Statement->new($s, $p, $calc_o);
					$done_something++;
				}
			}
			elsif ($p->is_resource and ref($functions{'inverse+'.$p->uri}) eq 'CODE'
			and $s->is_variable and !$o->is_variable)
			{
				my $f = $functions{'inverse+'.$p->uri};
				my $calc_s = $f->($dummy, $o);
				if (defined $calc_s)
				{
					$bound->{ $s->name } = $calc_s;
					push @tmp, RDF::Trine::Statement->new($calc_s, $p, $o);
					$done_something++;
				}
			}
			elsif ($p->is_resource and ref($functions{$p->uri}) ne 'CODE')
			{
				push @$basic, $st;
				$done_something++;
			}
			else
			{
				push @tmp, $st;
			}
		}
		# This is what's left of $smart.
		$smart = [@tmp];
		
		# Do what we can to move things from $basic to $const.
		@tmp = ();
		ST: foreach my $st (@$basic)
		{
			$st = $st->bind_variables($bound);
			my ($s, $p, $o) = $st->nodes;
			
			if ($p->is_resource and ref($functions{$p->uri}) eq 'CODE')
			{
				push @$smart, $st; # reluctantly push back to $smart
				$done_something++;
			}
			elsif (!$st->referenced_variables)
			{
				push @$const, $st;
				$done_something++;
			}
			else
			{
				push @tmp, $st;
			}
		}
		# This is what's left of $basic.
		$basic = [@tmp];
		
		return $done_something;
	};
	
	# This is quite a crazy-looking loop structure. Just to explain what's
	# going on here... we loop $process until we detect that no triples were
	# moved between the different pots. After that, we allow it one more
	# run of $process, and if that last "grace" run moves some triples, begin
	# looping in earnest again.
	my ($continue, $grace) = (1, 1);
	while ($grace)
	{
		$continue = 1;
		while ($continue)
		{
			$continue = $process->();
		}
		$grace = $process->();
	}
		
	my $basic_iterator;
	if (@$basic)
	{
		my $basic_pattern  = RDF::Trine::Pattern->new(@$basic, @$nonvar);
		$basic_iterator = $model->get_pattern($basic_pattern);
	}
	else
	{
		$basic_iterator = RDF::Trine::Iterator::Bindings->new([{}]);
	}
	
	return RDF::Trine::Iterator::Bindings->new(sub {
		my $this_iter    = shift;
		NEXT: my $basic_result = $basic_iterator->next;
		return unless defined $basic_result;

		my $skip   = 0;
		my %bonus_bindings;
		
		my $binder = sub
		{
			my @checks = @$smart;
			my $done_something = 1;
			
			while (@checks and $done_something)
			{
				$done_something = 0;
				CHK: foreach my $check (@checks)
				{
					my $bound = $check->bind_variables($basic_result);
					
					if (!$bound->subject->is_variable and $bound->object->is_variable
					and ref($functions{$bound->predicate->uri}) eq 'CODE')
					{
						my $f = $functions{$bound->predicate->uri};
						my $r = $f->($dummy, $bound->subject);
						if ($r)
						{
							$bonus_bindings{ $check->object->name } = $r;
							@checks = grep { $_ ne $check } @checks;
							$done_something = 1;
						}
					}
					elsif ($bound->subject->is_variable and !$bound->object->is_variable
					and ref($functions{'inverse+'.$bound->predicate->uri}) eq 'CODE')
					{
						my $f = $functions{'inverse+'.$bound->predicate->uri};
						my $r = $f->($dummy, $bound->object);
						if ($r)
						{
							$bonus_bindings{ $check->subject->name } = $r;
							@checks = grep { $_ ne $check } @checks;
							$done_something = 1;
						}
					}
					elsif (!$bound->subject->is_variable and !$bound->object->is_variable
					and ref($functions{$bound->predicate->uri}) eq 'CODE')
					{
						my $f = $functions{$bound->predicate->uri};
						my $r = $f->($dummy, $bound->subject, $bound->object);
						
						if ($r)
						{
							# check passed, remove from list of checks!
							@checks = grep { $_ ne $check } @checks;
							$done_something = 1;
						}
						else
						{
							$skip = 1;
							return;
						}
					}
				}
			}
		};
		
		$binder->();
		goto NEXT if $skip;
		
		my %extended_result = %$basic_result;
		while (my ($k, $v) = each %$bound)
		{
			$extended_result{$k} = $v;
		}
		while (my ($k, $v) = each %bonus_bindings)
		{
			$extended_result{$k} = $v;
		}
		return \%extended_result;
	}, \@names);
}
1;