1# RDF::Trine::Serializer::TriG 2# ----------------------------------------------------------------------------- 3 4=head1 NAME 5 6RDF::Trine::Serializer::TriG - TriG Serializer 7 8=head1 VERSION 9 10This document describes RDF::Trine::Serializer::TriG version 1.019 11 12=head1 SYNOPSIS 13 14 use RDF::Trine::Serializer::TriG; 15 my $serializer = RDF::Trine::Serializer::TriG->new(); 16 17=head1 DESCRIPTION 18 19The RDF::Trine::Serializer::TriG class provides an API for serializing RDF 20graphs to the TriG syntax. 21 22=head1 METHODS 23 24Beyond the methods documented below, this class inherits methods from the 25L<RDF::Trine::Serializer> class. 26 27=over 4 28 29=cut 30 31package RDF::Trine::Serializer::TriG; 32 33use strict; 34use warnings; 35use base qw(RDF::Trine::Serializer); 36 37use URI; 38use Carp; 39use Encode; 40use Data::Dumper; 41use Scalar::Util qw(blessed refaddr reftype); 42 43use RDF::Trine::Node; 44use RDF::Trine::Statement; 45use RDF::Trine::Error qw(:try); 46 47###################################################################### 48 49our ($VERSION); 50BEGIN { 51 $VERSION = '1.019'; 52 $RDF::Trine::Serializer::serializer_names{ 'trig' } = __PACKAGE__; 53# $RDF::Trine::Serializer::format_uris{ 'http://sw.deri.org/2008/07/n-quads/#n-quads' } = __PACKAGE__; 54# foreach my $type (qw(text/x-nquads)) { 55# $RDF::Trine::Serializer::media_types{ $type } = __PACKAGE__; 56# } 57} 58 59###################################################################### 60 61=item C<< new >> 62 63Returns a new TriG serializer object. 64 65=cut 66 67sub new { 68 my $class = shift; 69 my $ns = {}; 70 my $base_uri; 71 72 my @args = @_; 73 my $ttl = RDF::Trine::Serializer::Turtle->new(@args); 74 if (@_) { 75 if (scalar(@_) == 1 and reftype($_[0]) eq 'HASH') { 76 $ns = shift; 77 } else { 78 my %args = @_; 79 if (exists $args{ base }) { 80 $base_uri = $args{ base }; 81 } 82 if (exists $args{ base_uri }) { 83 $base_uri = $args{ base_uri }; 84 } 85 if (exists $args{ namespaces }) { 86 $ns = $args{ namespaces }; 87 } 88 } 89 } 90 91 my %rev; 92 while (my ($ns, $uri) = each(%{ $ns })) { 93 if (blessed($uri)) { 94 $uri = $uri->uri_value; 95 if (blessed($uri)) { 96 $uri = $uri->uri_value; 97 } 98 } 99 $rev{ $uri } = $ns; 100 } 101 102 my $self = bless( { 103 ns => \%rev, 104 base_uri => $base_uri, 105 ttl => $ttl, 106 }, $class ); 107 108 return $self; 109} 110 111=item C<< serialize_model_to_file ( $fh, $model ) >> 112 113Serializes the C<$model> to TriG, printing the results to the supplied 114filehandle C<<$fh>>. 115 116=cut 117 118sub serialize_model_to_file { 119 my $self = shift; 120 my $file = shift; 121 my $model = shift; 122 123 my %ns = reverse(%{ $self->{ns} }); 124 my @nskeys = sort keys %ns; 125 if (@nskeys) { 126 foreach my $ns (sort @nskeys) { 127 my $uri = $ns{ $ns }; 128 print $file "\@prefix $ns: <$uri> .\n"; 129 } 130 print $file "\n"; 131 } 132 133 my $s = $self->{ttl}; 134 my $count = $model->count_statements(undef, undef, undef, RDF::Trine::Node::Nil->new()); 135 if ($count) { 136 my $iter = $model->get_statements(undef, undef, undef, RDF::Trine::Node::Nil->new()); 137 print $file "{\n\t"; 138 my $ttl = $s->serialize_iterator_to_string($iter); 139 $ttl =~ s/\n/\n\t/g; 140 print {$file} $ttl; 141 print $file "}\n\n"; 142 } 143 144 my $graphs = $model->get_graphs; 145 while (my $g = $graphs->next) { 146 my $iter = $model->get_statements(undef, undef, undef, $g); 147 print $file sprintf("%s {\n", $self->node_as_concise_string($g)); 148 my $ttl = $s->serialize_iterator_to_string($iter); 149 $ttl =~ s/\n/\n\t/g; 150 print $file $ttl; 151 print $file "}\n\n"; 152 } 153} 154 155=item C<< serialize_model_to_string ( $model ) >> 156 157Serializes the C<$model> to TriG, returning the result as a string. 158 159=cut 160 161sub serialize_model_to_string { 162 my $self = shift; 163 my $model = shift; 164 my $iter = $model->as_stream; 165 my $data = ''; 166 open(my $fh, '>:encoding(UTF-8)', \$data); 167 $self->serialize_model_to_file($fh, $model); 168 close($fh); 169 return decode('UTF-8', $data); 170} 171 172=item C<< serialize_iterator_to_file ( $file, $iter ) >> 173 174Serializes the iterator to TriG, printing the results to the supplied 175filehandle C<<$fh>>. 176 177=cut 178 179sub serialize_iterator_to_file { 180 my $self = shift; 181 my $file = shift; 182 my $iter = shift; 183 184 my %ns = reverse(%{ $self->{ns} }); 185 my @nskeys = sort keys %ns; 186 if (@nskeys) { 187 foreach my $ns (sort @nskeys) { 188 my $uri = $ns{ $ns }; 189 print $file "\@prefix $ns: <$uri> .\n"; 190 } 191 print $file "\n"; 192 } 193 194 my $g; 195 my $in_graph = 0; 196 my $s = $self->{ttl}; 197 while (my $st = $iter->next) { 198 my $new_graph = $st->isa('RDF::Trine::Statement::Quad') ? $st->graph : RDF::Trine::Node::Nil->new(); 199 if (not($in_graph)) { 200 $g = $new_graph; 201 if ($g->is_nil) { 202 print $file "{\n" 203 } else { 204 print $file sprintf("%s {\n", $s->node_as_concise_string($g)); 205 } 206 } elsif (not($g->equal($new_graph))) { 207 $g = $new_graph; 208 print $file sprintf("}\n\n%s {\n", $s->node_as_concise_string($g)); 209 } 210 $in_graph = 1; 211 212 print {$file} "\t" . $self->_statement_as_string( $st ); 213 } 214 215 if ($in_graph) { 216 print $file "}\n"; 217 } 218} 219 220=item C<< serialize_iterator_to_string ( $iter ) >> 221 222Serializes the iterator to TriG, returning the result as a string. 223 224=cut 225 226sub serialize_iterator_to_string { 227 my $self = shift; 228 my $iter = shift; 229 my $data = ''; 230 open(my $fh, '>:encoding(UTF-8)', \$data); 231 $self->serialize_iterator_to_file($fh, $iter); 232 close($fh); 233 return decode('UTF-8', $data); 234} 235 236sub _statement_as_string { 237 my $self = shift; 238 my $st = shift; 239 my @nodes; 240 my $s = $self->{ttl}; 241 @nodes = ($st->nodes)[0..2]; 242 return join(' ', map { $s->node_as_concise_string($_) } @nodes) . " .\n"; 243} 244 245 246=item C<< statement_as_string ( $st ) >> 247 248Returns a string with the supplied RDF::Trine::Statement::Quad object serialized 249as TriG, ending in a DOT and newline. 250 251=cut 252 253sub statement_as_string { 254 my $self = shift; 255 my $st = shift; 256 my @nodes = $st->nodes; 257 return join(' ', map { $_->as_ntriples } @nodes[0..3]) . " .\n"; 258} 259 260 261sub _node_concise_string { 262 my $self = shift; 263 my $obj = shift; 264 if ($obj->is_literal and $obj->has_datatype) { 265 my $dt = $obj->literal_datatype; 266 if ($dt =~ m<^http://www.w3.org/2001/XMLSchema#(integer|double|decimal)$> and $obj->is_canonical_lexical_form) { 267 my $value = $obj->literal_value; 268 return $value; 269 } else { 270 my $dtr = iri($dt); 271 my $literal = $obj->literal_value; 272 my $qname; 273 try { 274 my ($ns,$local) = $dtr->qname; 275 if (blessed($self) and exists $self->{ns}{$ns}) { 276 $qname = join(':', $self->{ns}{$ns}, $local); 277 $self->{used_ns}{ $self->{ns}{$ns} }++; 278 } 279 } catch RDF::Trine::Error with {}; 280 if ($qname) { 281 my $escaped = $obj->_unicode_escape( $literal ); 282 return qq["$escaped"^^$qname]; 283 } 284 } 285 } elsif ($obj->isa('RDF::Trine::Node::Resource')) { 286 my $value; 287 try { 288 my ($ns,$local) = $obj->qname; 289 if (blessed($self) and exists $self->{ns}{$ns}) { 290 $value = join(':', $self->{ns}{$ns}, $local); 291 $self->{used_ns}{ $self->{ns}{$ns} }++; 292 } 293 } catch RDF::Trine::Error with {} otherwise {}; 294 if ($value) { 295 return $value; 296 } 297 } 298 return; 299} 300 301=item C<< node_as_concise_string >> 302 303Returns a string representation using common Turtle syntax shortcuts (e.g. for numeric literals). 304 305=cut 306 307sub node_as_concise_string { 308 my $self = shift; 309 my $obj = shift; 310 my $str = $self->_node_concise_string( $obj ); 311 if (defined($str)) { 312 return $str; 313 } else { 314 return $obj->as_ntriples; 315 } 316} 317 3181; 319 320__END__ 321 322=back 323 324=head1 BUGS 325 326Please report any bugs or feature requests to through the GitHub web interface 327at L<https://github.com/kasei/perlrdf/issues>. 328 329=head1 SEE ALSO 330 331L<http://sw.deri.org/2008/07/n-quads/> 332 333=head1 AUTHOR 334 335Gregory Todd Williams C<< <gwilliams@cpan.org> >> 336 337=head1 COPYRIGHT 338 339Copyright (c) 2006-2012 Gregory Todd Williams. This 340program is free software; you can redistribute it and/or modify it under 341the same terms as Perl itself. 342 343=cut 344