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