@@ -, +, @@
#2
---------------
---
C4/Installer/PerlDependencies.pm | 15 ++
C4/Record.pm | 20 ++-
Koha/DublinCoreTransformer.pm | 298 ++++++++++++++++++++++++--------------
debian/control | 6 +
4 files changed, 225 insertions(+), 114 deletions(-)
--- a/C4/Installer/PerlDependencies.pm
+++ a/C4/Installer/PerlDependencies.pm
@@ -737,6 +737,21 @@ our $PERL_DEPS = {
'required' => '0',
'min_ver' => '5.61',
},
+ 'HTML::Entities' => {
+ 'usage' => 'Core',
+ 'required' => '1',
+ 'min_ver' => '3.69',
+ },
+ 'HTML::Entities::Numbered' => {
+ 'usage' => 'Core',
+ 'required' => '1',
+ 'min_ver' => '0.04',
+ },
+ 'RDF::Trine' => {
+ 'usage' => 'Core',
+ 'required' => '1',
+ 'min_ver' => '1.000',
+ },
};
1;
--- a/C4/Record.pm
+++ a/C4/Record.pm
@@ -218,15 +218,29 @@ sub marcxml2marc {
=head2 marc2dcxml - Convert from ISO-2709 to Dublin Core
- my ($error,$dcxml) = marc2dcxml($marc,$qualified);
+ my ( $error, $dcxml ) = marc2dcxml( $type, $marc, $qualified,
+ $entities, $root, $xsi_schemaLocation,
+ $rdf_subject, $rdf_format );
Returns a DublinCore::Record object, will eventually return a Dublin Core scalar
-FIXME: should return actual XML, not just an object
+FIXME: should return actual XML, not just an object (Koha::DublinCoreTransformer return an XML)
+
+C<$type> - the recommendation ( simple-dc-rdf, dc-rdf, dc-xml, oai-dc )
C<$marc> - an ISO-2709 scalar or MARC::Record object
-C<$qualified> - specify whether qualified Dublin Core should be used in the input or output [0]
+C<$qualified> - specify whether simple or qualified Dublin Core should be used in output [0 or 1]
+
+C<$entities> placing entities to 0 will codify only the five basic entities e.g., <, >, ", &, and &apos. Conversely if it is encoded to 1, all entities will coded into decimal
+
+C<$root> root element for XML files
+
+C<$xsi_schemaLocation> the xsischemaLocation for XML files.
+
+C<$rdf_subject> Represent the main subject of RDF triples (for Koha the URI of the resource)
+
+C<$rdf_format> Imply multiple formats for RDF (ntriples, nquads, rdfxml, rdfjson, ntriples-canonical, turtle)
=cut
--- a/Koha/DublinCoreTransformer.pm
+++ a/Koha/DublinCoreTransformer.pm
@@ -24,6 +24,7 @@ package Koha::DublinCoreTransformer;
use Modern::Perl;
use strict;
use warnings::register;
+use utf8;
use version;
use v5.10.1;
@@ -45,14 +46,12 @@ BEGIN {
}
-use utf8;
-use Encode qw(is_utf8 encode decode);
use MARC::File::USMARC;
use MARC::Crosswalk::DublinCore;
use XML::LibXML;
use HTML::Entities;
-use XML::Entities;
-use RDF::Helper;
+use HTML::Entities::Numbered;
+use RDF::Trine;
use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(
qw(type qualified get_marc_record root xsi_schemaLocation rdf_subject rdf_format entities optional_namespace namespace_url)
@@ -66,6 +65,7 @@ my $dcam = qq(http://purl.org/dc/dcam/);
my $rdfNS = qq(http://www.w3.org/1999/02/22-rdf-syntax-ns#);
my @elementupcase =
qw/tableOfContents dateAccepted dateCopyrighted dateSubmitted isVersionOf hasVersion isReplacedBy isRequiredBy isPartOf hasPart isReferencedBy isFormatOf hasFormat conformsTo accrualMethod accrualPeriodicity accrualPolicy instructionalMethod rightsHolder educationLevel accessRights bibliographicCitation/;
+my $map;
#USAGE: Koha::DublinCoreTransformer->new({
# type => 'xml|rdf',
@@ -103,10 +103,10 @@ sub get_xml_data {
$self->{root} = "metadata" unless ( defined $self->{root} );
$self->{entities} = 0 unless ( defined $self->{entities} );
my %dataxml = (
- xmlroot => $self->{root},
- entities => $self->{entities},
+ xmlroot => $self->{root},
+ entities => $self->{entities},
optional_namespace => $self->{optional_namespace},
- namespace_url => $self->{namespace_url},
+ namespace_url => $self->{namespace_url},
);
if ( exists $self->{xsi_schemaLocation} ) {
@@ -219,9 +219,9 @@ sub write_xml {
my $root = $doc->createElement( $dataxml->{'xmlroot'} );
$root->setNamespace( $xsi_schema, 'xsi', 0 );
- if (defined $dataxml->{'optional_namespace'}){
- $root->setNamespace( $dataxml->{'namespace_url'},
- $dataxml->{'optional_namespace'}, 0 );
+ if ( defined $dataxml->{'optional_namespace'} ) {
+ $root->setNamespace( $dataxml->{'namespace_url'},
+ $dataxml->{'optional_namespace'}, 0 );
}
if ( $self->type() eq 'xml' ) {
@@ -258,7 +258,7 @@ sub write_xml {
#Enabling or desabling entities and print the xml
if ( $dataxml->{'entities'} == 1 ) {
my $serialized_data = $doc->toString(1);
- my ($dcxml_entity_encoded) = XML_entity_encode( $serialized_data );
+ my ($dcxml_entity_encoded) = XML_entity_encode($serialized_data);
$serialized_data = $dcxml_entity_encoded;
return $serialized_data;
}
@@ -271,8 +271,8 @@ sub write_rdf {
my $self = shift;
my $rdfdescription = $self->get_rdf_data();
my $dc = $self->conversion_to_dc();
- my $rdf;
- my $subject = $rdfdescription->{'rdf_subject'};
+ my $serializer;
+ my %namespaces;
#Looking for bad data
if ( ( $self->type() ne 'xml' and $self->type() ne 'rdf' )
@@ -293,54 +293,63 @@ sub write_rdf {
die "Set entities => " . $self->entities() . " is no good, stopped";
}
+ # Creating the triple store in temporary data
+ my $store = RDF::Trine::Store::Memory->new();
+
+ # Creating the model
+ my $rdf = RDF::Trine::Model->new($store);
+
+ # Creating the subject
+ my $subject =
+ RDF::Trine::Node::Resource->new( $rdfdescription->{'rdf_subject'} );
+
+ $namespaces{'rdf'} = $rdfNS;
+
if ( $self->qualified() == 0 ) {
- #Creating RDF::Helper object
- $rdf = RDF::Helper->new(
- BaseInterface => 'RDF::Trine',
- namespaces => {
- rdf => $rdfNS,
- dc => $unqualified,
- },
- ExpandQNames => 1,
- base_uri => '',
- );
+ # Declaring all namespaces in a hash
+ $namespaces{'dc'} = $unqualified;
}
else {
- $rdf = RDF::Helper->new(
- BaseInterface => 'RDF::Trine',
- namespaces => {
- rdf => $rdfNS,
- dcterms => $qualified,
- dcam => $dcam,
- },
- ExpandQNames => 1,
- base_uri => '',
- );
+
+ # Declaring all namespaces in a hash
+ $namespaces{'dcterms'} = $qualified;
+ $namespaces{'dcam'} = $dcam;
}
+ # Creating namespaces
+ $map = RDF::Trine::NamespaceMap->new( \%namespaces );
+
if ( $self->type() eq 'rdf' ) {
$self->dc_order_execution( $dc, $rdf, $subject );
}
#Enabling or desabling entities and print the xml, fixing encode with rdfjson
- if ( $rdfdescription->{'entities'} == 1
- && $rdfdescription->{'rdf_format'} eq 'rdfxml' )
- {
- my $serialized_data = $rdf->serialize( format => $rdfdescription->{'rdf_format'} );
- my ($dcxml_entity_encoded) = XML_entity_encode( $serialized_data );
- $serialized_data = $dcxml_entity_encoded;
- return $serialized_data;
+ if ( $rdfdescription->{'rdf_format'} eq 'rdfxml' ) {
+ if ( $rdfdescription->{'entities'} == 1 ) {
+ $serializer =
+ RDF::Trine::Serializer::RDFXML->new(
+ namespaces => {%namespaces} );
+ my $serialized_data = $serializer->serialize_model_to_string($rdf);
+ my ($dcxml_entity_encoded) = XML_entity_encode($serialized_data);
+ return $serialized_data = $dcxml_entity_encoded;
+ }
+ else {
+ $serializer =
+ RDF::Trine::Serializer::RDFXML->new(
+ namespaces => {%namespaces} );
+ return $serializer->serialize_model_to_string($rdf);
+ }
}
- elsif ( $rdfdescription->{'rdf_format'} eq 'rdfjson' ) {
- my $encoding =
- $rdf->serialize( format => $rdfdescription->{'rdf_format'} );
- my $enc = Encode::find_encoding('iso-8859-1');
- Encode::is_utf8 ( $encoding ) ? $encoding : $enc->decode ( $encoding );
- return $encoding;
+ elsif ( $rdfdescription->{'rdf_format'} eq 'turtle' ) {
+ $serializer =
+ RDF::Trine::Serializer::Turtle->new( namespaces => {%namespaces} );
+ return $serializer->serialize_model_to_string($rdf);
}
else {
- return $rdf->serialize( format => $rdfdescription->{'rdf_format'} );
+ $serializer =
+ RDF::Trine::Serializer->new( $rdfdescription->{'rdf_format'} );
+ return $serializer->serialize_model_to_string($rdf);
}
}
@@ -376,8 +385,9 @@ sub XML_entity_encode {
foreach my $string (@strings) {
utf8::decode($string);
my $html_entities =
- HTML::Entities::encode_entities( $string, '^\n\t\x20-\x26\x28-\x7e' );
- my $xml_entities = XML::Entities::numify( 'all', $html_entities );
+ HTML::Entities::encode_entities( $string, '^\n\t\x20-\x7e' );
+ my $xml_entities =
+ HTML::Entities::Numbered::name2hex_xml($html_entities);
push @strings_entity_encoded, $xml_entities;
}
return @strings_entity_encoded;
@@ -503,80 +513,145 @@ sub rdf_constructor {
if ( ( $namespace eq "dc" or "dcterms" ) and $attr == 0 ) {
# This will do something like: Title
- my $predicate = $namespace . ':' . $lowercase;
- my $object = $element_content;
- $rdf->assert_literal( $subject, $predicate, $object );
+ my $predicate = undef;
+ if ( $namespace eq "dc" ) {
+ $predicate = $map->dc($lowercase);
+ }
+ else {
+ $predicate = $map->dcterms($lowercase);
+ }
+ my $object = RDF::Trine::Node::Literal->new($element_content);
+ my $statement =
+ RDF::Trine::Statement->new( $subject, $predicate, $object );
+ $rdf->add_statement($statement);
}
elsif ( ( $namespace eq "dc" ) and $attr == 2 ) {
# This will do something like: Title
- my $predicate = 'dcterms:' . $lowercase;
- my $object = $element_content;
- $rdf->assert_literal( $subject, $predicate, $object );
+ my $predicate = $map->dcterms($lowercase);
+ my $object = RDF::Trine::Node::Literal->new($element_content);
+ my $statement =
+ RDF::Trine::Statement->new( $subject, $predicate, $object );
+ $rdf->add_statement($statement);
}
elsif ( ( $namespace eq "dc" ) and $attr == 1 ) {
$deletespaces = $element_scheme;
$deletespaces =~ s/\s//;
- my $predicate = 'dcterms:' . $lowercase;
- my $object = $element_content;
- SWITCH:
+ SWITCH:
for ($element_scheme) {
- if ( /^ISO 3166/ ) {
-
- # Dublin core returns DCMI Type Vocabulary
- # This will do something like:
- #
- #
- # us
- #
- #
- my $bnode = $rdf->new_bnode("country");
- my $uri_resource = join "", $qualified, $deletespaces;
- my $resource = $rdf->new_resource($uri_resource);
- $rdf->assert_literal( $subject, $predicate, $bnode );
- $rdf->assert_literal( $bnode, 'dcam:memberOf', $resource );
- $rdf->assert_literal( $bnode, 'rdf:value', $object );
+ if (/^ISO 3166/) {
+
+ # Dublin core returns DCMI Type Vocabulary
+ # This will do something like:
+ #
+ #
+ # us
+ #
+ #
+ my $objectbnode = RDF::Trine::Node::Blank->new('country');
+ my $predicate = $map->dcterms($lowercase);
+ my $object = RDF::Trine::Node::Literal->new($element_content);
+ my $dcam_member_of = $map->dcam('memberOf');
+ my $resource_schema = $map->dcterms($deletespaces);
+ my $rdf_value = $map->rdf('value');
+ my $statement1 =
+ RDF::Trine::Statement->new( $subject, $predicate,
+ $objectbnode );
+ my $statement2 =
+ RDF::Trine::Statement->new( $objectbnode, $dcam_member_of,
+ $resource_schema );
+ my $statement3 =
+ RDF::Trine::Statement->new( $objectbnode, $rdf_value,
+ $object );
+ $rdf->add_statement($statement1);
+ $rdf->add_statement($statement2);
+ $rdf->add_statement($statement3);
last SWITCH;
}
- if ( /^DCMI Type Vocabulary/ )
- { #Changing for DCMIType
- my $bnode = $rdf->new_bnode('DCMIType');
- my $uri_resource = $qualified . 'DCMIType';
- my $resource = $rdf->new_resource($uri_resource);
- $rdf->assert_literal( $subject, $predicate, $bnode );
- $rdf->assert_literal( $bnode, 'dcam:memberOf', $resource );
- $rdf->assert_literal( $bnode, 'rdf:value', $object );
+ if (/^DCMI Type Vocabulary/) { #Changing for DCMIType
+ my $objectbnode = RDF::Trine::Node::Blank->new('DCMIType');
+ my $predicate = $map->dcterms($lowercase);
+ my $object = RDF::Trine::Node::Literal->new($element_content);
+ my $dcam_member_of = $map->dcam('memberOf');
+ my $resource_schema = $map->dcterms('DCMIType');
+ my $rdf_value = $map->rdf('value');
+ my $statement1 =
+ RDF::Trine::Statement->new( $subject, $predicate,
+ $objectbnode );
+ my $statement2 =
+ RDF::Trine::Statement->new( $objectbnode, $dcam_member_of,
+ $resource_schema );
+ my $statement3 =
+ RDF::Trine::Statement->new( $objectbnode, $rdf_value,
+ $object );
+ $rdf->add_statement($statement1);
+ $rdf->add_statement($statement2);
+ $rdf->add_statement($statement3);
last SWITCH;
}
- if ( /^ISO 639-2/ )
- { #Changing bnodeId ISO639-2 for language
- my $bnode = $rdf->new_bnode('language');
- my $uri_resource = join "", $qualified, $deletespaces;
- my $resource = $rdf->new_resource($uri_resource);
- $rdf->assert_literal( $subject, $predicate, $bnode );
- $rdf->assert_literal( $bnode, 'dcam:memberOf', $resource );
- $rdf->assert_literal( $bnode, 'rdf:value', $object );
+ if (/^ISO 639-2/) { #Changing bnodeId ISO639-2 for language
+ my $objectbnode = RDF::Trine::Node::Blank->new('language');
+ my $predicate = $map->dcterms($lowercase);
+ my $object = RDF::Trine::Node::Literal->new($element_content);
+ my $dcam_member_of = $map->dcam('memberOf');
+ my $resource_schema = $map->dcterms($deletespaces);
+ my $rdf_value = $map->rdf('value');
+ my $statement1 =
+ RDF::Trine::Statement->new( $subject, $predicate,
+ $objectbnode );
+ my $statement2 =
+ RDF::Trine::Statement->new( $objectbnode, $dcam_member_of,
+ $resource_schema );
+ my $statement3 =
+ RDF::Trine::Statement->new( $objectbnode, $rdf_value,
+ $object );
+ $rdf->add_statement($statement1);
+ $rdf->add_statement($statement2);
+ $rdf->add_statement($statement3);
last SWITCH;
}
- if ( /^RFC 1766/ )
- { #Changing bnodeId RFC1766 for languagetag
- my $bnode = $rdf->new_bnode('languagetag');
- my $uri_resource = join "", $qualified, $deletespaces;
- my $resource = $rdf->new_resource($uri_resource);
- $rdf->assert_literal( $subject, $predicate, $bnode );
- $rdf->assert_literal( $bnode, 'dcam:memberOf', $resource );
- $rdf->assert_literal( $bnode, 'rdf:value', $object );
+ if (/^RFC 1766/) { #Changing bnodeId RFC1766 for languagetag
+ my $objectbnode = RDF::Trine::Node::Blank->new('languagetag');
+ my $predicate = $map->dcterms($lowercase);
+ my $object = RDF::Trine::Node::Literal->new($element_content);
+ my $dcam_member_of = $map->dcam('memberOf');
+ my $resource_schema = $map->dcterms($deletespaces);
+ my $rdf_value = $map->rdf('value');
+ my $statement1 =
+ RDF::Trine::Statement->new( $subject, $predicate,
+ $objectbnode );
+ my $statement2 =
+ RDF::Trine::Statement->new( $objectbnode, $dcam_member_of,
+ $resource_schema );
+ my $statement3 =
+ RDF::Trine::Statement->new( $objectbnode, $rdf_value,
+ $object );
+ $rdf->add_statement($statement1);
+ $rdf->add_statement($statement2);
+ $rdf->add_statement($statement3);
last SWITCH;
}
if ( /^LCSH/ || /^MeSH/ || /^LCC/ || /^DDC/ ||
/^UDC/ || /^IMT/ || /^URI/ || /^TGN/ )
{ #Scheme sharing common elements
- my $bnode = $rdf->new_bnode($deletespaces);
- my $uri_resource = join "", $qualified, $deletespaces;
- my $resource = $rdf->new_resource($uri_resource);
- $rdf->assert_literal( $subject, $predicate, $bnode );
- $rdf->assert_literal( $bnode, 'dcam:memberOf', $resource );
- $rdf->assert_literal( $bnode, 'rdf:value', $object );
+ my $objectbnode = RDF::Trine::Node::Blank->new($deletespaces);
+ my $predicate = $map->dcterms($lowercase);
+ my $object = RDF::Trine::Node::Literal->new($element_content);
+ my $dcam_member_of = $map->dcam('memberOf');
+ my $resource_schema = $map->dcterms($deletespaces);
+ my $rdf_value = $map->rdf('value');
+ my $statement1 =
+ RDF::Trine::Statement->new( $subject, $predicate,
+ $objectbnode );
+ my $statement2 =
+ RDF::Trine::Statement->new( $objectbnode, $dcam_member_of,
+ $resource_schema );
+ my $statement3 =
+ RDF::Trine::Statement->new( $objectbnode, $rdf_value,
+ $object );
+ $rdf->add_statement($statement1);
+ $rdf->add_statement($statement2);
+ $rdf->add_statement($statement3);
last SWITCH;
}
}
@@ -909,21 +984,21 @@ version 0.01
This package requires the following modules:
-DublinCore::Record
+L
-MARC::Record
+L
-MARC::File::USMARC
+L
-MARC::Crosswalk::DublinCore
+L
-HTML::Entities
+L
-XML::Entities
+L
-XML::LibXML
+L
-RDF::Helper
+L
=head2 SEE ALSO
@@ -939,3 +1014,4 @@ Hector Eduardo Catro Avalos E hector.hecaxmmx at gmail dot com E
and the Koha Development Team.
=cut
+
--- a/debian/control
+++ a/debian/control
@@ -52,7 +52,9 @@ Build-Depends: libalgorithm-checkdigits-perl,
libgd-gd2-noxpm-perl | libgd-gd2-perl,
libgraphics-magick-perl,
libgravatar-url-perl,
+ libhtml-entities-numbered-perl,
libhtml-format-perl,
+ libhtml-parser-perl,
libhtml-scrubber-perl,
libhttp-cookies-perl,
libhttp-message-perl,
@@ -86,6 +88,7 @@ Build-Depends: libalgorithm-checkdigits-perl,
libpdf-reuse-barcode-perl,
libpdf-reuse-perl,
libpdf-table-perl,
+ librdf-trine-perl,
libreadonly-perl,
libreadonly-xs-perl,
libscalar-list-utils-perl,
@@ -251,7 +254,9 @@ Depends: libalgorithm-checkdigits-perl,
libgd-gd2-noxpm-perl | libgd-gd2-perl,
libgraphics-magick-perl,
libgravatar-url-perl,
+ libhtml-entities-numbered-perl,
libhtml-format-perl,
+ libhtml-parser-perl,
libhtml-scrubber-perl,
libhttp-cookies-perl,
libhttp-message-perl,
@@ -285,6 +290,7 @@ Depends: libalgorithm-checkdigits-perl,
libpdf-reuse-barcode-perl,
libpdf-reuse-perl,
libpdf-table-perl,
+ librdf-trine-perl,
libreadonly-perl,
libreadonly-xs-perl,
libscalar-list-utils-perl,
--