use strict; #use warnings; package RDF::Notation3::Template::TTriples; require 5.005_62; use RDF::Notation3; ############################################################ @RDF::Notation3::Template::TTriples::ISA = qw(RDF::Notation3); sub parse_file { my ($self, $path) = @_; $self->_do_error(1, '') unless @_ > 1; $self->{triples} = []; $self->SUPER::parse_file($path); return scalar @{$self->{triples}}; } sub parse_string { my ($self, $str) = @_; $self->_do_error(3, '') unless @_ > 1; $self->{triples} = []; $self->SUPER::parse_string($str); return scalar @{$self->{triples}}; } sub get_triples { my ($self, $subj, $verb, $obj, $context) = @_; my @triples = (); foreach (@{$self->{triples}}) { if (not $subj or ($subj eq $_->[0])) { if (not $verb or ($verb eq $_->[1])) { if (not $obj or ($obj eq $_->[2])) { if (not $context or ($context eq $_->[3])) { push @triples, $_; } } } } } return \@triples; } sub get_triples_as_string { my ($self, $subj, $verb, $obj, $context) = @_; my $triples = ''; foreach (@{$self->{triples}}) { if (not $subj or ($subj eq $_->[0])) { if (not $verb or ($verb eq $_->[1])) { if (not $obj or ($obj eq $_->[2])) { if (not $context or ($context eq $_->[3])) { $triples .= "$_->[0] $_->[1] $_->[2]\n"; } } } } } return $triples; } sub get_n3 { my ($self) = @_; my $n3 = ''; # for each context foreach my $c (keys %{$self->{ns}}) { # namespaces foreach (keys %{$self->{ns}->{$c}}) { $n3 .= "\@prefix $_: <$self->{ns}->{$c}->{$_}> .\n"; } # statements my $tri_tree = {}; my @tri_seq = (); # building tree foreach my $t (@{$self->{triples}}) { if ($t->[3] eq $c) { push @{$tri_tree->{$t->[0]}->{$t->[1]}}, $t->[2]; push @tri_seq, $t->[0] unless grep ($_ eq $t->[0], @tri_seq); } } # serializing tree foreach my $s (@tri_seq) { $n3 .= "$s\n"; my @pred = keys %{$tri_tree->{$s}}; for (my $i=0; $i < @pred; $i++) { $n3 .= ' ' x 8; $n3 .= "$pred[$i] "; # object for (my $j=0; $j < @{$tri_tree->{$s}->{$pred[$i]}}; $j++) { $n3 .= $tri_tree->{$s}->{$pred[$i]}->[$j]; if ($i == $#pred && $j == @{$tri_tree->{$s}->{$pred[$i]}}-1) { $n3 .= " .\n"; } elsif ($j == @{$tri_tree->{$s}->{$pred[$i]}}-1) { $n3 .= " ;\n"; } else { $n3 .= " , "; } } } } } return $n3; } sub add_prefix { my ($self, $pref, $uri) = @_; if ($pref !~ /^[_a-zA-Z]\w*/) { $self->_do_error(102, $pref); } elsif ($uri !~ /^(?:[_a-zA-Z]\w*)?:[a-zA-Z]\w*$|^[^\{\}<>]*$/) { $self->_do_error(103, $uri); } else { $self->{ns}->{'<>'}->{$pref} = $uri; } return scalar keys %{$self->{ns}->{'<>'}}; } sub _check_resource { my ($self, $s, $rs, $type) = @_; if ($rs =~ /^<[^\{\}<>]*>$/) { # URI } elsif ($rs =~ /^(?:[_a-zA-Z]\w*)?:[a-zA-Z]\w*$/) { # QName my $bound = 0; foreach (keys %{$self->{ns}->{'<>'}}) { $rs =~ /^$_:(.*)$/ and $bound = 1 and last; } $self->_do_error(106, "$rs (subject: $s)") unless $bound; } elsif ($rs =~ /^"(?:\\"|[^\"])*"$/) { # string1 $self->_do_error(202, "$rs (subject: $s)") unless $type eq 'l'; } elsif ($rs =~ /^"""(.*)"""$/) { # string2 $self->_do_error(202, "$rs (subject: $s)") unless $type eq 'l'; } else { $self->_do_error(201, "$rs (subject: $s)"); } } 1; __END__ # Below is a documentation. =head1 NAME RDF::Notation3::Template::TTriples - a triple generator template =head1 LICENSING Copyright (c) 2001 Ginger Alliance. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Petr Cimprich, petr@gingerall.cz =head1 SEE ALSO perl(1), RDF::Notation3. =cut