From 831eac1652123c8f510b8388c4d1c2672e26511d Mon Sep 17 00:00:00 2001 From: Hector Castro Date: Thu, 5 Mar 2015 11:45:38 -0600 Subject: [PATCH] Bug 13642 [ENH] Adding new features for Dublin Core metadata #2 When Koha export a bibliographic record to DC, makes it in XML format. This XML not follows the DC-XML recommendations as should be: elements in uppercase eg. dc:Date, dc:Creator, section 4.2, recommendation 4 explain that "The property names for the 15 DC elements should be all lower-case." eg. dc:date, dc:creator" and section "4.3 Example - a simple DC record", xsi:schemaLocation="http://example.org/myapp/ http://example.org/myapp/schema.xsd" schema does not exist. The recommendation can be consulted at . This new feature, adds an ability to export Dublin Core metadata to XML and RDF (including rdfxml, rdfjson, ntriples, turtle, etc.) Test plan --------------- 1) Download Dublin Core file. Open up the file, and make sure that the document not follows the DC-XML recommendations as should be. 2) Apply patches. 3) Go to whichever bib record in OPAC or staff and click on Save > Dublin Core. A modal will display, prove all options. 4) Change the system preference 'Opac ExportOptions' by enabling and disabling Dublin Core and try to download a record in the OPAC. 5) Try several bibliographic records in any format (book, magazine, DVD, etc.) to confirm that properly exported. 6) RDF/XML can be validated per RDF Validator W3C. 7) DC-XML cannot valid if not exist a valid XSD schema. 8) OAI-DC can be validated using and the proper schema typed in text field for URL. --- C4/Installer/PerlDependencies.pm | 15 ++ C4/Record.pm | 20 ++- Koha/DublinCoreTransformer.pm | 298 ++++++++++++++++++++++++-------------- debian/control | 6 + 4 files changed, 225 insertions(+), 114 deletions(-) diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm index 96557e3..2db59a8 100644 --- a/C4/Installer/PerlDependencies.pm +++ b/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; diff --git a/C4/Record.pm b/C4/Record.pm index 1ae183e..bbbe75c 100644 --- a/C4/Record.pm +++ b/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 diff --git a/Koha/DublinCoreTransformer.pm b/Koha/DublinCoreTransformer.pm index d7a4f0a..76fb135 100644 --- a/Koha/DublinCoreTransformer.pm +++ b/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 + diff --git a/debian/control b/debian/control index 8520226..1011c43 100644 --- a/debian/control +++ b/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, -- 1.7.10.4