1# RDF::Trine::Parser::RDFPatch
2# -----------------------------------------------------------------------------
3
4=head1 NAME
5
6RDF::Trine::Parser::RDFPatch - RDF-Patch Parser
7
8=head1 VERSION
9
10This document describes RDF::Trine::Parser::RDFPatch version 1.019
11
12=head1 SYNOPSIS
13
14 use RDF::Trine::Parser::RDFPatch;
15 my $serializer	= RDF::Trine::Parser::RDFPatch->new();
16
17=head1 DESCRIPTION
18
19The RDF::Trine::Parser::RDFPatch class provides an API for serializing RDF
20graphs to the RDF-Patch syntax.
21
22=head1 METHODS
23
24=over 4
25
26=cut
27
28package RDF::Trine::Parser::RDFPatch;
29
30use strict;
31use warnings;
32
33use URI;
34use Carp;
35use Data::Dumper;
36use Scalar::Util qw(blessed);
37use List::Util qw(min);
38
39use RDF::Trine::Node;
40use RDF::Trine::Statement;
41use RDF::Trine::Error qw(:try);
42use RDF::Trine::Parser::Turtle;
43use RDF::Trine::Parser::Turtle::Constants;
44
45######################################################################
46
47our ($VERSION);
48BEGIN {
49	$VERSION	= '1.019';
50}
51
52######################################################################
53
54=item C<< new (  ) >>
55
56Returns a new RDF-Patch Parser object.
57
58=cut
59
60sub new {
61	my $class	= shift;
62	my $self = bless( {
63		last		=> [],
64		namespaces	=> RDF::Trine::NamespaceMap->new(),
65	}, $class );
66	return $self;
67}
68
69=item C<< namespace_map >>
70
71Returns the RDF::Trine::NamespaceMap object used in parsing.
72
73=cut
74
75sub namespace_map {
76	my $self	= shift;
77	return $self->{namespaces};
78}
79
80=item C<< parse ( $base_uri, $rdf, \&handler ) >>
81
82=cut
83
84sub parse {
85	my $self	= shift;
86	my $base	= shift;
87	my $string	= shift;
88	my $handler	= shift;
89	open( my $fh, '<:encoding(UTF-8)', \$string );
90	return $self->parse_file( $base, $fh, $handler );
91}
92
93=item C<< parse_file ( $base, $fh, \&handler ) >>
94
95=cut
96
97sub parse_file {
98	my $self	= shift;
99	my $base	= shift;
100	my $fh		= shift;
101	my $handler	= shift;
102
103	unless (ref($fh)) {
104		my $filename	= $fh;
105		undef $fh;
106		open( $fh, '<:encoding(UTF-8)', $filename ) or throw RDF::Trine::Error::ParserError -text => $!;
107	}
108
109	my $lineno	= 0;
110	while (defined(my $line = <$fh>)) {
111		$lineno++;
112		my $op	= $self->parse_line( $line, $base );
113		last unless blessed($op);
114		$self->handle_op( $op, $handler, $lineno );
115	}
116}
117
118=item C<< handle_op ( $op, $handler, $lineno ) >>
119
120Handles the RDF::Trine::Parser::RDFPatch::Op operation object.
121For 'A'dd operations, the C<< $handler >> callback is called with the RDF statement.
122Otherwise an exception is thrown.
123
124=cut
125
126sub handle_op {
127	my $self	= shift;
128	my $op		= shift;
129	my $handler	= shift;
130	my $lineno	= shift;
131	my $opid	= $op->op;
132	if ($opid eq 'A') {
133		my ($st)	= $op->args;
134		$handler->( $st );
135	} else {
136		my $col	= 0;
137		throw RDF::Trine::Error::ParserError::Positioned (
138			-text => "Cannot handle RDF Patch operation type '$opid' during RDF parsing at $lineno:$col",
139			-value => [$lineno, $col],
140		);
141	}
142}
143
144=item C<< parse_line ( $line, $base ) >>
145
146Returns an operation object.
147
148=cut
149
150sub _get_token_type {
151	my $self	= shift;
152	my $l		= shift;
153	my $type	= shift;
154	my $t		= $l->get_token;
155	unless ($t) {
156		$l->_throw_error(sprintf("Expecting %s but got EOF", decrypt_constant($type)));
157		return;
158	}
159	unless ($t->type eq $type) {
160		$self->_throw_error(sprintf("Expecting %s but got %s", decrypt_constant($type), decrypt_constant($t->type)), $t, $l);
161	}
162	return $t;
163}
164
165sub parse_line {
166	my $self	= shift;
167	my $line	= shift;
168	my $base	= shift;
169	return if ($line =~ /^#/);
170	if (substr($line, 0, 7) eq '@prefix') {
171		open( my $fh, '<:encoding(UTF-8)', \$line );
172		my $l	= RDF::Trine::Parser::Turtle::Lexer->new($fh);
173		$self->_get_token_type($l, PREFIX);
174		my $t	= $self->_get_token_type($l, PREFIXNAME);
175		my $name	= $t->value;
176		$name		=~ s/:$//;
177		$t	= $self->_get_token_type($l, IRI);
178		my $r	= RDF::Trine::Node::Resource->new($t->value, $base);
179		my $iri	= $r->uri_value;
180		$t	= $self->_get_token_type($l, DOT);
181		$self->{namespaces}->add_mapping( $name => $iri );
182		return;
183	}
184
185	my ($op, $tail)	= split(/ /, $line, 2);
186	unless ($op =~ /^[ADQ]$/) {
187		throw RDF::Trine::Error::ParserError -text => "Unknown RDF Patch operation ID '$op'";
188	}
189
190	my $p		= RDF::Trine::Parser::Turtle->new( 'map' => $self->{namespaces} );
191	my @nodes;
192	foreach my $pos (1,2,3,4) {
193		if ($tail =~ /^\s*U\b/) {
194			substr($tail, 0, $+[0], '');
195			my $v	= RDF::Trine::Node::Variable->new("v$pos");
196			$self->{last}[$pos]	= $v;
197			push(@nodes, $v);
198		} elsif ($tail =~ /^\s*R\b/) {
199			substr($tail, 0, $+[0], '');
200			my $node	= $self->{last}[$pos];
201			unless (blessed($node)) {
202				throw RDF::Trine::Error -text => "Use of non-existent `R`epeated term";
203			}
204			push(@nodes, $node);
205		} elsif ($tail =~ /^\s*[.]/) {
206			last;
207		} else {
208			my $token;
209			my $n	= $p->parse_node($tail, $base, token => \$token);
210			$self->{last}[$pos]	= $n;
211			push(@nodes, $n);
212			my $len	= $token->column;
213			substr($tail, 0, $len, '');
214		}
215	}
216
217	my $st;
218	if (scalar(@nodes) == 3) {
219		$st	= RDF::Trine::Statement->new(@nodes);
220	} elsif (scalar(@nodes) == 4) {
221		$st	= RDF::Trine::Statement::Quad->new(@nodes);
222	} else {
223		my $arity	= scalar(@nodes);
224		throw RDF::Trine::Error::ParserError -text => "RDFPatch operation '$op' has unexpected arity ($arity)";
225	}
226
227	return RDF::Trine::Parser::RDFPatch::Op->new( $op, $st );
228}
229
230
231package RDF::Trine::Parser::RDFPatch::Op;
232
233use strict;
234use warnings;
235
236=item C<< new ( $op, @args ) >>
237
238Returns a new RDF-Patch Parser operation object.
239
240=cut
241
242sub new {
243	my $class	= shift;
244	my $op		= shift;
245	my @args	= @_;
246	my $self = bless( { op => $op, args => \@args }, $class );
247	return $self;
248}
249
250sub op {
251	my $self	= shift;
252	return $self->{op};
253}
254
255sub args {
256	my $self	= shift;
257	return @{ $self->{args} };
258}
259
260sub execute {
261	my $self	= shift;
262	my $model	= shift;
263	my $op	= $self->op;
264	if ($op eq 'A') {
265		return $model->add_statement( $self->args );
266	} elsif ($op eq 'D') {
267		return $model->remove_statement( $self->args );
268	} elsif ($op eq 'Q') {
269		my ($st)	= $self->args;
270		return $model->get_statements( $st->nodes );
271	} else {
272		throw RDF::Trine::Error -text => "Unexpected operation '$op' in RDF::Trine::Parser::RDFPatch::Op->execute";
273	}
274}
275
2761;
277
278__END__
279
280=back
281
282=head1 BUGS
283
284Please report any bugs or feature requests to through the GitHub web interface
285at L<https://github.com/kasei/perlrdf/issues>.
286
287=head1 SEE ALSO
288
289L<http://afs.github.io/rdf-patch/>
290
291=head1 AUTHOR
292
293Gregory Todd Williams  C<< <gwilliams@cpan.org> >>
294
295=head1 COPYRIGHT
296
297Copyright (c) 2006-2012 Gregory Todd Williams. This
298program is free software; you can redistribute it and/or modify it under
299the same terms as Perl itself.
300
301=cut
302