From de868e37ae811701434d47fbad784b650ff542d0 Mon Sep 17 00:00:00 2001 From: Hector Castro Date: Tue, 24 Feb 2015 15:41:28 -0600 Subject: [PATCH] [Signed-off]Bug 13642 - Adding new features for Dublin Core metadata MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When Koha export a bibliographic record to DC, makes it in XML format. This XML is not well-formed document and do not follows the DC-XML recommendations as should be. 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 is not well formed 2) Apply patch. 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 and OAI-DC can be validated by other validator. Sponsored-by: Universidad de El Salvador Signed-off-by: Hector Castro XML::Entities not found in .deb package New patch for work with librdf-helper-perl (2.0) and librdf-trine-perl (1.000). RDF::Trine and RDF::Helper not need to be upgraded. Tested in both (upgraded and not upgraded) Fix some utf8 encoding. Tested with chinese records. http://bugs.koha-community.org/show_bug.cgi?id=13642 Followed test plan. Works as expected. (Changed title of commit message.) Signed-off-by: Marc VĂ©ron --- C4/Record.pm | 90 +- Koha/DublinCoreTransformer.pm | 942 ++++++++++++++++++++ catalogue/export.pl | 30 +- debian/control | 8 +- .../intranet-tmpl/prog/en/includes/cat-toolbar.inc | 2 +- .../prog/en/modules/catalogue/detail.tt | 130 ++- .../opac-tmpl/bootstrap/en/includes/masthead.inc | 64 ++ .../bootstrap/en/includes/opac-detail-sidebar.inc | 33 +- koha-tmpl/opac-tmpl/bootstrap/js/script.js | 69 +- opac/opac-export.pl | 30 +- 10 files changed, 1355 insertions(+), 43 deletions(-) create mode 100644 Koha/DublinCoreTransformer.pm diff --git a/C4/Record.pm b/C4/Record.pm index 16d3f54..1ae183e 100644 --- a/C4/Record.pm +++ b/C4/Record.pm @@ -25,7 +25,7 @@ use strict; # please specify in which methods a given module is used use MARC::Record; # marc2marcxml, marcxml2marc, changeEncoding use MARC::File::XML; # marc2marcxml, marcxml2marc, changeEncoding -use MARC::Crosswalk::DublinCore; # marc2dcxml +use Koha::DublinCoreTransformer; # marc2dcxml use Biblio::EndnoteStyle; use Unicode::Normalize; # _entity_encode use C4::Biblio; #marc2bibtex @@ -231,7 +231,8 @@ C<$qualified> - specify whether qualified Dublin Core should be used in the inpu =cut sub marc2dcxml { - my ($marc,$qualified) = @_; + my ( $type, $marc, $qualified, $entities, $root, $xsi_schemaLocation, $rdf_subject, + $rdf_format ) = @_; my $error; # test if it's already a MARC::Record object, if not, make it one my $marc_record_obj; @@ -245,24 +246,75 @@ sub marc2dcxml { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR; } } - my $crosswalk = MARC::Crosswalk::DublinCore->new; - if ($qualified) { - $crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 1 ); - } - my $dcxml = $crosswalk->as_dublincore($marc_record_obj); - my $dcxmlfinal = "\n"; - $dcxmlfinal .= ""; - - foreach my $element ( $dcxml->elements() ) { - $dcxmlfinal.="<"."dc:".$element->name().">".$element->content()."name().">\n"; + my $dcxml; + + SWITCH: + for ($type) { + if (/^simple-dc-rdf/) { + my $objectDC = Koha::DublinCoreTransformer->new({ + type => 'rdf', + qualified => 0, + get_marc_record => $marc, + }); + + $objectDC->get_rdf_data({ + rdf_subject => $rdf_subject, + rdf_format => $rdf_format, + entities => 1, + }); + $dcxml = $objectDC->write_rdf(); + last SWITCH; + } + if (/^dc-rdf/) { + my $objectDC = Koha::DublinCoreTransformer->new({ + type => 'rdf', + qualified => 1, + get_marc_record => $marc, + }); + + $objectDC->get_rdf_data({ + rdf_subject => $rdf_subject, + rdf_format => $rdf_format, + entities => 1, + }); + $dcxml = $objectDC->write_rdf(); + last SWITCH; + } + if (/^dc-xml/) { + my $objectDC = Koha::DublinCoreTransformer->new({ + type => 'xml', + qualified => $qualified, + get_marc_record => $marc, + }); + + $objectDC->get_xml_data({ + root => $root, + xsi_schemaLocation => $xsi_schemaLocation, + entities => 1, + }); + $dcxml = $objectDC->write_xml(); + last SWITCH; + } + if (/^oai-dc/) { + my $objectDC = Koha::DublinCoreTransformer->new({ + type => 'xml', + qualified => 0, + get_marc_record => $marc, + }); + + $objectDC->get_xml_data({ + root => 'oai_dc:dc', + xsi_schemaLocation => 'http://www.openarchives.org/OAI/2.0/oai_dc/' . + ' http://www.openarchives.org/OAI/2.0/oai_dc.xsd', + entities => 0, + optional_namespace => 'oai_dc', + namespace_url => 'http://www.openarchives.org/OAI/2.0/oai_dc/', + }); + $dcxml = $objectDC->write_xml(); + last SWITCH; + } } - $dcxmlfinal .= "\n"; - return ($error,$dcxmlfinal); + return ( $error, $dcxml ); } =head2 marc2modsxml - Convert from ISO-2709 to MODS diff --git a/Koha/DublinCoreTransformer.pm b/Koha/DublinCoreTransformer.pm new file mode 100644 index 0000000..9ca8ffb --- /dev/null +++ b/Koha/DublinCoreTransformer.pm @@ -0,0 +1,942 @@ +#!/usr/bin/perl +package Koha::DublinCoreTransformer; + +# +# This file is part of Koha. +# +# Copyright (C) 2014 Universidad de El Salvador, +# Facultad Multidisciplinaria Oriental +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . +# + +use Modern::Perl; +use strict; +use warnings::register; +use version; +use v5.10.1; + +BEGIN { + require Exporter; + + # set the version for version checking + our $VERSION = version->declare("v0.01"); + + # Inherit from Exporter to export functions and variables + our @ISA = qw(Exporter); + + # Functions and variables which are exported by default + our @EXPORT = qw(new get_xml_data get_rdf_data write_xml write_rdf); + + # Functions and variables which can be optionally exported + our @EXPORT_OK = + qw(type qualified get_marc_record root xsi_schemaLocation rdf_subject rdf_format entities optional_namespace namespace_url); + +} + +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 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) +); + +# Defining some constants +my $xsi_schema = qq(http://www.w3.org/2001/XMLSchema-instance); +my $unqualified = qq(http://purl.org/dc/elements/1.1/); +my $qualified = qq(http://purl.org/dc/terms/); +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/; + +#USAGE: Koha::DublinCoreTransformer->new({ +# type => 'xml|rdf', +# qualified => 0|1, +# get_marc_record => $record +#}); + +sub new { + my ( $class, $args ) = @_; + $args = {} unless defined $args; + return bless( $args, $class ); +} + +sub get_xml_data { + +#USAGE: oop->get_xml_data({ +# root => 'root', +# xsi_schemaLocation => 'http://example.org/myapp/ http://example.org/myapp/schema.xsd', +# entities => 0|1, +# optional_namespace => 'oai_dc' +# namespace_url => 'http://www.openarchives.org/OAI/2.0/oai_dc/' +#}); + my $self = shift; + my ($args) = @_; + + if (@_) { + $self->root( $args->{root} ); + $self->xsi_schemaLocation( $args->{xsi_schemaLocation} ); + $self->entities( $args->{entities} ); + $self->optional_namespace( $args->{optional_namespace} ); + $self->namespace_url( $args->{namespace_url} ); + } + + #if data not filled + $self->{root} = "metadata" unless ( defined $self->{root} ); + $self->{entities} = 0 unless ( defined $self->{entities} ); + my %dataxml = ( + xmlroot => $self->{root}, + entities => $self->{entities}, + optional_namespace => $self->{optional_namespace}, + namespace_url => $self->{namespace_url}, + ); + + if ( exists $self->{xsi_schemaLocation} ) { + $dataxml{'xsi_schemaLocation'} = $self->{xsi_schemaLocation}; + } + if ( exists $self->{xsi_schemaLocation} ) { + $dataxml{'optional_namespace'} = $self->{optional_namespace}; + } + if ( exists $self->{xsi_schemaLocation} ) { + $dataxml{'namespace_url'} = $self->{namespace_url}; + } + return \%dataxml; +} + +sub get_rdf_data { + +#USAGE: oop->get_rdf_data({ +# rdf_subject => 'http://opac.mydomain.edu/cgi-bin/koha/opac-detail.pl?biblionumber=17589', +# rdf_format => 'ntriples | nquads| rdfxml | rdfjson | ntriples-canonical | turtle', +# entities => 0|1, +#}) + + my $self = shift; + my ($args) = @_; + + if (@_) { + $self->rdf_subject( $args->{rdf_subject} ); + $self->rdf_format( $args->{rdf_format} ); + $self->entities( $args->{entities} ); + } + + #if data not filled + $self->{rdf_subject} = "http://koha-community.org/" + unless ( defined $self->{rdf_subject} ); + $self->{rdf_format} = "rdfxml" unless ( defined $self->{rdf_format} ); + $self->{entities} = 0 unless ( defined $self->{entities} ); + my %rdfdescription = ( + rdf_subject => $self->{rdf_subject}, + rdf_format => $self->{rdf_format}, + entities => $self->{entities}, + ); + + return \%rdfdescription; +} + +sub conversion_to_dc { + +#Get the MARC record and return a Dublin Core elements, passed as argument in dc_order_execution method. +#USAGE: +#my dc = $self->conversion_to_dc(); +#$self->dc_order_execution ($dc, $dcxml, $root); + my $self = shift; + my $marc_record_obj = $self->get_marc_record(); + my $crosswalk; + my $dc; + + #if data not filled + $self->qualified(0) unless ( exists $self->{qualified} ); + if ( ( $self->qualified() != 0 and $self->qualified() != 1 ) + && warnings::enabled($self) ) + { + warnings::warn( $self, "Only the 0 or 1 values are accepted" ); + die "Set qualified => " . $self->qualified() . " is no good, stopped"; + } + if ( $self->qualified() == 1 ) { + $crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 1 ); + } + elsif ( $self->qualified() == 0 ) { + $crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 0 ); + } + if ( $marc_record_obj =~ /^MARC::Record/ ) { + $dc = $crosswalk->as_dublincore($marc_record_obj); + } + else { + warnings::warn( $self, + "MARC::Record object failed or not a MARC::Record" ); + die "Stopped due get_marc_record => is not a MARC::Record"; + } + + return $dc; + +} + +sub write_xml { + my $self = shift; + my $dataxml = $self->get_xml_data(); + my $dc = $self->conversion_to_dc(); + + #Looking for bad data + if ( ( $self->type() ne 'xml' and $self->type() ne 'rdf' ) + && warnings::enabled($self) ) + { + warnings::warn( $self, "Only the xml or rdf values are accepted" ); + die "Set type => " . $self->type() . " is no good, stopped"; + } + elsif ( $self->type() eq 'rdf' && warnings::enabled($self) ) { + warnings::warn( $self, "The constructor specified rdf" ); + die "Cannot use this method with rdf. This is no good, stopped"; + } + + if ( ( $self->entities() != 0 and $self->entities() != 1 ) + && warnings::enabled($self) ) + { + warnings::warn( $self, "Only the 0 or 1 values are accepted" ); + die "Set entities => " . $self->entities() . " is no good, stopped"; + } + + #Creating XML object + my $doc = XML::LibXML::Document->new( '1.0', 'utf-8' ); + 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 ( $self->type() eq 'xml' ) { + if ( $self->qualified() == 0 ) { + if ( defined $dataxml->{'xsi_schemaLocation'} ) { + $root->setAttribute( + 'xsi:schemaLocation' => $dataxml->{'xsi_schemaLocation'} ); + $root->setNamespace( $unqualified, 'dc', 0 ); + $self->dc_order_execution( $dc, $doc, $root ); + } + else { + $root->setNamespace( $unqualified, 'dc', 0 ); + $self->dc_order_execution( $dc, $doc, $root ); + } + } + elsif ( $self->qualified() == 1 ) { + if ( defined $dataxml->{'xsi_schemaLocation'} ) { + $root->setAttribute( + 'xsi:schemaLocation' => $dataxml->{'xsi_schemaLocation'} ); + $root->setNamespace( $unqualified, 'dc', 0 ); + $root->setNamespace( $qualified, 'dcterms', 0 ); + $self->dc_order_execution( $dc, $doc, $root ); + } + else { + $root->setNamespace( $unqualified, 'dc', 0 ); + $root->setNamespace( $qualified, 'dcterms', 0 ); + $self->dc_order_execution( $dc, $doc, $root ); + } + } + } + + $doc->setDocumentElement($root); + + #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 ); + $serialized_data = $dcxml_entity_encoded; + return $serialized_data; + } + else { + return $doc->toString(1); + } +} + +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'}; + + #Looking for bad data + if ( ( $self->type() ne 'xml' and $self->type() ne 'rdf' ) + && warnings::enabled($self) ) + { + warnings::warn( $self, "Only the xml or rdf values are accepted" ); + die "Set type => " . $self->type() . " is no good, stopped"; + } + elsif ( $self->type() eq 'xml' && warnings::enabled($self) ) { + warnings::warn( $self, "The constructor specified xml" ); + die "Cannot use this method with xml. This is no good, stopped"; + } + + if ( ( $self->entities() != 0 and $self->entities() != 1 ) + && warnings::enabled($self) ) + { + warnings::warn( $self, "Only the 0 or 1 values are accepted" ); + die "Set entities => " . $self->entities() . " is no good, stopped"; + } + + if ( $self->qualified() == 0 ) { + + #Creating RDF::Helper object + $rdf = RDF::Helper->new( + BaseInterface => 'RDF::Trine', + namespaces => { + rdf => $rdfNS, + dc => $unqualified, + }, + ExpandQNames => 1, + base_uri => '', + ); + } + else { + $rdf = RDF::Helper->new( + BaseInterface => 'RDF::Trine', + namespaces => { + rdf => $rdfNS, + dcterms => $qualified, + dcam => $dcam, + }, + ExpandQNames => 1, + base_uri => '', + ); + } + + 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; + } + 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; + } + else { + return $rdf->serialize( format => $rdfdescription->{'rdf_format'} ); + } +} + +sub upper_or_lowercase { + +#This subroutine define if is necessary to convert lowercase some qualifiers or let them as crosswalk method basis +#USAGE: upper_or_lowercase (element->qualifier()) + my $dcelement = $_[0]; + my $count = 0; + my $result; + while ( $count <= $#elementupcase ) { + if ( $elementupcase[$count] eq $dcelement ) { + $result = $dcelement; + last; + } + elsif ( $dcelement ne $elementupcase[$count] ) { + $result = lc($dcelement); + $count++; + next; + } + } + + return $result; + +} + +sub XML_entity_encode { + +#This subroutine change characteres to XML entities. Since XML::LibXML only encode the five basics +#USAGE: This subroutine is called when get_xml_data is populated with entities => 1 + my @strings = @_; + my @strings_entity_encoded; + 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 ); + push @strings_entity_encoded, $xml_entities; + } + return @strings_entity_encoded; +} + +sub xml_constructor { + +#xml_constructor ( doc, root, namespace, attr, element_name, element_content, element_qualifier, element_scheme ) +#USAGE: define all posible elements (name, content, qualifier, scheme) as neccesary +#doc: the XML object +#root: append root to doc +#namespace: defined as "dc" or "dcterms" +#attr: a boolean value to determinate xsi:type xml namespace for dcterms +#examples: +#xml_constructor ( $dcxml, $root, "dc", 0, element->name(), element->content() ); +#xml_constructor ( $dcxml, $root, "dcterms", 1, element->name(), element->content(), $element->qualifier() ); + + my ( $doc, $root, $namespace, $attr, $element_name, $element_content, + $element_qualifier, $element_scheme ) + = @_; + + # This scalar is used for deleting spaces in scheme elements + my $deletespaces; + + # This scalar is used for making upper or lowercase the qualifier elements + my $lowercase; + my $tagxml; + + given ($namespace) { + when ( $namespace eq "dc" ) { + $lowercase = lc($element_name); + } + when ( $namespace eq "dcterms" ) { + $lowercase = upper_or_lowercase($element_qualifier); + + #replacing spacial to spatial, bug from dublin or crosswalk. + $lowercase =~ s/spacial/spatial/; + } + } + + if ( ( $namespace eq "dc" or "dcterms" ) and $attr == 0 ) { + + # This will do something like: Title + $tagxml = XML::LibXML::Element->new($lowercase); + $tagxml->setNamespace( undef, $namespace, 1 ); + $tagxml->appendTextNode($element_content); + $root->appendChild($tagxml); + } + elsif ( ( $namespace eq "dcterms" ) and $attr == 1 ) { + +# This will do something like: us + $deletespaces = $element_scheme; + $deletespaces =~ s/\s//; + $tagxml = XML::LibXML::Element->new($lowercase); + $tagxml->setNamespace( undef, $namespace, 1 ); + my $attribute = $namespace . ':' . $deletespaces; + $tagxml->setAttribute( 'xsi:type', $attribute ); + $tagxml->appendTextNode($element_content); + $root->appendChild($tagxml); + } + elsif ( ( $namespace eq "dc" ) and $attr == 1 ) { + given ($element_scheme) { + +# This will do something like: Water supply. + when ( $element_scheme ne "DCMI Type Vocabulary" ) + { #Dublin core returns DCMI Type Vocabulary + $deletespaces = $element_scheme; + $deletespaces =~ s/\s//; + $tagxml = XML::LibXML::Element->new($lowercase); + $tagxml->setNamespace( undef, $namespace, 1 ); + my $attribute = 'dcterms:' . $deletespaces; + $tagxml->setAttribute( 'xsi:type', $attribute ); + $tagxml->appendTextNode($element_content); + $root->appendChild($tagxml); + } + when ( $element_scheme eq "DCMI Type Vocabulary" ) + { #Changing for DCMIType + # This will do something like: Text + $tagxml = XML::LibXML::Element->new($lowercase); + $tagxml->setNamespace( undef, $namespace, 1 ); + $tagxml->setAttribute( 'xsi:type', 'dcterms:DCMIType' ); + $tagxml->appendTextNode($element_content); + $root->appendChild($tagxml); + } + } + } #if...elsif + + return $tagxml; + +} #subroutine + +sub rdf_constructor { + +#xml_constructor ( rdf, subject, namespace, attr, element_name, element_content, element_qualifier, element_scheme ) +#USAGE: define all posible elements (name, content, qualifier, scheme) as neccesary +#rdf: the RDF object +#subject: the subject for the triples +#namespace: defined as "dc" or "dcterms". This is for Simple DC or DC-RDF recommendations. +#attr: a boolean value to determine the nodeID attribute for dcterms + + my ( $rdf, $subject, $namespace, $attr, $element_name, $element_content, + $element_qualifier, $element_scheme ) + = @_; + + #This scalar is used for deleting spaces in scheme elements + my $deletespaces; + + #This scalar is used for making upper or lowercase the qualifier elements + my $lowercase; + + given ($namespace) { + when ( $namespace eq "dc" ) { + $lowercase = lc($element_name); + } + when ( $namespace eq "dcterms" ) { + $lowercase = upper_or_lowercase($element_qualifier); + + #replacing spacial to spatial, bug from dublin or crosswalk. + $lowercase =~ s/spacial/spatial/; + } + } + + 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 ); + } + 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 ); + } + elsif ( ( $namespace eq "dc" ) and $attr == 1 ) { + $deletespaces = $element_scheme; + $deletespaces =~ s/\s//; + my $predicate = 'dcterms:' . $lowercase; + my $object = $element_content; + 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 ); + 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 ); + 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 ); + 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 ); + 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 ); + last SWITCH; + } + } + } #if-elsif + return $rdf; +} #subroutine + +sub dc_order_execution { + + #USAGE: USAGE: Get the parameters for xml or rdf and execute in order. + my $self = shift; + + if ( $self->type() eq 'xml' ) { #Order for xml + my ( $dc, $dcxml, $root ) = @_; + foreach my $element ( $dc->elements() ) { + SWITCH: { + if ( $element->name() + and not defined $element->scheme() + and not defined $element->qualifier() ) + { + $dcxml = + xml_constructor( $dcxml, $root, "dc", 0, $element->name(), + $element->content() ); + last SWITCH; + } + + if ( $element->name() + and not defined $element->scheme() + and not defined $element->qualifier() ) + { + $dcxml = + xml_constructor( $dcxml, $root, "dcterms", 0, + $element->name(), $element->content() ); + last SWITCH; + } + + if ( $element->name() + and $element->scheme() + and $element->qualifier() ) + { + $dcxml = xml_constructor( + $dcxml, $root, + "dcterms", 1, + $element->name(), $element->content(), + $element->qualifier(), $element->scheme() + ); + last SWITCH; + } + + if ( $element->name() + and $element->scheme() + and ( $element->scheme ne "DCMI Type Vocabulary" ) ) + { + $dcxml = + xml_constructor( $dcxml, $root, "dc", 1, $element->name(), + $element->content(), $element->qualifier(), + $element->scheme() ); + last SWITCH; + } + + if ( $element->name() + and $element->scheme() + and ( $element->scheme() eq "DCMI Type Vocabulary" ) ) + { + $dcxml = + xml_constructor( $dcxml, $root, "dc", 1, $element->name(), + $element->content(), $element->qualifier(), + $element->scheme() ); + last SWITCH; + } + + if ( $element->name() and $element->qualifier() ) { + $dcxml = xml_constructor( + $dcxml, $root, + "dcterms", 0, + $element->name(), $element->content(), + $element->qualifier(), $element->scheme() + ); + last SWITCH; + } #if + } #SWITCH + } #foreach 1 + } + elsif ( $self->type() eq 'rdf' ) { #Order for rdf/xml + my ( $dc, $rdf, $subject ) = @_; + foreach my $element ( $dc->elements() ) { + SWITCH: { + if ( $element->name() + and not defined $element->scheme() + and not defined $element->qualifier() ) + { + rdf_constructor( $rdf, $subject, "dc", 0, $element->name(), + $element->content() ) + unless $self->qualified() == 1; + rdf_constructor( $rdf, $subject, "dc", 2, $element->name(), + $element->content() ) + unless $self->qualified() == 0; + last SWITCH; + } + + if ( $element->name() + and $element->scheme() + and ( $element->scheme ne "DCMI Type Vocabulary" ) ) + { + rdf_constructor( $rdf, $subject, "dc", 1, $element->name(), + $element->content(), $element->qualifier(), + $element->scheme() ); + last SWITCH; + } + + if ( $element->name() + and $element->scheme() + and ( $element->scheme() eq "DCMI Type Vocabulary" ) ) + { + rdf_constructor( $rdf, $subject, "dc", 1, $element->name(), + $element->content(), $element->qualifier(), + $element->scheme() ); + last SWITCH; + } + + if ( $element->name() and $element->qualifier() ) { + rdf_constructor( + $rdf, $subject, + "dcterms", 0, + $element->name(), $element->content(), + $element->qualifier(), $element->scheme() + ); + last SWITCH; + } #if + } #SWITCH + } #foreach 2 + } + return; +} + +END { + + #When opened with MARC::File::USMARC, close marc record if not closed + sub DESTROY { + my $self = shift; + if ( $self->{get_marc_record} =~ /^MARC:File::USMARC/ ) { + $self->{get_marc_record}->close(); + undef $self->{get_marc_record}; + } + } +} +1; +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Koha::DublinCoreTransformer - transform the values of MARC::Crosswalk::DublinCore +into metadata in XML or RDF format. + +=head1 SYNOPSIS + +=head2 XML-DC + + use Koha::DublinCoreTransformer; + use MARC::File::USMARC; + my $batch = MARC::File::USMARC->in('in.mrc'); + + ## the $record will be a MARC::Record object. + my $record = $batch->next(); + + #For Simple DC-XML + my $objectDC = DublinCoreTransformer->new({ + type => 'xml', + qualified => 0, + get_marc_record => $record}); + + #For Qualified DC-XML + my $objectDC = DublinCoreTransformer->new({ + type => 'xml', + qualified => 1, + get_marc_record => $record}); + + #After call constructor you need to pass the root element and + #the schema in .xsd format. If you prefer or you don't know nothing + #about it pass the method in blank, i.e., without arguments. + #Also you can determine if you want to encode with xml entities or + #just with the five basics entities. + #Set entities to 0 for the five basics or 1 to encode with the + #complete xml entities. + $objectDC->get_xml_data({ + root => 'metadata', + xsi_schemaLocation => 'http://example.org/myapp/ http://example.org/myapp/schema.xsd', + }); + #This print your xml file in STDOUT + my $XML-DC = $objectDC->write_xml(); + print $XML-DC; + + #Close the file according to MARC::File::USMARC + $batch->close(); + undef $batch; + + #Or if you want to generate a file + open (OUTPUT, '> dc2xml.xml') or die $!; + print OUTPUT $XML-DC; + close(OUTPUT); + +=head2 DC-RDF + + use Koha::DublinCoreTransformer; + use MARC::File::USMARC; + my $marc = MARC::File::USMARC->in('in.mrc'); + my $record = $marc->next(); + + #Simple DC-RDF is not used but not deprecated, DublinCoreTransformer + #can generate it as follow: + my $objectDC = DublinCoreTransformer->new({ + type => 'rdf', + qualified => 0, + get_marc_record => $record}); + + #DC-RDF + my $objectDC = DublinCoreTransformer->new({ + type => 'rdf', + qualified => 1, + get_marc_record => $record}); + + #The get_rdf_data method for RDF does not need to use the root element + #and the schema, but you need to declare the resource being described, + #i.e., the record. + #Note: For Koha is the IRI identifier of the record + $objectDC->get_rdf_data({ + rdf_subject => 'http://opac.mydomain.edu/cgi-bin/koha/opac-detail.pl?biblionumber=17589', + }); + + my $XML-RDF = $objectDC->write_rdf(); + print $XML-RDF; + #Close the file according to MARC::File::USMARC + $batch->close(); + undef $marc; + +=head1 DESCRIPTION + +The Koha::DublinCoreTransformer defines the interface to transform +and manipulate MARC records into DC-XML or DC-RDF recommendation. +This package transform MARC records to XML or RDF/XML Dublin Core +and follows the recommendations listed below: + +L + +L +This recommendation is superseded by DC-RDFrecommendation but not obsoleted at all. + +L + +=head2 Methods + +=over 12 + +=item C + +Return a new Koha::DublinCoreTransformer object. +This constructor sets the output type (RDF or XML), the level of the standard (Simple DC or Qualified DC) and the MARC record to be transformed to DC. + + my $objectDC = DublinCoreTransformer->new({ + type => 'rdf', + qualified => 0, + get_marc_record => $record}); + +=item C + +This method is just for DC-XML: Fetch the xml root element and the schema in .xsd format. + + $objectDC->get_xml_data({ + root => 'metadata', + xsi_schemaLocation => 'http://example.org/myapp/ http://example.org/myapp/schema.xsd', + entities => 1, + }); + +The entities argument is for extended xml entities, i.e., placing entities to zero will codify only the five basic entities e.g., <, >, ", &, and &apos. Conversely if it is encoded to one, all entities will coded into decimal. + +Additionally, has been included the optional_namespace and namespace_url arguments to include another XML name space. + +NOTE: This method is only for use of the DC-XML recommendation, i.e., type => 'xml'. +See C method or the section SYNOPSIS. + +=item C + +This method is only for DC-RDF: Fetch the IRI identifier of the resource being described. As well, you can pass the format you want to generate with the rdf, by default the DC-RDF specify RDF/XML but RDF can represent in other formats listed below: + +. ntriples + +. nquads + +. rdfxml + +. rdfjson + +. ntriples-canonical + +. turtle + + $objectDC->get_rdf_data({ + rdf_subject => 'http://opac.fmoues.edu.sv/cgi-bin/koha/opac-detail.pl?biblionumber=17589', + rdf_format => 'rdfxml', + entities => 0|1, + }); + +NOTE: The entities is needed only for rdfxml value and is used like C method. + +=item C + +Return the xml object as string. + +NOTE: This method is only for use of the DC-XML recommendation, i.e., type => 'xml'. +See C and C methods or the section SYNOPSIS. + +=item C + +Return the rdf object as string. + +NOTE: This method is only for use of the DC-RDF recommendation, i.e., type => 'rdf'. +See C and C methods or the section SYNOPSIS. + +=back + +=head1 VERSION + +version 0.01 + +=head1 RELATES MODULES + +This package requires the following modules: + +DublinCore::Record + +MARC::Record + +MARC::File::USMARC + +MARC::Crosswalk::DublinCore + +HTML::Entities + +XML::Entities + +XML::LibXML + +RDF::Helper + +=head2 SEE ALSO + +Dublin Core Web Page L. + +=head1 LICENSE + +Copyright (c) 2014 Koha Community. 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 + +Hector Eduardo Catro Avalos E hector.hecaxmmx at gmail dot com E +and the Koha Development Team. + +=cut + diff --git a/catalogue/export.pl b/catalogue/export.pl index e66d3f2..265ff1a 100755 --- a/catalogue/export.pl +++ b/catalogue/export.pl @@ -26,6 +26,12 @@ my $format=$query->param("format"); my $error = ''; if ($op eq "export") { my $biblionumber = $query->param("bib"); + my $recommendation = $query->param("recommendation"); + my $formats = $query->param("formats"); + my $qualifier = $query->param("qualifier"); + my $root_element = $query->param("root_element"); + my $xsischemalocation = $query->param("xsischemalocation"); + my $resource_url = $query->url(-base => 1) . '/cgi-bin/koha/catalogue/detail.pl?biblionumber=' . $biblionumber; if ($biblionumber){ my $marc = GetMarcBiblio($biblionumber, 1); @@ -51,8 +57,28 @@ if ($op eq "export") { $format = "bibtex"; } elsif ($format =~ /dc/) { - ($error,$marc) = marc2dcxml($marc,1); - $format = "dublin-core.xml"; + SWITCH: + for ($recommendation) { + if (/^simple-dc-rdf/) { + ($error,$marc) = marc2dcxml($recommendation, $marc, 0, + 1, undef, undef, $resource_url , $formats); + $format = "dublin-core." . $formats; + last SWITCH; } + if (/^dc-rdf/) { + ($error,$marc) = marc2dcxml($recommendation, $marc, 1, + 1, undef, undef, $resource_url, $formats); + $format = "dublin-core." . $formats; + last SWITCH; } + if (/^dc-xml/) { + ($error,$marc) = marc2dcxml($recommendation, $marc, $qualifier, + 1, $root_element, $xsischemalocation, undef, undef); + $format = "dublin-core.xml"; + last SWITCH; } + if (/^oai-dc/) { + ($error,$marc) = marc2dcxml($recommendation, $marc); + $format = "dublin-core.xml"; + last SWITCH; } + } } elsif ($format =~ /marc8/) { $marc = changeEncoding($marc,"MARC","MARC21","MARC-8"); diff --git a/debian/control b/debian/control index 96a6650..fa21ab8 100644 --- a/debian/control +++ b/debian/control @@ -47,7 +47,6 @@ Build-Depends: libalgorithm-checkdigits-perl, libdigest-sha-perl | perl, libemail-date-perl, libemail-valid-perl, - libfile-path-perl | perl-modules, libfile-slurp-perl, libfont-ttf-perl, libgd-barcode-perl, @@ -56,6 +55,8 @@ Build-Depends: libalgorithm-checkdigits-perl, libgravatar-url-perl, libhtml-format-perl, libhtml-scrubber-perl, + libhttp-cookies-perl, + libhttp-message-perl, libhttp-oai-perl, libjson-perl, liblibrary-callnumber-lc-perl, @@ -97,6 +98,7 @@ Build-Depends: libalgorithm-checkdigits-perl, libtemplate-plugin-htmltotext-perl, libtemplate-plugin-json-escape-perl, libtest-deep-perl, + libtest-harness-perl | perl-modules, libtest-mockmodule-perl, libtest-mockobject-perl, libtest-simple-perl | perl-modules, @@ -245,7 +247,6 @@ Depends: libalgorithm-checkdigits-perl, libdigest-sha-perl | perl, libemail-date-perl, libemail-valid-perl, - libfile-path-perl | perl-modules, libfile-slurp-perl, libfont-ttf-perl, libgd-barcode-perl, @@ -254,6 +255,8 @@ Depends: libalgorithm-checkdigits-perl, libgravatar-url-perl, libhtml-format-perl, libhtml-scrubber-perl, + libhttp-cookies-perl, + libhttp-message-perl, libhttp-oai-perl, libjson-perl, liblibrary-callnumber-lc-perl, @@ -295,6 +298,7 @@ Depends: libalgorithm-checkdigits-perl, libtemplate-plugin-htmltotext-perl, libtemplate-plugin-json-escape-perl, libtest-deep-perl, + libtest-harness-perl | perl-modules, libtest-mockmodule-perl, libtest-mockobject-perl, libtest-simple-perl | perl-modules, diff --git a/koha-tmpl/intranet-tmpl/prog/en/includes/cat-toolbar.inc b/koha-tmpl/intranet-tmpl/prog/en/includes/cat-toolbar.inc index 97da6c3..7c31074 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/includes/cat-toolbar.inc +++ b/koha-tmpl/intranet-tmpl/prog/en/includes/cat-toolbar.inc @@ -219,7 +219,7 @@ CAN_user_serials_create_subscription ) %]