Line 0
Link Here
|
|
|
1 |
#!/usr/bin/perl |
2 |
package Koha::DublinCoreTransformer; |
3 |
|
4 |
# |
5 |
# This file is part of Koha. |
6 |
# |
7 |
# Copyright (C) 2014 Universidad de El Salvador, |
8 |
# Facultad Multidisciplinaria Oriental |
9 |
# |
10 |
# Koha is free software; you can redistribute it and/or modify it |
11 |
# under the terms of the GNU General Public License as published by |
12 |
# the Free Software Foundation; either version 3 of the License, or |
13 |
# (at your option) any later version. |
14 |
# |
15 |
# Koha is distributed in the hope that it will be useful, but |
16 |
# WITHOUT ANY WARRANTY; without even the implied warranty of |
17 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
18 |
# GNU General Public License for more details. |
19 |
# |
20 |
# You should have received a copy of the GNU General Public License |
21 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
22 |
# |
23 |
|
24 |
use Modern::Perl; |
25 |
use strict; |
26 |
use warnings::register; |
27 |
use utf8; |
28 |
use version; |
29 |
use v5.10.1; |
30 |
|
31 |
BEGIN { |
32 |
require Exporter; |
33 |
|
34 |
# set the version for version checking |
35 |
our $VERSION = version->declare("v0.01"); |
36 |
|
37 |
# Inherit from Exporter to export functions and variables |
38 |
our @ISA = qw(Exporter); |
39 |
|
40 |
# Functions and variables which are exported by default |
41 |
our @EXPORT = qw(new get_xml_data get_rdf_data write_xml write_rdf); |
42 |
|
43 |
# Functions and variables which can be optionally exported |
44 |
our @EXPORT_OK = |
45 |
qw(type qualified get_marc_record root xsi_schemaLocation rdf_subject rdf_format entities optional_namespace namespace_url); |
46 |
|
47 |
} |
48 |
|
49 |
use MARC::File::USMARC; |
50 |
use MARC::Crosswalk::DublinCore; |
51 |
use XML::LibXML; |
52 |
use HTML::Entities; |
53 |
use HTML::Entities::Numbered; |
54 |
use RDF::Trine; |
55 |
use base qw(Class::Accessor); |
56 |
__PACKAGE__->mk_accessors( |
57 |
qw(type qualified get_marc_record root xsi_schemaLocation rdf_subject rdf_format entities optional_namespace namespace_url) |
58 |
); |
59 |
|
60 |
# Defining some constants |
61 |
my $xsi_schema = qq(http://www.w3.org/2001/XMLSchema-instance); |
62 |
my $unqualified = qq(http://purl.org/dc/elements/1.1/); |
63 |
my $qualified = qq(http://purl.org/dc/terms/); |
64 |
my $dcam = qq(http://purl.org/dc/dcam/); |
65 |
my $rdfNS = qq(http://www.w3.org/1999/02/22-rdf-syntax-ns#); |
66 |
my @elementupcase = |
67 |
qw/tableOfContents dateAccepted dateCopyrighted dateSubmitted isVersionOf hasVersion isReplacedBy isRequiredBy isPartOf hasPart isReferencedBy isFormatOf hasFormat conformsTo accrualMethod accrualPeriodicity accrualPolicy instructionalMethod rightsHolder educationLevel accessRights bibliographicCitation/; |
68 |
my $map; |
69 |
|
70 |
#USAGE: Koha::DublinCoreTransformer->new({ |
71 |
# type => 'xml|rdf', |
72 |
# qualified => 0|1, |
73 |
# get_marc_record => $record |
74 |
#}); |
75 |
|
76 |
sub new { |
77 |
my ( $class, $args ) = @_; |
78 |
$args = {} unless defined $args; |
79 |
return bless( $args, $class ); |
80 |
} |
81 |
|
82 |
sub get_xml_data { |
83 |
|
84 |
#USAGE: oop->get_xml_data({ |
85 |
# root => 'root', |
86 |
# xsi_schemaLocation => 'http://example.org/myapp/ http://example.org/myapp/schema.xsd', |
87 |
# entities => 0|1, |
88 |
# optional_namespace => 'oai_dc' |
89 |
# namespace_url => 'http://www.openarchives.org/OAI/2.0/oai_dc/' |
90 |
#}); |
91 |
my $self = shift; |
92 |
my ($args) = @_; |
93 |
|
94 |
if (@_) { |
95 |
$self->root( $args->{root} ); |
96 |
$self->xsi_schemaLocation( $args->{xsi_schemaLocation} ); |
97 |
$self->entities( $args->{entities} ); |
98 |
$self->optional_namespace( $args->{optional_namespace} ); |
99 |
$self->namespace_url( $args->{namespace_url} ); |
100 |
} |
101 |
|
102 |
#if data not filled |
103 |
$self->{root} = "metadata" unless ( defined $self->{root} ); |
104 |
$self->{entities} = 0 unless ( defined $self->{entities} ); |
105 |
my %dataxml = ( |
106 |
xmlroot => $self->{root}, |
107 |
entities => $self->{entities}, |
108 |
optional_namespace => $self->{optional_namespace}, |
109 |
namespace_url => $self->{namespace_url}, |
110 |
); |
111 |
|
112 |
if ( exists $self->{xsi_schemaLocation} ) { |
113 |
$dataxml{'xsi_schemaLocation'} = $self->{xsi_schemaLocation}; |
114 |
} |
115 |
if ( exists $self->{xsi_schemaLocation} ) { |
116 |
$dataxml{'optional_namespace'} = $self->{optional_namespace}; |
117 |
} |
118 |
if ( exists $self->{xsi_schemaLocation} ) { |
119 |
$dataxml{'namespace_url'} = $self->{namespace_url}; |
120 |
} |
121 |
return \%dataxml; |
122 |
} |
123 |
|
124 |
sub get_rdf_data { |
125 |
|
126 |
#USAGE: oop->get_rdf_data({ |
127 |
# rdf_subject => 'http://opac.mydomain.edu/cgi-bin/koha/opac-detail.pl?biblionumber=17589', |
128 |
# rdf_format => 'ntriples | nquads| rdfxml | rdfjson | ntriples-canonical | turtle', |
129 |
# entities => 0|1, |
130 |
#}) |
131 |
|
132 |
my $self = shift; |
133 |
my ($args) = @_; |
134 |
|
135 |
if (@_) { |
136 |
$self->rdf_subject( $args->{rdf_subject} ); |
137 |
$self->rdf_format( $args->{rdf_format} ); |
138 |
$self->entities( $args->{entities} ); |
139 |
} |
140 |
|
141 |
#if data not filled |
142 |
$self->{rdf_subject} = "http://koha-community.org/" |
143 |
unless ( defined $self->{rdf_subject} ); |
144 |
$self->{rdf_format} = "rdfxml" unless ( defined $self->{rdf_format} ); |
145 |
$self->{entities} = 0 unless ( defined $self->{entities} ); |
146 |
my %rdfdescription = ( |
147 |
rdf_subject => $self->{rdf_subject}, |
148 |
rdf_format => $self->{rdf_format}, |
149 |
entities => $self->{entities}, |
150 |
); |
151 |
|
152 |
return \%rdfdescription; |
153 |
} |
154 |
|
155 |
sub conversion_to_dc { |
156 |
|
157 |
#Get the MARC record and return a Dublin Core elements, passed as argument in dc_order_execution method. |
158 |
#USAGE: |
159 |
#my dc = $self->conversion_to_dc(); |
160 |
#$self->dc_order_execution ($dc, $dcxml, $root); |
161 |
my $self = shift; |
162 |
my $marc_record_obj = $self->get_marc_record(); |
163 |
my $crosswalk; |
164 |
my $dc; |
165 |
|
166 |
#if data not filled |
167 |
$self->qualified(0) unless ( exists $self->{qualified} ); |
168 |
if ( ( $self->qualified() != 0 and $self->qualified() != 1 ) |
169 |
&& warnings::enabled($self) ) |
170 |
{ |
171 |
warnings::warn( $self, "Only the 0 or 1 values are accepted" ); |
172 |
die "Set qualified => " . $self->qualified() . " is no good, stopped"; |
173 |
} |
174 |
if ( $self->qualified() == 1 ) { |
175 |
$crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 1 ); |
176 |
} |
177 |
elsif ( $self->qualified() == 0 ) { |
178 |
$crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 0 ); |
179 |
} |
180 |
if ( $marc_record_obj =~ /^MARC::Record/ ) { |
181 |
$dc = $crosswalk->as_dublincore($marc_record_obj); |
182 |
} |
183 |
else { |
184 |
warnings::warn( $self, |
185 |
"MARC::Record object failed or not a MARC::Record" ); |
186 |
die "Stopped due get_marc_record => is not a MARC::Record"; |
187 |
} |
188 |
|
189 |
return $dc; |
190 |
|
191 |
} |
192 |
|
193 |
sub write_xml { |
194 |
my $self = shift; |
195 |
my $dataxml = $self->get_xml_data(); |
196 |
my $dc = $self->conversion_to_dc(); |
197 |
|
198 |
#Looking for bad data |
199 |
if ( ( $self->type() ne 'xml' and $self->type() ne 'rdf' ) |
200 |
&& warnings::enabled($self) ) |
201 |
{ |
202 |
warnings::warn( $self, "Only the xml or rdf values are accepted" ); |
203 |
die "Set type => " . $self->type() . " is no good, stopped"; |
204 |
} |
205 |
elsif ( $self->type() eq 'rdf' && warnings::enabled($self) ) { |
206 |
warnings::warn( $self, "The constructor specified rdf" ); |
207 |
die "Cannot use this method with rdf. This is no good, stopped"; |
208 |
} |
209 |
|
210 |
if ( ( $self->entities() != 0 and $self->entities() != 1 ) |
211 |
&& warnings::enabled($self) ) |
212 |
{ |
213 |
warnings::warn( $self, "Only the 0 or 1 values are accepted" ); |
214 |
die "Set entities => " . $self->entities() . " is no good, stopped"; |
215 |
} |
216 |
|
217 |
#Creating XML object |
218 |
my $doc = XML::LibXML::Document->new( '1.0', 'utf-8' ); |
219 |
my $root = $doc->createElement( $dataxml->{'xmlroot'} ); |
220 |
$root->setNamespace( $xsi_schema, 'xsi', 0 ); |
221 |
|
222 |
if ( defined $dataxml->{'optional_namespace'} ) { |
223 |
$root->setNamespace( $dataxml->{'namespace_url'}, |
224 |
$dataxml->{'optional_namespace'}, 0 ); |
225 |
} |
226 |
|
227 |
if ( $self->type() eq 'xml' ) { |
228 |
if ( $self->qualified() == 0 ) { |
229 |
if ( defined $dataxml->{'xsi_schemaLocation'} ) { |
230 |
$root->setAttribute( |
231 |
'xsi:schemaLocation' => $dataxml->{'xsi_schemaLocation'} ); |
232 |
$root->setNamespace( $unqualified, 'dc', 0 ); |
233 |
$self->dc_order_execution( $dc, $doc, $root ); |
234 |
} |
235 |
else { |
236 |
$root->setNamespace( $unqualified, 'dc', 0 ); |
237 |
$self->dc_order_execution( $dc, $doc, $root ); |
238 |
} |
239 |
} |
240 |
elsif ( $self->qualified() == 1 ) { |
241 |
if ( defined $dataxml->{'xsi_schemaLocation'} ) { |
242 |
$root->setAttribute( |
243 |
'xsi:schemaLocation' => $dataxml->{'xsi_schemaLocation'} ); |
244 |
$root->setNamespace( $unqualified, 'dc', 0 ); |
245 |
$root->setNamespace( $qualified, 'dcterms', 0 ); |
246 |
$self->dc_order_execution( $dc, $doc, $root ); |
247 |
} |
248 |
else { |
249 |
$root->setNamespace( $unqualified, 'dc', 0 ); |
250 |
$root->setNamespace( $qualified, 'dcterms', 0 ); |
251 |
$self->dc_order_execution( $dc, $doc, $root ); |
252 |
} |
253 |
} |
254 |
} |
255 |
|
256 |
$doc->setDocumentElement($root); |
257 |
|
258 |
#Enabling or desabling entities and print the xml |
259 |
if ( $dataxml->{'entities'} == 1 ) { |
260 |
my $serialized_data = $doc->toString(1); |
261 |
my ($dcxml_entity_encoded) = XML_entity_encode($serialized_data); |
262 |
$serialized_data = $dcxml_entity_encoded; |
263 |
return $serialized_data; |
264 |
} |
265 |
else { |
266 |
return $doc->toString(1); |
267 |
} |
268 |
} |
269 |
|
270 |
sub write_rdf { |
271 |
my $self = shift; |
272 |
my $rdfdescription = $self->get_rdf_data(); |
273 |
my $dc = $self->conversion_to_dc(); |
274 |
my $serializer; |
275 |
my %namespaces; |
276 |
|
277 |
#Looking for bad data |
278 |
if ( ( $self->type() ne 'xml' and $self->type() ne 'rdf' ) |
279 |
&& warnings::enabled($self) ) |
280 |
{ |
281 |
warnings::warn( $self, "Only the xml or rdf values are accepted" ); |
282 |
die "Set type => " . $self->type() . " is no good, stopped"; |
283 |
} |
284 |
elsif ( $self->type() eq 'xml' && warnings::enabled($self) ) { |
285 |
warnings::warn( $self, "The constructor specified xml" ); |
286 |
die "Cannot use this method with xml. This is no good, stopped"; |
287 |
} |
288 |
|
289 |
if ( ( $self->entities() != 0 and $self->entities() != 1 ) |
290 |
&& warnings::enabled($self) ) |
291 |
{ |
292 |
warnings::warn( $self, "Only the 0 or 1 values are accepted" ); |
293 |
die "Set entities => " . $self->entities() . " is no good, stopped"; |
294 |
} |
295 |
|
296 |
# Creating the triple store in temporary data |
297 |
my $store = RDF::Trine::Store::Memory->new(); |
298 |
|
299 |
# Creating the model |
300 |
my $rdf = RDF::Trine::Model->new($store); |
301 |
|
302 |
# Creating the subject |
303 |
my $subject = |
304 |
RDF::Trine::Node::Resource->new( $rdfdescription->{'rdf_subject'} ); |
305 |
|
306 |
$namespaces{'rdf'} = $rdfNS; |
307 |
|
308 |
if ( $self->qualified() == 0 ) { |
309 |
|
310 |
# Declaring all namespaces in a hash |
311 |
$namespaces{'dc'} = $unqualified; |
312 |
} |
313 |
else { |
314 |
|
315 |
# Declaring all namespaces in a hash |
316 |
$namespaces{'dcterms'} = $qualified; |
317 |
$namespaces{'dcam'} = $dcam; |
318 |
} |
319 |
|
320 |
# Creating namespaces |
321 |
$map = RDF::Trine::NamespaceMap->new( \%namespaces ); |
322 |
|
323 |
if ( $self->type() eq 'rdf' ) { |
324 |
$self->dc_order_execution( $dc, $rdf, $subject ); |
325 |
} |
326 |
|
327 |
#Enabling or desabling entities and print the xml, fixing encode with rdfjson |
328 |
if ( $rdfdescription->{'rdf_format'} eq 'rdfxml' ) { |
329 |
if ( $rdfdescription->{'entities'} == 1 ) { |
330 |
$serializer = |
331 |
RDF::Trine::Serializer::RDFXML->new( |
332 |
namespaces => {%namespaces} ); |
333 |
my $serialized_data = $serializer->serialize_model_to_string($rdf); |
334 |
my ($dcxml_entity_encoded) = XML_entity_encode($serialized_data); |
335 |
return $serialized_data = $dcxml_entity_encoded; |
336 |
} |
337 |
else { |
338 |
$serializer = |
339 |
RDF::Trine::Serializer::RDFXML->new( |
340 |
namespaces => {%namespaces} ); |
341 |
return $serializer->serialize_model_to_string($rdf); |
342 |
} |
343 |
} |
344 |
elsif ( $rdfdescription->{'rdf_format'} eq 'turtle' ) { |
345 |
$serializer = |
346 |
RDF::Trine::Serializer::Turtle->new( namespaces => {%namespaces} ); |
347 |
return $serializer->serialize_model_to_string($rdf); |
348 |
} |
349 |
else { |
350 |
$serializer = |
351 |
RDF::Trine::Serializer->new( $rdfdescription->{'rdf_format'} ); |
352 |
return $serializer->serialize_model_to_string($rdf); |
353 |
} |
354 |
} |
355 |
|
356 |
sub upper_or_lowercase { |
357 |
|
358 |
#This subroutine define if is necessary to convert lowercase some qualifiers or let them as crosswalk method basis |
359 |
#USAGE: upper_or_lowercase (element->qualifier()) |
360 |
my $dcelement = $_[0]; |
361 |
my $count = 0; |
362 |
my $result; |
363 |
while ( $count <= $#elementupcase ) { |
364 |
if ( $elementupcase[$count] eq $dcelement ) { |
365 |
$result = $dcelement; |
366 |
last; |
367 |
} |
368 |
elsif ( $dcelement ne $elementupcase[$count] ) { |
369 |
$result = lc($dcelement); |
370 |
$count++; |
371 |
next; |
372 |
} |
373 |
} |
374 |
|
375 |
return $result; |
376 |
|
377 |
} |
378 |
|
379 |
sub XML_entity_encode { |
380 |
|
381 |
#This subroutine change characteres to XML entities. Since XML::LibXML only encode the five basics |
382 |
#USAGE: This subroutine is called when get_xml_data is populated with entities => 1 |
383 |
my @strings = @_; |
384 |
my @strings_entity_encoded; |
385 |
foreach my $string (@strings) { |
386 |
utf8::decode($string); |
387 |
my $html_entities = |
388 |
HTML::Entities::encode_entities( $string, '^\n\t\x20-\x7e' ); |
389 |
my $xml_entities = |
390 |
HTML::Entities::Numbered::name2hex_xml($html_entities); |
391 |
push @strings_entity_encoded, $xml_entities; |
392 |
} |
393 |
return @strings_entity_encoded; |
394 |
} |
395 |
|
396 |
sub xml_constructor { |
397 |
|
398 |
#xml_constructor ( doc, root, namespace, attr, element_name, element_content, element_qualifier, element_scheme ) |
399 |
#USAGE: define all posible elements (name, content, qualifier, scheme) as neccesary |
400 |
#doc: the XML object |
401 |
#root: append root to doc |
402 |
#namespace: defined as "dc" or "dcterms" |
403 |
#attr: a boolean value to determinate xsi:type xml namespace for dcterms |
404 |
#examples: |
405 |
#xml_constructor ( $dcxml, $root, "dc", 0, element->name(), element->content() ); |
406 |
#xml_constructor ( $dcxml, $root, "dcterms", 1, element->name(), element->content(), $element->qualifier() ); |
407 |
|
408 |
my ( $doc, $root, $namespace, $attr, $element_name, $element_content, |
409 |
$element_qualifier, $element_scheme ) |
410 |
= @_; |
411 |
|
412 |
# This scalar is used for deleting spaces in scheme elements |
413 |
my $deletespaces; |
414 |
|
415 |
# This scalar is used for making upper or lowercase the qualifier elements |
416 |
my $lowercase; |
417 |
my $tagxml; |
418 |
|
419 |
given ($namespace) { |
420 |
when ( $namespace eq "dc" ) { |
421 |
$lowercase = lc($element_name); |
422 |
} |
423 |
when ( $namespace eq "dcterms" ) { |
424 |
$lowercase = upper_or_lowercase($element_qualifier); |
425 |
|
426 |
#replacing spacial to spatial, bug from dublin or crosswalk. |
427 |
$lowercase =~ s/spacial/spatial/; |
428 |
} |
429 |
} |
430 |
|
431 |
if ( ( $namespace eq "dc" or "dcterms" ) and $attr == 0 ) { |
432 |
|
433 |
# This will do something like: <dc:title>Title</dc:title> |
434 |
$tagxml = XML::LibXML::Element->new($lowercase); |
435 |
$tagxml->setNamespace( undef, $namespace, 1 ); |
436 |
$tagxml->appendTextNode($element_content); |
437 |
$root->appendChild($tagxml); |
438 |
} |
439 |
elsif ( ( $namespace eq "dcterms" ) and $attr == 1 ) { |
440 |
|
441 |
# This will do something like: <dcterms:spatial xsi:type="dcterms:ISO3166">us</dcterms:spatial> |
442 |
$deletespaces = $element_scheme; |
443 |
$deletespaces =~ s/\s//; |
444 |
$tagxml = XML::LibXML::Element->new($lowercase); |
445 |
$tagxml->setNamespace( undef, $namespace, 1 ); |
446 |
my $attribute = $namespace . ':' . $deletespaces; |
447 |
$tagxml->setAttribute( 'xsi:type', $attribute ); |
448 |
$tagxml->appendTextNode($element_content); |
449 |
$root->appendChild($tagxml); |
450 |
} |
451 |
elsif ( ( $namespace eq "dc" ) and $attr == 1 ) { |
452 |
given ($element_scheme) { |
453 |
|
454 |
# This will do something like: <dc:subject xsi:type="dcterms:LCSH">Water supply.</dc:subject> |
455 |
when ( $element_scheme ne "DCMI Type Vocabulary" ) |
456 |
{ #Dublin core returns DCMI Type Vocabulary |
457 |
$deletespaces = $element_scheme; |
458 |
$deletespaces =~ s/\s//; |
459 |
$tagxml = XML::LibXML::Element->new($lowercase); |
460 |
$tagxml->setNamespace( undef, $namespace, 1 ); |
461 |
my $attribute = 'dcterms:' . $deletespaces; |
462 |
$tagxml->setAttribute( 'xsi:type', $attribute ); |
463 |
$tagxml->appendTextNode($element_content); |
464 |
$root->appendChild($tagxml); |
465 |
} |
466 |
when ( $element_scheme eq "DCMI Type Vocabulary" ) |
467 |
{ #Changing for DCMIType |
468 |
# This will do something like: <dc:type xsi:type="dcterms:DCMIType">Text</dc:type> |
469 |
$tagxml = XML::LibXML::Element->new($lowercase); |
470 |
$tagxml->setNamespace( undef, $namespace, 1 ); |
471 |
$tagxml->setAttribute( 'xsi:type', 'dcterms:DCMIType' ); |
472 |
$tagxml->appendTextNode($element_content); |
473 |
$root->appendChild($tagxml); |
474 |
} |
475 |
} |
476 |
} #if...elsif |
477 |
|
478 |
return $tagxml; |
479 |
|
480 |
} #subroutine |
481 |
|
482 |
sub rdf_constructor { |
483 |
|
484 |
#xml_constructor ( rdf, subject, namespace, attr, element_name, element_content, element_qualifier, element_scheme ) |
485 |
#USAGE: define all posible elements (name, content, qualifier, scheme) as neccesary |
486 |
#rdf: the RDF object |
487 |
#subject: the subject for the triples |
488 |
#namespace: defined as "dc" or "dcterms". This is for Simple DC or DC-RDF recommendations. |
489 |
#attr: a boolean value to determine the nodeID attribute for dcterms |
490 |
|
491 |
my ( $rdf, $subject, $namespace, $attr, $element_name, $element_content, |
492 |
$element_qualifier, $element_scheme ) |
493 |
= @_; |
494 |
|
495 |
#This scalar is used for deleting spaces in scheme elements |
496 |
my $deletespaces; |
497 |
|
498 |
#This scalar is used for making upper or lowercase the qualifier elements |
499 |
my $lowercase; |
500 |
|
501 |
given ($namespace) { |
502 |
when ( $namespace eq "dc" ) { |
503 |
$lowercase = lc($element_name); |
504 |
} |
505 |
when ( $namespace eq "dcterms" ) { |
506 |
$lowercase = upper_or_lowercase($element_qualifier); |
507 |
|
508 |
#replacing spacial to spatial, bug from dublin or crosswalk. |
509 |
$lowercase =~ s/spacial/spatial/; |
510 |
} |
511 |
} |
512 |
|
513 |
if ( ( $namespace eq "dc" or "dcterms" ) and $attr == 0 ) { |
514 |
|
515 |
# This will do something like: <dc:title>Title</dc:title> |
516 |
my $predicate = undef; |
517 |
if ( $namespace eq "dc" ) { |
518 |
$predicate = $map->dc($lowercase); |
519 |
} |
520 |
else { |
521 |
$predicate = $map->dcterms($lowercase); |
522 |
} |
523 |
my $object = RDF::Trine::Node::Literal->new($element_content); |
524 |
my $statement = |
525 |
RDF::Trine::Statement->new( $subject, $predicate, $object ); |
526 |
$rdf->add_statement($statement); |
527 |
} |
528 |
elsif ( ( $namespace eq "dc" ) and $attr == 2 ) { |
529 |
|
530 |
# This will do something like: <dcterms:title>Title</dcterms:title> |
531 |
my $predicate = $map->dcterms($lowercase); |
532 |
my $object = RDF::Trine::Node::Literal->new($element_content); |
533 |
my $statement = |
534 |
RDF::Trine::Statement->new( $subject, $predicate, $object ); |
535 |
$rdf->add_statement($statement); |
536 |
} |
537 |
elsif ( ( $namespace eq "dc" ) and $attr == 1 ) { |
538 |
$deletespaces = $element_scheme; |
539 |
$deletespaces =~ s/\s//; |
540 |
SWITCH: |
541 |
for ($element_scheme) { |
542 |
if (/^ISO 3166/) { |
543 |
|
544 |
# Dublin core returns DCMI Type Vocabulary |
545 |
# This will do something like: |
546 |
# <rdf:Description rdf:nodeID="country"> |
547 |
# <dcam:memberOf rdf:resource="http://purl.org/dc/terms/ISO3166"/> |
548 |
# <rdf:value>us</rdf:value> |
549 |
# </rdf:Description> |
550 |
# <dcterms:spatial rdf:nodeID="country"/> |
551 |
my $objectbnode = RDF::Trine::Node::Blank->new('country'); |
552 |
my $predicate = $map->dcterms($lowercase); |
553 |
my $object = RDF::Trine::Node::Literal->new($element_content); |
554 |
my $dcam_member_of = $map->dcam('memberOf'); |
555 |
my $resource_schema = $map->dcterms($deletespaces); |
556 |
my $rdf_value = $map->rdf('value'); |
557 |
my $statement1 = |
558 |
RDF::Trine::Statement->new( $subject, $predicate, |
559 |
$objectbnode ); |
560 |
my $statement2 = |
561 |
RDF::Trine::Statement->new( $objectbnode, $dcam_member_of, |
562 |
$resource_schema ); |
563 |
my $statement3 = |
564 |
RDF::Trine::Statement->new( $objectbnode, $rdf_value, |
565 |
$object ); |
566 |
$rdf->add_statement($statement1); |
567 |
$rdf->add_statement($statement2); |
568 |
$rdf->add_statement($statement3); |
569 |
last SWITCH; |
570 |
} |
571 |
if (/^DCMI Type Vocabulary/) { #Changing for DCMIType |
572 |
my $objectbnode = RDF::Trine::Node::Blank->new('DCMIType'); |
573 |
my $predicate = $map->dcterms($lowercase); |
574 |
my $object = RDF::Trine::Node::Literal->new($element_content); |
575 |
my $dcam_member_of = $map->dcam('memberOf'); |
576 |
my $resource_schema = $map->dcterms('DCMIType'); |
577 |
my $rdf_value = $map->rdf('value'); |
578 |
my $statement1 = |
579 |
RDF::Trine::Statement->new( $subject, $predicate, |
580 |
$objectbnode ); |
581 |
my $statement2 = |
582 |
RDF::Trine::Statement->new( $objectbnode, $dcam_member_of, |
583 |
$resource_schema ); |
584 |
my $statement3 = |
585 |
RDF::Trine::Statement->new( $objectbnode, $rdf_value, |
586 |
$object ); |
587 |
$rdf->add_statement($statement1); |
588 |
$rdf->add_statement($statement2); |
589 |
$rdf->add_statement($statement3); |
590 |
last SWITCH; |
591 |
} |
592 |
if (/^ISO 639-2/) { #Changing bnodeId ISO639-2 for language |
593 |
my $objectbnode = RDF::Trine::Node::Blank->new('language'); |
594 |
my $predicate = $map->dcterms($lowercase); |
595 |
my $object = RDF::Trine::Node::Literal->new($element_content); |
596 |
my $dcam_member_of = $map->dcam('memberOf'); |
597 |
my $resource_schema = $map->dcterms($deletespaces); |
598 |
my $rdf_value = $map->rdf('value'); |
599 |
my $statement1 = |
600 |
RDF::Trine::Statement->new( $subject, $predicate, |
601 |
$objectbnode ); |
602 |
my $statement2 = |
603 |
RDF::Trine::Statement->new( $objectbnode, $dcam_member_of, |
604 |
$resource_schema ); |
605 |
my $statement3 = |
606 |
RDF::Trine::Statement->new( $objectbnode, $rdf_value, |
607 |
$object ); |
608 |
$rdf->add_statement($statement1); |
609 |
$rdf->add_statement($statement2); |
610 |
$rdf->add_statement($statement3); |
611 |
last SWITCH; |
612 |
} |
613 |
if (/^RFC 1766/) { #Changing bnodeId RFC1766 for languagetag |
614 |
my $objectbnode = RDF::Trine::Node::Blank->new('languagetag'); |
615 |
my $predicate = $map->dcterms($lowercase); |
616 |
my $object = RDF::Trine::Node::Literal->new($element_content); |
617 |
my $dcam_member_of = $map->dcam('memberOf'); |
618 |
my $resource_schema = $map->dcterms($deletespaces); |
619 |
my $rdf_value = $map->rdf('value'); |
620 |
my $statement1 = |
621 |
RDF::Trine::Statement->new( $subject, $predicate, |
622 |
$objectbnode ); |
623 |
my $statement2 = |
624 |
RDF::Trine::Statement->new( $objectbnode, $dcam_member_of, |
625 |
$resource_schema ); |
626 |
my $statement3 = |
627 |
RDF::Trine::Statement->new( $objectbnode, $rdf_value, |
628 |
$object ); |
629 |
$rdf->add_statement($statement1); |
630 |
$rdf->add_statement($statement2); |
631 |
$rdf->add_statement($statement3); |
632 |
last SWITCH; |
633 |
} |
634 |
if ( /^LCSH/ || /^MeSH/ || /^LCC/ || /^DDC/ || |
635 |
/^UDC/ || /^IMT/ || /^URI/ || /^TGN/ ) |
636 |
{ #Scheme sharing common elements |
637 |
my $objectbnode = RDF::Trine::Node::Blank->new($deletespaces); |
638 |
my $predicate = $map->dcterms($lowercase); |
639 |
my $object = RDF::Trine::Node::Literal->new($element_content); |
640 |
my $dcam_member_of = $map->dcam('memberOf'); |
641 |
my $resource_schema = $map->dcterms($deletespaces); |
642 |
my $rdf_value = $map->rdf('value'); |
643 |
my $statement1 = |
644 |
RDF::Trine::Statement->new( $subject, $predicate, |
645 |
$objectbnode ); |
646 |
my $statement2 = |
647 |
RDF::Trine::Statement->new( $objectbnode, $dcam_member_of, |
648 |
$resource_schema ); |
649 |
my $statement3 = |
650 |
RDF::Trine::Statement->new( $objectbnode, $rdf_value, |
651 |
$object ); |
652 |
$rdf->add_statement($statement1); |
653 |
$rdf->add_statement($statement2); |
654 |
$rdf->add_statement($statement3); |
655 |
last SWITCH; |
656 |
} |
657 |
} |
658 |
} #if-elsif |
659 |
return $rdf; |
660 |
} #subroutine |
661 |
|
662 |
sub dc_order_execution { |
663 |
|
664 |
#USAGE: USAGE: Get the parameters for xml or rdf and execute in order. |
665 |
my $self = shift; |
666 |
|
667 |
if ( $self->type() eq 'xml' ) { #Order for xml |
668 |
my ( $dc, $dcxml, $root ) = @_; |
669 |
foreach my $element ( $dc->elements() ) { |
670 |
SWITCH: { |
671 |
if ( $element->name() |
672 |
and not defined $element->scheme() |
673 |
and not defined $element->qualifier() ) |
674 |
{ |
675 |
$dcxml = |
676 |
xml_constructor( $dcxml, $root, "dc", 0, $element->name(), |
677 |
$element->content() ); |
678 |
last SWITCH; |
679 |
} |
680 |
|
681 |
if ( $element->name() |
682 |
and not defined $element->scheme() |
683 |
and not defined $element->qualifier() ) |
684 |
{ |
685 |
$dcxml = |
686 |
xml_constructor( $dcxml, $root, "dcterms", 0, |
687 |
$element->name(), $element->content() ); |
688 |
last SWITCH; |
689 |
} |
690 |
|
691 |
if ( $element->name() |
692 |
and $element->scheme() |
693 |
and $element->qualifier() ) |
694 |
{ |
695 |
$dcxml = xml_constructor( |
696 |
$dcxml, $root, |
697 |
"dcterms", 1, |
698 |
$element->name(), $element->content(), |
699 |
$element->qualifier(), $element->scheme() |
700 |
); |
701 |
last SWITCH; |
702 |
} |
703 |
|
704 |
if ( $element->name() |
705 |
and $element->scheme() |
706 |
and ( $element->scheme ne "DCMI Type Vocabulary" ) ) |
707 |
{ |
708 |
$dcxml = |
709 |
xml_constructor( $dcxml, $root, "dc", 1, $element->name(), |
710 |
$element->content(), $element->qualifier(), |
711 |
$element->scheme() ); |
712 |
last SWITCH; |
713 |
} |
714 |
|
715 |
if ( $element->name() |
716 |
and $element->scheme() |
717 |
and ( $element->scheme() eq "DCMI Type Vocabulary" ) ) |
718 |
{ |
719 |
$dcxml = |
720 |
xml_constructor( $dcxml, $root, "dc", 1, $element->name(), |
721 |
$element->content(), $element->qualifier(), |
722 |
$element->scheme() ); |
723 |
last SWITCH; |
724 |
} |
725 |
|
726 |
if ( $element->name() and $element->qualifier() ) { |
727 |
$dcxml = xml_constructor( |
728 |
$dcxml, $root, |
729 |
"dcterms", 0, |
730 |
$element->name(), $element->content(), |
731 |
$element->qualifier(), $element->scheme() |
732 |
); |
733 |
last SWITCH; |
734 |
} #if |
735 |
} #SWITCH |
736 |
} #foreach 1 |
737 |
} |
738 |
elsif ( $self->type() eq 'rdf' ) { #Order for rdf/xml |
739 |
my ( $dc, $rdf, $subject ) = @_; |
740 |
foreach my $element ( $dc->elements() ) { |
741 |
SWITCH: { |
742 |
if ( $element->name() |
743 |
and not defined $element->scheme() |
744 |
and not defined $element->qualifier() ) |
745 |
{ |
746 |
rdf_constructor( $rdf, $subject, "dc", 0, $element->name(), |
747 |
$element->content() ) |
748 |
unless $self->qualified() == 1; |
749 |
rdf_constructor( $rdf, $subject, "dc", 2, $element->name(), |
750 |
$element->content() ) |
751 |
unless $self->qualified() == 0; |
752 |
last SWITCH; |
753 |
} |
754 |
|
755 |
if ( $element->name() |
756 |
and $element->scheme() |
757 |
and ( $element->scheme ne "DCMI Type Vocabulary" ) ) |
758 |
{ |
759 |
rdf_constructor( $rdf, $subject, "dc", 1, $element->name(), |
760 |
$element->content(), $element->qualifier(), |
761 |
$element->scheme() ); |
762 |
last SWITCH; |
763 |
} |
764 |
|
765 |
if ( $element->name() |
766 |
and $element->scheme() |
767 |
and ( $element->scheme() eq "DCMI Type Vocabulary" ) ) |
768 |
{ |
769 |
rdf_constructor( $rdf, $subject, "dc", 1, $element->name(), |
770 |
$element->content(), $element->qualifier(), |
771 |
$element->scheme() ); |
772 |
last SWITCH; |
773 |
} |
774 |
|
775 |
if ( $element->name() and $element->qualifier() ) { |
776 |
rdf_constructor( |
777 |
$rdf, $subject, |
778 |
"dcterms", 0, |
779 |
$element->name(), $element->content(), |
780 |
$element->qualifier(), $element->scheme() |
781 |
); |
782 |
last SWITCH; |
783 |
} #if |
784 |
} #SWITCH |
785 |
} #foreach 2 |
786 |
} |
787 |
return; |
788 |
} |
789 |
|
790 |
END { |
791 |
|
792 |
#When opened with MARC::File::USMARC, close marc record if not closed |
793 |
sub DESTROY { |
794 |
my $self = shift; |
795 |
if ( $self->{get_marc_record} =~ /^MARC:File::USMARC/ ) { |
796 |
$self->{get_marc_record}->close(); |
797 |
undef $self->{get_marc_record}; |
798 |
} |
799 |
} |
800 |
} |
801 |
1; |
802 |
__END__ |
803 |
|
804 |
=pod |
805 |
|
806 |
=encoding UTF-8 |
807 |
|
808 |
=head1 NAME |
809 |
|
810 |
Koha::DublinCoreTransformer - transform the values of MARC::Crosswalk::DublinCore |
811 |
into metadata in XML or RDF format. |
812 |
|
813 |
=head1 SYNOPSIS |
814 |
|
815 |
=head2 XML-DC |
816 |
|
817 |
use Koha::DublinCoreTransformer; |
818 |
use MARC::File::USMARC; |
819 |
my $batch = MARC::File::USMARC->in('in.mrc'); |
820 |
|
821 |
## the $record will be a MARC::Record object. |
822 |
my $record = $batch->next(); |
823 |
|
824 |
#For Simple DC-XML |
825 |
my $objectDC = DublinCoreTransformer->new({ |
826 |
type => 'xml', |
827 |
qualified => 0, |
828 |
get_marc_record => $record}); |
829 |
|
830 |
#For Qualified DC-XML |
831 |
my $objectDC = DublinCoreTransformer->new({ |
832 |
type => 'xml', |
833 |
qualified => 1, |
834 |
get_marc_record => $record}); |
835 |
|
836 |
#After call constructor you need to pass the root element and |
837 |
#the schema in .xsd format. If you prefer or you don't know nothing |
838 |
#about it pass the method in blank, i.e., without arguments. |
839 |
#Also you can determine if you want to encode with xml entities or |
840 |
#just with the five basics entities. |
841 |
#Set entities to 0 for the five basics or 1 to encode with the |
842 |
#complete xml entities. |
843 |
$objectDC->get_xml_data({ |
844 |
root => 'metadata', |
845 |
xsi_schemaLocation => 'http://example.org/myapp/ http://example.org/myapp/schema.xsd', |
846 |
}); |
847 |
#This print your xml file in STDOUT |
848 |
my $XML-DC = $objectDC->write_xml(); |
849 |
print $XML-DC; |
850 |
|
851 |
#Close the file according to MARC::File::USMARC |
852 |
$batch->close(); |
853 |
undef $batch; |
854 |
|
855 |
#Or if you want to generate a file |
856 |
open (OUTPUT, '> dc2xml.xml') or die $!; |
857 |
print OUTPUT $XML-DC; |
858 |
close(OUTPUT); |
859 |
|
860 |
=head2 DC-RDF |
861 |
|
862 |
use Koha::DublinCoreTransformer; |
863 |
use MARC::File::USMARC; |
864 |
my $marc = MARC::File::USMARC->in('in.mrc'); |
865 |
my $record = $marc->next(); |
866 |
|
867 |
#Simple DC-RDF is not used but not deprecated, DublinCoreTransformer |
868 |
#can generate it as follow: |
869 |
my $objectDC = DublinCoreTransformer->new({ |
870 |
type => 'rdf', |
871 |
qualified => 0, |
872 |
get_marc_record => $record}); |
873 |
|
874 |
#DC-RDF |
875 |
my $objectDC = DublinCoreTransformer->new({ |
876 |
type => 'rdf', |
877 |
qualified => 1, |
878 |
get_marc_record => $record}); |
879 |
|
880 |
#The get_rdf_data method for RDF does not need to use the root element |
881 |
#and the schema, but you need to declare the resource being described, |
882 |
#i.e., the record. |
883 |
#Note: For Koha is the IRI identifier of the record |
884 |
$objectDC->get_rdf_data({ |
885 |
rdf_subject => 'http://opac.mydomain.edu/cgi-bin/koha/opac-detail.pl?biblionumber=17589', |
886 |
}); |
887 |
|
888 |
my $XML-RDF = $objectDC->write_rdf(); |
889 |
print $XML-RDF; |
890 |
#Close the file according to MARC::File::USMARC |
891 |
$batch->close(); |
892 |
undef $marc; |
893 |
|
894 |
=head1 DESCRIPTION |
895 |
|
896 |
The Koha::DublinCoreTransformer defines the interface to transform |
897 |
and manipulate MARC records into DC-XML or DC-RDF recommendation. |
898 |
This package transform MARC records to XML or RDF/XML Dublin Core |
899 |
and follows the recommendations listed below: |
900 |
|
901 |
L<DC-XML-GUIDELINES [DCMI Recommendation]|http://dublincore.org/documents/dc-xml-guidelines/> |
902 |
|
903 |
L<Expressing Simple Dublin Core in RDF-XML|http://dublincore.org/documents/dcmes-xml/> |
904 |
This recommendation is superseded by DC-RDFrecommendation but not obsoleted at all. |
905 |
|
906 |
L<DC-RDF [DCMI Recommendation]|http://dublincore.org/documents/dc-rdf/> |
907 |
|
908 |
=head2 Methods |
909 |
|
910 |
=over 12 |
911 |
|
912 |
=item C<new> |
913 |
|
914 |
Return a new Koha::DublinCoreTransformer object. |
915 |
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. |
916 |
|
917 |
my $objectDC = DublinCoreTransformer->new({ |
918 |
type => 'rdf', |
919 |
qualified => 0, |
920 |
get_marc_record => $record}); |
921 |
|
922 |
=item C<get_xml_data> |
923 |
|
924 |
This method is just for DC-XML: Fetch the xml root element and the schema in .xsd format. |
925 |
|
926 |
$objectDC->get_xml_data({ |
927 |
root => 'metadata', |
928 |
xsi_schemaLocation => 'http://example.org/myapp/ http://example.org/myapp/schema.xsd', |
929 |
entities => 1, |
930 |
}); |
931 |
|
932 |
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. |
933 |
|
934 |
Additionally, has been included the optional_namespace and namespace_url arguments to include another XML name space. |
935 |
|
936 |
NOTE: This method is only for use of the DC-XML recommendation, i.e., type => 'xml'. |
937 |
See C<new> method or the section SYNOPSIS. |
938 |
|
939 |
=item C<get_rdf_data> |
940 |
|
941 |
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: |
942 |
|
943 |
. ntriples |
944 |
|
945 |
. nquads |
946 |
|
947 |
. rdfxml |
948 |
|
949 |
. rdfjson |
950 |
|
951 |
. ntriples-canonical |
952 |
|
953 |
. turtle |
954 |
|
955 |
$objectDC->get_rdf_data({ |
956 |
rdf_subject => 'http://opac.fmoues.edu.sv/cgi-bin/koha/opac-detail.pl?biblionumber=17589', |
957 |
rdf_format => 'rdfxml', |
958 |
entities => 0|1, |
959 |
}); |
960 |
|
961 |
NOTE: The entities is needed only for rdfxml value and is used like C<get_xml_data> method. |
962 |
|
963 |
=item C<write_xml> |
964 |
|
965 |
Return the xml object as string. |
966 |
|
967 |
NOTE: This method is only for use of the DC-XML recommendation, i.e., type => 'xml'. |
968 |
See C<new> and C<get_xml_data> methods or the section SYNOPSIS. |
969 |
|
970 |
=item C<write_rdf> |
971 |
|
972 |
Return the rdf object as string. |
973 |
|
974 |
NOTE: This method is only for use of the DC-RDF recommendation, i.e., type => 'rdf'. |
975 |
See C<new> and C<get_rdf_data> methods or the section SYNOPSIS. |
976 |
|
977 |
=back |
978 |
|
979 |
=head1 VERSION |
980 |
|
981 |
version 0.01 |
982 |
|
983 |
=head1 RELATES MODULES |
984 |
|
985 |
This package requires the following modules: |
986 |
|
987 |
L<DublinCore::Record> |
988 |
|
989 |
L<MARC::Record> |
990 |
|
991 |
L<MARC::File::USMARC> |
992 |
|
993 |
L<MARC::Crosswalk::DublinCore> |
994 |
|
995 |
L<HTML::Entities> |
996 |
|
997 |
L<HTML::Entities::Numbered> |
998 |
|
999 |
L<XML::LibXML> |
1000 |
|
1001 |
L<RDF::Trine> |
1002 |
|
1003 |
=head2 SEE ALSO |
1004 |
|
1005 |
Dublin Core Web Page L<http://dublincore.org>. |
1006 |
|
1007 |
=head1 LICENSE |
1008 |
|
1009 |
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. |
1010 |
|
1011 |
=head1 AUTHOR |
1012 |
|
1013 |
Hector Eduardo Catro Avalos E<lt> hector.hecaxmmx at gmail dot com E<gt> |
1014 |
and the Koha Development Team. |
1015 |
|
1016 |
=cut |
1017 |
|