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