[libcatmandu-rdf-perl] 01/01: basic RDF Exporter
Jonas Smedegaard
dr at jones.dk
Sun May 18 02:13:09 UTC 2014
This is an automated email from the git hooks/post-receive script.
js pushed a commit to tag 0.01
in repository libcatmandu-rdf-perl.
commit daf72cc4c52270f2c0cb31c5d4f3fc1b41559ae3
Author: Jakob Voss <voss at gbv.de>
Date: Thu Sep 5 11:39:00 2013 +0200
basic RDF Exporter
---
.gitignore | 5 +++
.perlcriticrc | 2 +
.travis.yml | 27 +++++++++++
README.md | 8 ++++
cpanfile | 2 +-
dist.ini | 33 ++++++++++++++
lib/Catmandu/Exporter/RDF.pm | 105 ++++++++++++++++++++++++++++++++++++++++---
lib/Catmandu/RDF.pm | 17 +++++++
t/exporter-add.t | 91 +++++++++++++++++++++++++++++++++++++
t/exporter.t | 22 ++-------
10 files changed, 287 insertions(+), 25 deletions(-)
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..3dca150
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,5 @@
+.DS_Store
+*.swp
+.build
+build
+Catmandu-RDF-*
diff --git a/.perlcriticrc b/.perlcriticrc
new file mode 100644
index 0000000..c2f6df1
--- /dev/null
+++ b/.perlcriticrc
@@ -0,0 +1,2 @@
+[TestingAndDebugging::RequireUseStrict]
+equivalent_modules = Catmandu::Sane
diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 0000000..3d25543
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,27 @@
+language: perl
+perl:
+ - "5.19"
+ - "5.18"
+ - "5.16"
+ - "5.14"
+ - "5.12"
+ - "5.10"
+
+before_install:
+ - git config --global user.name "TravisCI"
+ - git config user.email 'travis at nowhere.dne'
+
+install:
+ - cpanm --quiet --notest --skip-satisfied Dist::Zilla
+ - dzil authordeps | grep -vP '[^\w:]' | xargs -n 5 -P 10 cpanm --quiet --notest --skip-satisfied
+ - dzil listdeps | grep -vP '[^\w:]' | cpanm --verbose --notest
+
+script:
+ - dzil smoke --release --author
+
+after_success:
+ - cpanm --quiet --notest --skip-satisfied Dist::Zilla::App::Command::cover Devel::Cover::Report::Coveralls
+ - dzil cover -test
+ - dzil cover -report coveralls
+
+env: RELEASE_TESTING=1 AUTOMATED_TESTING=1 AUTHOR_TESTING=1
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..8e5fe7e
--- /dev/null
+++ b/README.md
@@ -0,0 +1,8 @@
+Catmandu::RDF - Modules for handling RDF data within the [Catmandu](http://librecat.org) framework.
+
+This [CPAN distribution](https://metacpan.org/release/Catmandu-RDF) is in an
+early state of development. Feedback and contributions are very welcome at
+<https://github.com/nichtich/Catmandu-RDF>!
+
+[](https://travis-ci.org/nichtich/Catmandu-RDF)
+[](https://coveralls.io/r/nichtich/Catmandu-RDF?branch=master)
diff --git a/cpanfile b/cpanfile
index 0382506..0d698db 100644
--- a/cpanfile
+++ b/cpanfile
@@ -1,3 +1,3 @@
requires 'Catmandu', '>= 0.7';
requires 'RDF::Trine', '>= 1.0';
-requires 'RDF::Lazy', '0';
+requires 'RDF::NS', '>= 20130816';
diff --git a/dist.ini b/dist.ini
new file mode 100644
index 0000000..3c0571f
--- /dev/null
+++ b/dist.ini
@@ -0,0 +1,33 @@
+name = Catmandu-RDF
+license = Perl_5
+version = 0.01
+copyright_year = 2013
+author = Jakob Voß
+copyright_holder = Jakob Voß
+
+[@Basic]
+[PodWeaver]
+[OurPkgVersion]
+
+[Prereqs::FromCPANfile]
+
+;[Test::Perl::Critic]
+;critic_config = .perlcriticrc
+
+[PruneFiles]
+filename = dist.ini
+filename = .travis.yml
+filename = README.md
+filename = .perlcriticrc
+
+[GithubMeta]
+issues=1
+
+[ChangelogFromGit::CPAN::Changes]
+tag_regexp = ^v(\d+\.\d+)$
+
+[Git::Check]
+[Git::Tag]
+tag_format = %v
+tag_message =
+[Git::Push]
diff --git a/lib/Catmandu/Exporter/RDF.pm b/lib/Catmandu/Exporter/RDF.pm
index 7623ac6..0a97018 100644
--- a/lib/Catmandu/Exporter/RDF.pm
+++ b/lib/Catmandu/Exporter/RDF.pm
@@ -1,16 +1,28 @@
package Catmandu::Exporter::RDF;
#ABSTRACT: serialize RDF data
+#VERSION
use namespace::clean;
use Catmandu::Sane;
use Moo;
use RDF::Trine::Serializer;
+use RDF::NS;
with 'Catmandu::Exporter';
has type => (is => 'ro', default => sub { 'RDFXML' });
has serializer => (is => 'ro', lazy => 1, builder => '_build_serializer' );
-has _data => (is => 'rw'); # TODO:
+
+# experimental
+has _data => (is => 'rw');
+has ns => (
+ is => 'ro',
+ default => sub { RDF::NS->new() },
+ coerce => sub {
+ (!ref $_[0] or ref $_[0] ne 'RDF::NS') ? RDF::NS->new(@_) : $_[0];
+ },
+ handles => ['uri'],
+);
our %TYPE_ALIAS = (
Ttl => 'Turtle',
@@ -37,9 +49,9 @@ sub add {
# TODO: make performant
my $model = RDF::Trine::Model->new;
- # TODO: support lazy hashref with RDF::NS etc.
- # e.g. subject in _id:
- $model->add_hashref( $data );
+ my $rdf = $self->_expand_rdf($data);
+ #use Data::Dumper; say STDERR Dumper($rdf);
+ $model->add_hashref( $rdf );
$self->_data(
$self->_data->concat( $model->as_stream )
@@ -54,6 +66,77 @@ sub commit {
$self->serializer->serialize_iterator_to_file( $self->fh, $self->_data );
}
+sub _blank {
+ my ($self) = @_;
+ return '_:b'.++$self->{_blank_id};
+}
+
+sub _expand_object {
+ my ($self,$obj) = @_;
+
+ # RDF::Trine allows: plain literal or /^_:/ or /^[a-z0-9._\+-]{1,12}:\S+$/i or /^(.*)\@([a-z]{2})$/)
+ return $obj if !ref $obj;
+
+ my ($rdf, $bnode) = { };
+
+ if ($obj->{'@id'}) {
+ $rdf = { type => 'uri', value => $obj->{'@id'} };
+ } elsif ($obj->{'@value'}) {
+ $rdf = { type => 'literal', value => $obj->{'@value'} };
+ $rdf->{datatype} = $self->uri($obj->{'@type'}) if defined $obj->{'@type'};
+ #TODO #@language
+ } else {
+ $rdf->{type} = 'bnode';
+ $rdf->{value} = $self->_blank();
+
+ for (keys %$obj) { # TODO: recurse via _expand_rdf
+ next if /^@/;
+
+ my $b_predicate = $self->uri($_);
+ my $b_object = $self->_expand_object($obj->{$_});
+
+ push @{ $bnode->{$b_predicate} }, $b_object;
+ }
+ $bnode = { $rdf->{value} => $bnode } if $bnode;
+ }
+
+ # TODO @type
+ # TODO: _:xx allowed in RDF:NS?
+
+ return ($rdf, $bnode);
+}
+
+sub _expand_rdf {
+ my ($self,$data) = @_;
+
+ return $data unless $data->{'@id'};
+ my $subject = $data->{'@id'};
+
+ my @triples;
+
+ my $statements = {};
+ my $triples = { $subject => $statements };
+
+ foreach my $p (keys %$data) {
+ next if $p eq '@id';
+ my ($predicate, $object) = ($p, $data->{$p});
+
+ # TODO: disallow http://www.iana.org/assignments/uri-schemes/uri-schemes.xhtml (better in RDF::NS)
+ if ($predicate =~ /^([a-z][a-z0-9]*)[:_]/ and $1 ne 'http') {
+ $predicate = $self->uri($predicate);
+ }
+
+ my ($o, $t) = $self->_expand_object($object);
+ push @{ $statements->{$predicate} }, $o;
+
+ if ($t) { # additional triples
+ $triples->{$_} = $t->{$_} for keys %$t;
+ }
+ }
+
+ return $triples;
+}
+
=head1 SYNOPSIS
use Catmandu::Exporter::RDF;
@@ -84,11 +167,23 @@ and C<XML> for C<RDFXML>, C<json> for C<RDFJSON>.
The option C<fix> is supported as derived from L<Catmandu::Fixable>. For every
C<add> or for every item in C<add_many> the given fixes will be applied first.
+The option C<ns> can refer to an instance of or to a constructor argument of
+L<RDF::NS>. Use a fixed date, such as '20130816' to make sure your URI
+namespace prefixes are stable.
+
+=head2 add
+
+RDF data can be added as used by L<RDF::Trine::Model/as_hashref> in form of
+hash references. A simplified form of JSON-LD will be supported as well.
+
=head2 count
Always returns 1 because there is always one RDF graph in a RDF document.
-TODO: better return the number of unique RDF subjects?
+=head2 uri
+
+Used to expands an URI with L<RDF::NS>: for instance C<dc:title> is expanded to
+<http://purl.org/dc/elements/1.1/title>.
=cut
diff --git a/lib/Catmandu/RDF.pm b/lib/Catmandu/RDF.pm
new file mode 100644
index 0000000..8665992
--- /dev/null
+++ b/lib/Catmandu/RDF.pm
@@ -0,0 +1,17 @@
+package Catmandu::RDF;
+#ABSTRACT: Modules for handling RDF data within the Catmandu framework
+#VERSION
+
+=head1 DESCRIPTION
+
+Catmandu::RDF contains modules for handling RDF data within the L<Catmandu>
+framework. This release is in an early state of development. Feedback and
+contributions are very welcome at <https://github.com/nichtich/Catmandu-RDF>!
+
+=head1 MODULES
+
+=item L<Catmandu::Exporter::RDF>
+
+=cut
+
+1;
diff --git a/t/exporter-add.t b/t/exporter-add.t
new file mode 100644
index 0000000..8f8c104
--- /dev/null
+++ b/t/exporter-add.t
@@ -0,0 +1,91 @@
+use strict;
+use warnings;
+use Test::More;
+
+use Catmandu::Exporter::RDF;
+
+sub check_add(@) {
+ my $options = shift;
+ my $data = shift;
+ my $result = shift;
+
+ my $file = "";
+ my $exporter = Catmandu::Exporter::RDF->new(file => \$file, %$options);
+
+ $exporter->add($data);
+ $exporter->commit;
+
+ if (ref $result) {
+ $result->($file);
+ } else {
+ is $file, $result, $_[0];
+ }
+}
+
+
+check_add { type => 'ttl', ns => '20130816' }, {
+ '@id' => 'http://example.org/',
+ 'dc:title' => 'Subject',
+} => "<http://example.org/> <http://purl.org/dc/elements/1.1/title> \"Subject\" .\n",
+ 'expand predicate URI';
+
+check_add { type => 'ttl', ns => '20130816' }, {
+ '@id' => 'http://example.org/',
+ 'dc:title' => { '@value' => 'Subject' },
+} => "<http://example.org/> <http://purl.org/dc/elements/1.1/title> \"Subject\" .\n",
+ 'literal object';
+
+check_add { type => 'ttl', ns => '20130816' }, {
+ '@id' => 'http://example.org/',
+ 'dct:extent' => { '@value' => '42', '@type' => 'xsd:integer' },
+} => "<http://example.org/> <http://purl.org/dc/terms/extent> 42 .\n",
+ 'literal object with datatype';
+
+check_add { type => 'ttl', ns => '20130816' }, {
+ '@id' => 'http://example.org/',
+ 'http://example.org/predicate' => { '@id' => 'http://example.com/object' },
+} => "<http://example.org/> <http://example.org/predicate> <http://example.com/object> .\n",
+ 'uri object';
+
+check_add { type => 'ttl', ns => '20130816' }, {
+ '@id' => 'http://example.org/',
+ 'http://example.org/predicate' => { },
+} => "<http://example.org/> <http://example.org/predicate> _:b1 .\n",
+ 'blank node object';
+
+check_add { type => 'ttl', ns => '20130816' }, {
+ '@id' => 'http://www.gbv.de/',
+ 'geo:location' => {
+ 'geo:lat' => '9.93492',
+ 'geo:long' => '51.5393710',
+ }
+} => sub {
+ my $ttl = shift;
+ ok $ttl =~ qr{_:b1 <http://www.w3.org/2003/01/geo/wgs84_pos\#lat> "9.93492"}
+ && $ttl =~ qr{<http://www.w3.org/2003/01/geo/wgs84_pos\#long> "51.5393710"}
+ && $ttl =~ qr{<http://www.gbv.de/> <http://www.w3.org/2003/01/geo/wgs84_pos\#location> _:b1},
+ 'nested RDF';
+};
+
+## fixes
+
+check_add { type => 'ttl', ns => '20130816',
+ fix => ["move_field('_id','\@id')","prepend('\@id','http://example.org/');"]
+}, {
+ '_id' => 123,
+ 'dc:title' => 'Foo',
+} => "<http://example.org/123> <http://purl.org/dc/elements/1.1/title> \"Foo\" .\n",
+ 'fix subject URI';
+
+check_add { type => 'ttl', ns => '20130816',
+ fix => [
+ "move_field('dc:extent','dc:extent.\@value');",
+ "add_field('dc:extent.\@type','xsd:integer');"
+ ]
+}, {
+ '@id' => 'http://example.org/',
+ 'dc:extent' => '42',
+} => "<http://example.org/> <http://purl.org/dc/elements/1.1/extent> 42 .\n",
+ 'fix predicate';
+
+done_testing;
diff --git a/t/exporter.t b/t/exporter.t
index fa65ced..c476a7f 100644
--- a/t/exporter.t
+++ b/t/exporter.t
@@ -27,6 +27,7 @@ my $data = { # example copied from RDF::Trine::Model
my $exporter = $pkg->new(file => \$file, type => 'ttl');
isa_ok $exporter, $pkg;
+is $exporter->count, 0, 'count is zero';
$exporter->add($data);
$exporter->commit;
@@ -40,23 +41,6 @@ is $file, <<'RDF', 'serialize Turtle';
_:bnode1 <http://example.com/predicate2> _:bnode3 .
RDF
-done_testing;
+is $exporter->count, 1, 'count is always one';
-__END__
-
-# Support a subset of JSON-LD
-# TODO: test
-{
- '@id' => 'http://example.org/subject1',
- 'dc:title' => 'Example',
- 'http://example.org/predicate' => { '@id' => 'http://example.com/object2' },
- 'dc:modified' => {
- "@value": "2010-05-29T14:17:39+02:00",
- "@type": "http://www.w3.org/2001/XMLSchema#dateTime"
- }
-}
-
-set_field('@id','http://example.org/subject1');
-set_field('dc:title','Example');
-set_field('dc:modified. at value',"2010-05-29T14:17:39+02:00");
-set_field('dc:modified. at type','xsd:dateTime');
+done_testing;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-rdf-perl.git
More information about the Pkg-perl-cvs-commits
mailing list