# RDF::Trine::Model::StatementFilter # ----------------------------------------------------------------------------- =head1 NAME RDF::Trine::Model::StatementFilter - Model for filtering statements based on a user-specified criteria =head1 VERSION This document describes RDF::Trine::Model::StatementFilter version 1.019 =head1 METHODS Beyond the methods documented below, this class inherits methods from the L class. =over 4 =cut package RDF::Trine::Model::StatementFilter; use strict; use warnings; no warnings 'redefine'; use Data::Dumper; use base qw(RDF::Trine::Model); use Scalar::Util qw(blessed reftype); use RDF::Trine::Node; use RDF::Trine::Pattern; use RDF::Trine::Iterator qw(sgrep); our ($VERSION); BEGIN { $VERSION = '1.019'; } ################################################################################ =item C<< new ( $store ) >> Returns a new statement-filter model. =cut sub new { my $class = shift; my $self = $class->SUPER::new( @_ ); $self->{rules} = []; return $self; } =item C<< count_statements ($subject, $predicate, $object) >> Returns a count of all the statements matching the specified subject, predicate and objects. Any of the arguments may be undef to match any value. =cut sub count_statements { my $self = shift; my $s = shift; my $p = shift; my $o = shift; my $c = shift; my $count = 0; my $i = $self->get_statements( $s, $p, $o, $c ); while (my $s = $i->next) { $count++; } return $count; } =item C<< get_statements ($subject, $predicate, $object [, $context] ) >> Returns a stream object of all statements matching the specified subject, predicate and objects from all of the rdf stores. Any of the arguments may be undef to match any value. =cut sub get_statements { my $self = shift; my $s = shift; my $p = shift; my $o = shift; my $c = shift; my $stream = sgrep { $self->apply_rules($_) } $self->SUPER::get_statements( $s, $p, $o, $c ); return $stream; } =item C<< get_pattern ( $bgp [, $context] ) >> Returns a stream object of all bindings matching the specified graph pattern. =cut sub get_pattern { my $self = shift; my $bgp = shift; my $context = shift; my %args = @_; if (my $o = $args{ orderby }) { my @ordering = @$o; while (my ($col, $dir) = splice( @ordering, 0, 2, () )) { no warnings 'uninitialized'; unless ($dir =~ /^(ASC|DESC)$/) { throw RDF::Trine::Error -text => 'Direction must be ASC or DESC in get_pattern call'; } } } my @rules = $self->rules; if (@rules) { my (@triples) = ($bgp->isa('RDF::Trine::Statement')) ? $bgp : $bgp->triples; unless (@triples) { throw RDF::Trine::Error::CompilationError -text => 'Cannot call get_pattern() with empty pattern'; } my @streams; foreach my $triple (@triples) { my @vars = map { $_->name } grep { $_->isa('RDF::Trine::Node::Variable') } $triple->nodes; Carp::confess "not a statement object: " . Dumper($triple) unless ($triple->isa('RDF::Trine::Statement')); my $stream = $self->get_statements( $triple->nodes, $context ); my $binds = $stream->as_bindings( $triple->nodes )->project( @vars ); push(@streams, $binds); } if (@streams) { while (@streams > 1) { my $a = shift(@streams); my $b = shift(@streams); unshift(@streams, RDF::Trine::Iterator::Bindings->join_streams( $a, $b )); } } else { push(@streams, RDF::Trine::Iterator::Bindings->new([{}], [])); } my $stream = shift(@streams); return $stream; } else { return $self->SUPER::get_pattern( $bgp, $context, %args ); } } =item C<< apply_rules ( $statement ) >> =cut sub apply_rules { my $self = shift; my $st = shift; my @rules = $self->rules; foreach my $rule (@rules) { return 0 unless ($rule->( $st )); } return 1; } =item C<< rules >> Returns a list of all rules in the inferencing model. =cut sub rules { my $self = shift; return @{ $self->{rules} }; } =item C<< add_rule ( \&rule ) >> Adds a rule to the inferencing model. The rule should be a CODE reference that, when passed a statement object, will return true if the statement should be allowed in the model, false if it should be filtered out. =cut sub add_rule { my $self = shift; my $rule = shift; throw RDF::Trine::Error -text => "Filter must be a CODE reference" unless (reftype($rule) eq 'CODE'); push( @{ $self->{rules} }, $rule ); } 1; __END__ =back =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2006-2012 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut