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