1# RDF::Trine::Model::StatementFilter 2# ----------------------------------------------------------------------------- 3 4=head1 NAME 5 6RDF::Trine::Model::StatementFilter - Model for filtering statements based on a user-specified criteria 7 8=head1 VERSION 9 10This document describes RDF::Trine::Model::StatementFilter version 1.019 11 12=head1 METHODS 13 14Beyond the methods documented below, this class inherits methods from the 15L<RDF::Trine::Model> class. 16 17=over 4 18 19=cut 20 21package RDF::Trine::Model::StatementFilter; 22 23use strict; 24use warnings; 25no warnings 'redefine'; 26use Data::Dumper; 27use base qw(RDF::Trine::Model); 28use Scalar::Util qw(blessed reftype); 29 30use RDF::Trine::Node; 31use RDF::Trine::Pattern; 32use RDF::Trine::Iterator qw(sgrep); 33 34our ($VERSION); 35BEGIN { 36 $VERSION = '1.019'; 37} 38 39################################################################################ 40 41=item C<< new ( $store ) >> 42 43Returns a new statement-filter model. 44 45=cut 46 47sub new { 48 my $class = shift; 49 my $self = $class->SUPER::new( @_ ); 50 $self->{rules} = []; 51 return $self; 52} 53 54=item C<< count_statements ($subject, $predicate, $object) >> 55 56Returns a count of all the statements matching the specified subject, 57predicate and objects. Any of the arguments may be undef to match any value. 58 59=cut 60 61sub count_statements { 62 my $self = shift; 63 my $s = shift; 64 my $p = shift; 65 my $o = shift; 66 my $c = shift; 67 68 my $count = 0; 69 my $i = $self->get_statements( $s, $p, $o, $c ); 70 while (my $s = $i->next) { 71 $count++; 72 } 73 return $count; 74} 75 76=item C<< get_statements ($subject, $predicate, $object [, $context] ) >> 77 78Returns a stream object of all statements matching the specified subject, 79predicate and objects from all of the rdf stores. Any of the arguments may be 80undef to match any value. 81 82=cut 83 84sub get_statements { 85 my $self = shift; 86 my $s = shift; 87 my $p = shift; 88 my $o = shift; 89 my $c = shift; 90 91 my $stream = sgrep { $self->apply_rules($_) } $self->SUPER::get_statements( $s, $p, $o, $c ); 92 return $stream; 93} 94 95=item C<< get_pattern ( $bgp [, $context] ) >> 96 97Returns a stream object of all bindings matching the specified graph pattern. 98 99=cut 100 101sub get_pattern { 102 my $self = shift; 103 my $bgp = shift; 104 my $context = shift; 105 my %args = @_; 106 107 if (my $o = $args{ orderby }) { 108 my @ordering = @$o; 109 while (my ($col, $dir) = splice( @ordering, 0, 2, () )) { 110 no warnings 'uninitialized'; 111 unless ($dir =~ /^(ASC|DESC)$/) { 112 throw RDF::Trine::Error -text => 'Direction must be ASC or DESC in get_pattern call'; 113 } 114 } 115 } 116 117 my @rules = $self->rules; 118 if (@rules) { 119 my (@triples) = ($bgp->isa('RDF::Trine::Statement')) ? $bgp : $bgp->triples; 120 unless (@triples) { 121 throw RDF::Trine::Error::CompilationError -text => 'Cannot call get_pattern() with empty pattern'; 122 } 123 124 my @streams; 125 foreach my $triple (@triples) { 126 my @vars = map { $_->name } grep { $_->isa('RDF::Trine::Node::Variable') } $triple->nodes; 127 Carp::confess "not a statement object: " . Dumper($triple) unless ($triple->isa('RDF::Trine::Statement')); 128 my $stream = $self->get_statements( $triple->nodes, $context ); 129 my $binds = $stream->as_bindings( $triple->nodes )->project( @vars ); 130 push(@streams, $binds); 131 } 132 if (@streams) { 133 while (@streams > 1) { 134 my $a = shift(@streams); 135 my $b = shift(@streams); 136 unshift(@streams, RDF::Trine::Iterator::Bindings->join_streams( $a, $b )); 137 } 138 } else { 139 push(@streams, RDF::Trine::Iterator::Bindings->new([{}], [])); 140 } 141 my $stream = shift(@streams); 142 return $stream; 143 } else { 144 return $self->SUPER::get_pattern( $bgp, $context, %args ); 145 } 146} 147 148=item C<< apply_rules ( $statement ) >> 149 150=cut 151 152sub apply_rules { 153 my $self = shift; 154 my $st = shift; 155 my @rules = $self->rules; 156 foreach my $rule (@rules) { 157 return 0 unless ($rule->( $st )); 158 } 159 return 1; 160} 161 162=item C<< rules >> 163 164Returns a list of all rules in the inferencing model. 165 166=cut 167 168sub rules { 169 my $self = shift; 170 return @{ $self->{rules} }; 171} 172 173=item C<< add_rule ( \&rule ) >> 174 175Adds a rule to the inferencing model. The rule should be a CODE reference that, 176when passed a statement object, will return true if the statement should be 177allowed in the model, false if it should be filtered out. 178 179=cut 180 181sub add_rule { 182 my $self = shift; 183 my $rule = shift; 184 throw RDF::Trine::Error -text => "Filter must be a CODE reference" unless (reftype($rule) eq 'CODE'); 185 push( @{ $self->{rules} }, $rule ); 186} 187 1881; 189 190__END__ 191 192=back 193 194=head1 BUGS 195 196Please report any bugs or feature requests to through the GitHub web interface 197at L<https://github.com/kasei/perlrdf/issues>. 198 199=head1 AUTHOR 200 201Gregory Todd Williams C<< <gwilliams@cpan.org> >> 202 203=head1 COPYRIGHT 204 205Copyright (c) 2006-2012 Gregory Todd Williams. This 206program is free software; you can redistribute it and/or modify it under 207the same terms as Perl itself. 208 209=cut 210