View | Details | Raw Unified | Return to bug 13642
Collapse All | Expand All

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

Return to bug 13642