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

(-)a/C4/Installer/PerlDependencies.pm (+20 lines)
Lines 737-742 our $PERL_DEPS = { Link Here
737
        'required' => '0',
737
        'required' => '0',
738
        'min_ver'  => '5.61',
738
        'min_ver'  => '5.61',
739
    },
739
    },
740
    'HTML::Entities' => {
741
        'usage'    => 'Core',
742
        'required' => '1',
743
        'min_ver'  => '3.69',
744
    },
745
    'XML::Entities' => {
746
        'usage'    => 'Core',
747
        'required' => '1',
748
        'min_ver'  => '1.0001',
749
    },
750
    'RDF::Trine' => {
751
        'usage'    => 'Core',
752
        'required' => '1',
753
        'min_ver'  => '1.012',
754
    },
755
    'RDF::Helper' => {
756
        'usage'    => 'Core',
757
        'required' => '1',
758
        'min_ver'  => '2.01',
759
    },
740
};
760
};
741
761
742
1;
762
1;
(-)a/C4/Record.pm (-21 / +85 lines)
Lines 25-31 use strict; Link Here
25
# please specify in which methods a given module is used
25
# please specify in which methods a given module is used
26
use MARC::Record; # marc2marcxml, marcxml2marc, changeEncoding
26
use MARC::Record; # marc2marcxml, marcxml2marc, changeEncoding
27
use MARC::File::XML; # marc2marcxml, marcxml2marc, changeEncoding
27
use MARC::File::XML; # marc2marcxml, marcxml2marc, changeEncoding
28
use MARC::Crosswalk::DublinCore; # marc2dcxml
28
use Koha::DublinCoreTransformer; # marc2dcxml
29
use Biblio::EndnoteStyle;
29
use Biblio::EndnoteStyle;
30
use Unicode::Normalize; # _entity_encode
30
use Unicode::Normalize; # _entity_encode
31
use C4::Biblio; #marc2bibtex
31
use C4::Biblio; #marc2bibtex
Lines 222-237 sub marcxml2marc { Link Here
222
222
223
Returns a DublinCore::Record object, will eventually return a Dublin Core scalar
223
Returns a DublinCore::Record object, will eventually return a Dublin Core scalar
224
224
225
FIXME: should return actual XML, not just an object
225
FIXME: should return actual XML, not just an object (Koha::DublinCoreTransformer return an XML)
226
227
C<$type> - the recommendation ( simple-dc-rdf, dc-rdf, dc-xml, oai-dc)
226
228
227
C<$marc> - an ISO-2709 scalar or MARC::Record object
229
C<$marc> - an ISO-2709 scalar or MARC::Record object
228
230
229
C<$qualified> - specify whether qualified Dublin Core should be used in the input or output [0]
231
C<$qualified> - specify whether simple or qualified Dublin Core should be used in output [0 or 1]
232
233
C<$entities> placing entities to 0 will codify only the five basic entities e.g., &lt, &gt, &quot, &amp, and &apos. Conversely if it is encoded to 1, all entities will coded into decimal
234
235
C<$root> root element for XML files
236
237
C<$xsi_schemaLocation> the xsischemaLocation for XML files.
238
239
C<$rdf_subject> Represent the main subject of RDF triples (for Koha the URI of the resource)
240
241
C<$rdf_format> Imply multiple formats for RDF (ntriples, nquads, rdfxml, rdfjson, ntriples-canonical, turtle)
230
242
231
=cut
243
=cut
232
244
233
sub marc2dcxml {
245
sub marc2dcxml {
234
	my ($marc,$qualified) = @_;
246
    my ( $type, $marc, $qualified, $entities, $root, $xsi_schemaLocation, $rdf_subject,
247
        $rdf_format ) = @_;
235
	my $error;
248
	my $error;
236
    # test if it's already a MARC::Record object, if not, make it one
249
    # test if it's already a MARC::Record object, if not, make it one
237
    my $marc_record_obj;
250
    my $marc_record_obj;
Lines 245-268 sub marc2dcxml { Link Here
245
			$error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR;
258
			$error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR;
246
		}
259
		}
247
	}
260
	}
248
	my $crosswalk = MARC::Crosswalk::DublinCore->new;
261
    my $dcxml;
249
	if ($qualified) {
262
250
		$crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 1 );
263
    SWITCH:
251
	}
264
    for ($type) {
252
	my $dcxml = $crosswalk->as_dublincore($marc_record_obj);
265
        if (/^simple-dc-rdf/) {
253
	my $dcxmlfinal = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
266
            my $objectDC = Koha::DublinCoreTransformer->new({
254
	$dcxmlfinal .= "<metadata
267
                type            => 'rdf',
255
  xmlns=\"http://example.org/myapp/\"
268
                qualified       => 0,
256
  xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"
269
                get_marc_record => $marc,
257
  xsi:schemaLocation=\"http://example.org/myapp/ http://example.org/myapp/schema.xsd\"
270
            });
258
  xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
271
259
  xmlns:dcterms=\"http://purl.org/dc/terms/\">";
272
            $objectDC->get_rdf_data({
260
273
                rdf_subject => $rdf_subject,
261
	foreach my $element ( $dcxml->elements() ) {
274
                rdf_format  => 'rdfxml',
262
                $dcxmlfinal.="<"."dc:".$element->name().">".$element->content()."</"."dc:".$element->name().">\n";
275
                entities    => 1,
276
            });
277
            $dcxml = $objectDC->write_rdf();
278
            last SWITCH;
279
        }
280
        if (/^dc-rdf/) {
281
            my $objectDC = Koha::DublinCoreTransformer->new({
282
                type            => 'rdf',
283
                qualified       => 1,
284
                get_marc_record => $marc,
285
            });
286
287
            $objectDC->get_rdf_data({
288
                rdf_subject => $rdf_subject,
289
                rdf_format  => $rdf_format,
290
                entities    => 1,
291
            });
292
            $dcxml = $objectDC->write_rdf();
293
            last SWITCH;
294
        }
295
        if (/^dc-xml/) {
296
            my $objectDC = Koha::DublinCoreTransformer->new({
297
                type            => 'xml',
298
                qualified       => $qualified,
299
                get_marc_record => $marc,
300
            });
301
302
            $objectDC->get_xml_data({
303
                root               => $root,
304
                xsi_schemaLocation => $xsi_schemaLocation,
305
                entities           => 1,
306
            });
307
            $dcxml = $objectDC->write_xml();
308
            last SWITCH;
309
        }
310
        if ($type eq 'oai-dc') {
311
            my $objectDC = Koha::DublinCoreTransformer->new({
312
                type            => 'xml',
313
                qualified       => 0,
314
                get_marc_record => $marc,
315
            });
316
317
            $objectDC->get_xml_data({
318
                root               => 'oai_dc:dc',
319
                xsi_schemaLocation => 'http://www.openarchives.org/OAI/2.0/oai_dc/' .
320
                                      ' http://www.openarchives.org/OAI/2.0/oai_dc.xsd',
321
                entities           => 0,
322
                optional_namespace => 'oai_dc',
323
                namespace_url      => 'http://www.openarchives.org/OAI/2.0/oai_dc/',
324
            });
325
            $dcxml = $objectDC->write_xml();
326
            last SWITCH;
327
        }
263
    }
328
    }
264
	$dcxmlfinal .= "\n</metadata>";
329
    return ( $error, $dcxml );
265
	return ($error,$dcxmlfinal);
266
}
330
}
267
331
268
=head2 marc2modsxml - Convert from ISO-2709 to MODS
332
=head2 marc2modsxml - Convert from ISO-2709 to MODS
(-)a/Koha/DublinCoreTransformer.pm (+913 lines)
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 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: Koha::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
Koha::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 Koha::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 Koha::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 Koha::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/>
801
This recommendation is 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 Koha::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
(-)a/catalogue/export.pl (-2 / +28 lines)
Lines 26-31 my $format=$query->param("format"); Link Here
26
my $error = '';
26
my $error = '';
27
if ($op eq "export") {
27
if ($op eq "export") {
28
    my $biblionumber = $query->param("bib");
28
    my $biblionumber = $query->param("bib");
29
    my $recommendation = $query->param("recommendation");
30
    my $formats = $query->param("formats");
31
    my $qualifier = $query->param("qualifier");
32
    my $root_element = $query->param("root_element");
33
    my $xsischemalocation = $query->param("xsischemalocation");
34
    my $resource_url = $query->url(-base => 1) . '/cgi-bin/koha/catalogue/detail.pl?biblionumber=' . $biblionumber;
29
        if ($biblionumber){
35
        if ($biblionumber){
30
36
31
            my $marc = GetMarcBiblio($biblionumber, 1);
37
            my $marc = GetMarcBiblio($biblionumber, 1);
Lines 51-58 if ($op eq "export") { Link Here
51
                $format = "bibtex";
57
                $format = "bibtex";
52
            }
58
            }
53
            elsif ($format =~ /dc/) {
59
            elsif ($format =~ /dc/) {
54
                ($error,$marc) = marc2dcxml($marc,1);
60
                SWITCH:
55
                $format = "dublin-core.xml";
61
                    for ($recommendation) {
62
                        if (/^simple-dc-rdf/) {
63
                            ($error,$marc) = marc2dcxml($recommendation, $marc, 0,
64
                            1, undef, undef, $resource_url , $formats);
65
                            $format = "dublin-core." . $formats;
66
                            last SWITCH; }
67
                        if (/^dc-rdf/) {
68
                            ($error,$marc) = marc2dcxml($recommendation, $marc, 1,
69
                            1, undef, undef, $resource_url, $formats);
70
                            $format = "dublin-core." . $formats;
71
                            last SWITCH; }
72
                        if (/^dc-xml/) {
73
                            ($error,$marc) = marc2dcxml($recommendation, $marc, $qualifier,
74
                            1, $root_element, $xsischemalocation, undef, undef);
75
                            $format = "dublin-core.xml";
76
                            last SWITCH; }
77
                        if (/^oai-dc/) {
78
                            ($error,$marc) = marc2dcxml($recommendation, $marc);
79
                            $format = "dublin-core.xml";
80
                            last SWITCH; }
81
                }
56
            }
82
            }
57
            elsif ($format =~ /marc8/) {
83
            elsif ($format =~ /marc8/) {
58
                $marc = changeEncoding($marc,"MARC","MARC21","MARC-8");
84
                $marc = changeEncoding($marc,"MARC","MARC21","MARC-8");
(-)a/debian/control (-4 / +16 lines)
Lines 9-15 Standards-Version: 3.8.4 Link Here
9
# NOTA BENE: Build dependencies end up as runtime dependencies as well.
9
# NOTA BENE: Build dependencies end up as runtime dependencies as well.
10
# See debian/rules, the override_dh_gencontrol rules. 
10
# See debian/rules, the override_dh_gencontrol rules. 
11
# There are some exceptions.
11
# There are some exceptions.
12
Build-Depends: libalgorithm-checkdigits-perl,
12
Build-Depends: EEEK: unknown package for XML::Entities,
13
 libalgorithm-checkdigits-perl,
13
 libanyevent-http-perl,
14
 libanyevent-http-perl,
14
 libanyevent-perl,
15
 libanyevent-perl,
15
 libarchive-zip-perl,
16
 libarchive-zip-perl,
Lines 46-52 Build-Depends: libalgorithm-checkdigits-perl, Link Here
46
 libdigest-sha-perl | perl,
47
 libdigest-sha-perl | perl,
47
 libemail-date-perl,
48
 libemail-date-perl,
48
 libemail-valid-perl,
49
 libemail-valid-perl,
49
 libfile-path-perl | perl-modules,
50
 libfile-slurp-perl,
50
 libfile-slurp-perl,
51
 libfont-ttf-perl,
51
 libfont-ttf-perl,
52
 libgd-barcode-perl,
52
 libgd-barcode-perl,
Lines 54-60 Build-Depends: libalgorithm-checkdigits-perl, Link Here
54
 libgraphics-magick-perl,
54
 libgraphics-magick-perl,
55
 libgravatar-url-perl,
55
 libgravatar-url-perl,
56
 libhtml-format-perl,
56
 libhtml-format-perl,
57
 libhtml-parser-perl,
57
 libhtml-scrubber-perl,
58
 libhtml-scrubber-perl,
59
 libhttp-cookies-perl,
60
 libhttp-message-perl,
58
 libhttp-oai-perl,
61
 libhttp-oai-perl,
59
 libjson-perl,
62
 libjson-perl,
60
 liblibrary-callnumber-lc-perl,
63
 liblibrary-callnumber-lc-perl,
Lines 85-90 Build-Depends: libalgorithm-checkdigits-perl, Link Here
85
 libpdf-reuse-barcode-perl,
88
 libpdf-reuse-barcode-perl,
86
 libpdf-reuse-perl,
89
 libpdf-reuse-perl,
87
 libpdf-table-perl,
90
 libpdf-table-perl,
91
 librdf-helper-perl,
92
 librdf-trine-perl,
88
 libreadonly-perl,
93
 libreadonly-perl,
89
 libreadonly-xs-perl,
94
 libreadonly-xs-perl,
90
 libscalar-list-utils-perl,
95
 libscalar-list-utils-perl,
Lines 96-101 Build-Depends: libalgorithm-checkdigits-perl, Link Here
96
 libtemplate-plugin-htmltotext-perl,
101
 libtemplate-plugin-htmltotext-perl,
97
 libtemplate-plugin-json-escape-perl,
102
 libtemplate-plugin-json-escape-perl,
98
 libtest-deep-perl,
103
 libtest-deep-perl,
104
 libtest-harness-perl | perl-modules,
99
 libtest-mockmodule-perl,
105
 libtest-mockmodule-perl,
100
 libtest-mockobject-perl,
106
 libtest-mockobject-perl,
101
 libtest-simple-perl | perl-modules,
107
 libtest-simple-perl | perl-modules,
Lines 206-212 Description: Other dep. for koha Link Here
206
 daemon, debconf, etc.).
212
 daemon, debconf, etc.).
207
213
208
Package: koha-perldeps
214
Package: koha-perldeps
209
Depends: libalgorithm-checkdigits-perl,
215
Depends: EEEK: unknown package for XML::Entities,
216
 libalgorithm-checkdigits-perl,
210
 libanyevent-http-perl,
217
 libanyevent-http-perl,
211
 libanyevent-perl,
218
 libanyevent-perl,
212
 libarchive-zip-perl,
219
 libarchive-zip-perl,
Lines 243-249 Depends: libalgorithm-checkdigits-perl, Link Here
243
 libdigest-sha-perl | perl,
250
 libdigest-sha-perl | perl,
244
 libemail-date-perl,
251
 libemail-date-perl,
245
 libemail-valid-perl,
252
 libemail-valid-perl,
246
 libfile-path-perl | perl-modules,
247
 libfile-slurp-perl,
253
 libfile-slurp-perl,
248
 libfont-ttf-perl,
254
 libfont-ttf-perl,
249
 libgd-barcode-perl,
255
 libgd-barcode-perl,
Lines 251-257 Depends: libalgorithm-checkdigits-perl, Link Here
251
 libgraphics-magick-perl,
257
 libgraphics-magick-perl,
252
 libgravatar-url-perl,
258
 libgravatar-url-perl,
253
 libhtml-format-perl,
259
 libhtml-format-perl,
260
 libhtml-parser-perl,
254
 libhtml-scrubber-perl,
261
 libhtml-scrubber-perl,
262
 libhttp-cookies-perl,
263
 libhttp-message-perl,
255
 libhttp-oai-perl,
264
 libhttp-oai-perl,
256
 libjson-perl,
265
 libjson-perl,
257
 liblibrary-callnumber-lc-perl,
266
 liblibrary-callnumber-lc-perl,
Lines 282-287 Depends: libalgorithm-checkdigits-perl, Link Here
282
 libpdf-reuse-barcode-perl,
291
 libpdf-reuse-barcode-perl,
283
 libpdf-reuse-perl,
292
 libpdf-reuse-perl,
284
 libpdf-table-perl,
293
 libpdf-table-perl,
294
 librdf-helper-perl,
295
 librdf-trine-perl,
285
 libreadonly-perl,
296
 libreadonly-perl,
286
 libreadonly-xs-perl,
297
 libreadonly-xs-perl,
287
 libscalar-list-utils-perl,
298
 libscalar-list-utils-perl,
Lines 293-298 Depends: libalgorithm-checkdigits-perl, Link Here
293
 libtemplate-plugin-htmltotext-perl,
304
 libtemplate-plugin-htmltotext-perl,
294
 libtemplate-plugin-json-escape-perl,
305
 libtemplate-plugin-json-escape-perl,
295
 libtest-deep-perl,
306
 libtest-deep-perl,
307
 libtest-harness-perl | perl-modules,
296
 libtest-mockmodule-perl,
308
 libtest-mockmodule-perl,
297
 libtest-mockobject-perl,
309
 libtest-mockobject-perl,
298
 libtest-simple-perl | perl-modules,
310
 libtest-simple-perl | perl-modules,
(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/cat-toolbar.inc (-1 / +1 lines)
Lines 219-225 CAN_user_serials_create_subscription ) %] Link Here
219
    <button class="btn btn-small dropdown-toggle" data-toggle="dropdown"><i class="icon-download-alt"></i> Save <span class="caret"></span></button>
219
    <button class="btn btn-small dropdown-toggle" data-toggle="dropdown"><i class="icon-download-alt"></i> Save <span class="caret"></span></button>
220
    <ul class="dropdown-menu">
220
    <ul class="dropdown-menu">
221
        <li><a href="/cgi-bin/koha/catalogue/export.pl?format=bibtex&amp;op=export&amp;bib=[% biblionumber %]">BIBTEX</a></li>
221
        <li><a href="/cgi-bin/koha/catalogue/export.pl?format=bibtex&amp;op=export&amp;bib=[% biblionumber %]">BIBTEX</a></li>
222
        <li><a href="/cgi-bin/koha/catalogue/export.pl?format=dc&amp;op=export&amp;bib=[% biblionumber %]">Dublin Core (XML)</a></li>
222
        <li><a href="#" data-toggle="modal" data-target="#exportModal_">Dublin Core</a></li>
223
        <li><a href="/cgi-bin/koha/catalogue/export.pl?format=marcxml&amp;op=export&amp;bib=[% biblionumber %]">MARCXML</a></li>
223
        <li><a href="/cgi-bin/koha/catalogue/export.pl?format=marcxml&amp;op=export&amp;bib=[% biblionumber %]">MARCXML</a></li>
224
        <li><a href="/cgi-bin/koha/catalogue/export.pl?format=marc8&amp;op=export&amp;bib=[% biblionumber %]">MARC (non-Unicode/MARC-8)</a></li>
224
        <li><a href="/cgi-bin/koha/catalogue/export.pl?format=marc8&amp;op=export&amp;bib=[% biblionumber %]">MARC (non-Unicode/MARC-8)</a></li>
225
        <li><a href="/cgi-bin/koha/catalogue/export.pl?format=utf8&amp;op=export&amp;bib=[% biblionumber %]">MARC (Unicode/UTF-8)</a></li>
225
        <li><a href="/cgi-bin/koha/catalogue/export.pl?format=utf8&amp;op=export&amp;bib=[% biblionumber %]">MARC (Unicode/UTF-8)</a></li>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/catalogue/detail.tt (-1 / +129 lines)
Lines 297-302 function verify_images() { Link Here
297
297
298
        [% END %]
298
        [% END %]
299
    });
299
    });
300
301
    //JQuery for Dublin Core Exporter
302
    $(document).ready(function(){
303
        $("#input-simple").click(function(){
304
            $(".rdfoptions").removeAttr("disabled");
305
            $(".xmloptions").attr("disabled","disabled");
306
            $("#dc-rdf").toggle();
307
            $("#dc-xml").hide();
308
        });
309
    });
310
311
    $(document).ready(function(){
312
        $("#input-rdf").click(function(){
313
            $(".rdfoptions").removeAttr("disabled");
314
            $(".xmloptions").attr("disabled","disabled");
315
            $("#dc-rdf").toggle();
316
            $("#dc-xml").hide();
317
        });
318
    });
319
320
    $(document).ready(function(){
321
        $("#input-xml").click(function(){
322
            $(".xmloptions").removeAttr("disabled");
323
            $(".rdfoptions").attr("disabled","disabled");
324
                if($("#root_checked").is(':checked')){
325
                    $("#root_value").removeAttr("disabled");
326
                } else {
327
                    $("#root_value").attr("disabled","disabled");
328
                }
329
                if($("#schema_checked").is(':checked')){
330
                    $("#schema_value").removeAttr("disabled");
331
                } else {
332
                    $("#schema_value").attr("disabled","disabled");
333
                }
334
                $("#dc-xml").toggle();
335
                $("#dc-rdf").hide();
336
        });
337
    });
338
339
    $(document).ready(function(){
340
        $("#root_checked").click(function(){
341
            if($("#root_checked").is(':checked')){
342
                $("#root_value").removeAttr("disabled");
343
            } else {
344
                $("#root_value").attr("disabled","disabled");
345
            }
346
        });
347
    });
348
349
    $(document).ready(function(){
350
        $("#schema_checked").click(function(){
351
            if($("#schema_checked").is(':checked')){
352
                $("#schema_value").removeAttr("disabled");
353
            } else {
354
                $("#schema_value").attr("disabled","disabled");
355
            }
356
        });
357
    });
358
359
    $(document).ready(function(){
360
        $("#input-oai").click(function(){
361
            $(".rdfoptions").attr("disabled","disabled");
362
            $(".xmloptions").attr("disabled","disabled");
363
            $("#dc-rdf").hide();
364
            $("#dc-xml").hide();
365
        });
366
    });
367
300
//]]>
368
//]]>
301
</script>
369
</script>
302
</head>
370
</head>
Lines 1003-1009 function verify_images() { Link Here
1003
      <th>Save Record</th>   </tr>
1071
      <th>Save Record</th>   </tr>
1004
    <tr><td> Select download format:    <select name="format">
1072
    <tr><td> Select download format:    <select name="format">
1005
        <option value="mods">MODS (XML)</option>
1073
        <option value="mods">MODS (XML)</option>
1006
        <option value="dc">Dublin Core (XML)</option>
1074
        <option data-toggle="modal" data-target="#exportModal_">Dublin Core</option> <!-- trigger modal -->
1007
        <option value="marcxml">MARCXML</option>
1075
        <option value="marcxml">MARCXML</option>
1008
        <option value="marc8">MARC (non-Unicode/MARC-8)</option>
1076
        <option value="marc8">MARC (non-Unicode/MARC-8)</option>
1009
        <option value="utf8">MARC (Unicode/UTF-8)</option>    </select>
1077
        <option value="utf8">MARC (Unicode/UTF-8)</option>    </select>
Lines 1036-1039 function verify_images() { Link Here
1036
</div>
1104
</div>
1037
[% END %]
1105
[% END %]
1038
</div>
1106
</div>
1107
    <!-- Modal for Dublin Core-->
1108
    <div class="modal hide" id="exportModal_" tabindex="-1" role="dialog" aria-labelledby="exportLabelexportModal_" aria-hidden="true">
1109
        <div class="modal-header">
1110
            <button type="button" class="closebtn" data-dismiss="modal" aria-hidden="true">&times;</button>
1111
            <h3 id="exportLabelexportModal_">Exporting to Dublin Core...</h3>
1112
        </div>
1113
        <!-- Form to recolect data for Dublin Core-->
1114
        <form method="get" action="/cgi-bin/koha/catalogue/export.pl">
1115
        <div class="modal-body">
1116
            <fieldset>
1117
                <input id="input-simple" type="radio" name="recommendation" value="simple-dc-rdf">Simple DC-RDF
1118
                <br>
1119
                <input id="input-rdf" type="radio" name="recommendation" value="dc-rdf" checked>DC-RDF (Recommended)
1120
                <div id="dc-rdf" style="display:none;">
1121
                    <br>DC-RDF is downloadable in &quot;rdfxml&quot; by default (this is according with the
1122
                    <br>recommendation),  but you can download the file in other formats:
1123
                    <br>
1124
                    <input class="rdfoptions" type="radio" name="formats" value="rdfxml" checked>rdfxml
1125
                    <input class="rdfoptions" type="radio" name="formats" value="rdfjson">rdfjson
1126
                    <input class="rdfoptions" type="radio" name="formats" value="ntriples">ntriples
1127
                    <input class="rdfoptions" type="radio" name="formats" value="nquads">nquads
1128
                    <input class="rdfoptions" type="radio" name="formats" value="ntriples-canonical">ntriples-canonical
1129
                    <input class="rdfoptions" type="radio" name="formats" value="turtle">turtle
1130
                </div>
1131
                <br>
1132
                <input id="input-xml" type="radio" name="recommendation" value="dc-xml">DC-XML
1133
                <div id="dc-xml" style="display:none;">
1134
                    <p><b>Output options for DC-XML</b>
1135
                    <br>
1136
                    <b>Dublin Core level</b></p>
1137
                    <p><input class="xmloptions" type="radio" name="qualifier" value="0" checked disabled>Simple Dublin Core
1138
                    <input class="xmloptions" type="radio" name="qualifier" value="1" disabled>Qualified Dublin Core</p>
1139
                    <b>Other data (Optional)</b>
1140
                    <br>
1141
                    <input id="root_checked" class="xmloptions" type="checkbox" value="root">
1142
                    Root element: <input id="root_value" class="xmloptions" type="text" name="root_element" value="metadata" disabled>
1143
                    <br>The xsischemaLocation should be filled like:
1144
                    <br>http://example.org/myapp/ http://example.org/myapp/schema.xsd
1145
                    <br>
1146
                    <input id="schema_checked" class="xmloptions" type="checkbox" value="schema" disabled>
1147
                    xsischemaLocation: <input id="schema_value" class="xmloptions" type="url" name="xsischemalocation" disabled><br>
1148
                </div>
1149
                <br>
1150
                <input id="input-oai" type="radio" name="recommendation" value="oai-dc">OAI-DC
1151
                <br>
1152
                <div>
1153
                <br>Learn more about DCMI Specifications at: <a href="http://dublincore.org/specifications/">http://dublincore.org/specifications/</a>
1154
                <br>
1155
                </div>
1156
            </fieldset>
1157
        </div>
1158
        <div class="modal-footer">
1159
            <button type="submit" class="btn">Export</button>
1160
            <button class="btn btn-link" data-dismiss="modal" aria-hidden="true">Cancel</button>
1161
        </div>
1162
        <input type="hidden" name="op" value="export" />
1163
        <input type="hidden" name="format" value="dc" />
1164
        <input type="hidden" name="bib" value="[% biblionumber %]" />
1165
        </form>
1166
    </div>
1039
[% INCLUDE 'intranet-bottom.inc' %]
1167
[% INCLUDE 'intranet-bottom.inc' %]
(-)a/koha-tmpl/opac-tmpl/bootstrap/en/includes/masthead.inc (+64 lines)
Lines 316-318 Link Here
316
            </div>
316
            </div>
317
        </form> <!-- /#auth -->
317
        </form> <!-- /#auth -->
318
    </div>  <!-- /#modalAuth  -->
318
    </div>  <!-- /#modalAuth  -->
319
320
    <!-- Dublin Core Exporter modal form -->
321
    <div class="modal fade" id="myModal" tabindex="-1" role="dialog" aria-labelledby="myModalLabel" aria-hidden="true">
322
        <div class="modal-dialog">
323
            <div class="modal-content">
324
                <div class="modal-header">
325
                    <button type="button" class="closebtn" data-dismiss="modal" aria-hidden="true">&times;</button>
326
                    <h4 class="modal-title" id="myModalLabel">Exporting to Dublin Core...</h4>
327
                </div>
328
                <form method="get" action="/cgi-bin/koha/opac-export.pl">
329
                    <div class="modal-body">
330
                        <fieldset>
331
                            <input id="input-simple" type="radio" name="recommendation" value="simple-dc-rdf">Simple DC-RDF
332
                            <br>
333
                            <input id="input-rdf" type="radio" name="recommendation" value="dc-rdf" checked>DC-RDF (Recommended)
334
                            <div id="dc-rdf" style="display:none;">
335
                                <br>DC-RDF is downloadable in &quot;rdfxml&quot; by default (this is according with the
336
                                <br>recommendation),  but you can download the file in other formats:
337
                                <br>
338
                                <input class="rdfoptions" type="radio" name="formats" value="rdfxml" checked>rdfxml
339
                                <input class="rdfoptions" type="radio" name="formats" value="rdfjson">rdfjson
340
                                <input class="rdfoptions" type="radio" name="formats" value="ntriples">ntriples
341
                                <input class="rdfoptions" type="radio" name="formats" value="nquads">nquads
342
                                <input class="rdfoptions" type="radio" name="formats" value="ntriples-canonical">ntriples-canonical
343
                                <input class="rdfoptions" type="radio" name="formats" value="turtle">turtle
344
                            </div>
345
                            <br>
346
                            <input id="input-xml" type="radio" name="recommendation" value="dc-xml">DC-XML
347
                            <div id="dc-xml" style="display:none;">
348
                                <p><b>Output options for DC-XML</b>
349
                                <br>
350
                                <b>Dublin Core level</b></p>
351
                                <p><input class="xmloptions" type="radio" name="qualifier" value="0" checked disabled>Simple Dublin Core
352
                                <input class="xmloptions" type="radio" name="qualifier" value="1" disabled>Qualified Dublin Core</p>
353
                                <b>Other data (Optional)</b>
354
                                <br>
355
                                <input id="root_checked" class="xmloptions" type="checkbox" value="root">
356
                                Root element: <input id="root_value" class="xmloptions" type="text" name="root_element" value="metadata" disabled>
357
                                <br>The xsischemaLocation should be filled like:
358
                                <br>http://example.org/myapp/ http://example.org/myapp/schema.xsd
359
                                <br>
360
                                <input id="schema_checked" class="xmloptions" type="checkbox" value="schema" disabled>
361
                                xsischemaLocation: <input id="schema_value" class="xmloptions" type="url" name="xsischemalocation" disabled><br>
362
                            </div>
363
                            <br>
364
                            <input id="input-oai" type="radio" name="recommendation" value="oai-dc">OAI-DC
365
                            <br>
366
                            <div>
367
                                <br>Learn more about DCMI Specifications at: <a href="http://dublincore.org/specifications/">http://dublincore.org/specifications/</a>
368
                                <br>
369
                            </div>
370
                        </fieldset>
371
                    </div>
372
                    <div class="modal-footer">
373
                        <button type="button" class="btn btn-default" data-dismiss="modal">Close</button>
374
                        <button type="submit" class="btn btn-primary">Export</button>
375
                    </div>
376
                    <input type="hidden" name="op" value="export" />
377
                    <input type="hidden" name="format" value="dc" />
378
                    <input type="hidden" name="bib" value="[% biblionumber %]" />
379
                </form>
380
            </div>
381
        </div>
382
    </div><!-- End modal form -->
(-)a/koha-tmpl/opac-tmpl/bootstrap/en/includes/opac-detail-sidebar.inc (-15 / +18 lines)
Lines 42-62 Link Here
42
                    <a id="format" class="dropdown-toggle" data-toggle="dropdown" href="#">Save record <b class="caret"></b></a>
42
                    <a id="format" class="dropdown-toggle" data-toggle="dropdown" href="#">Save record <b class="caret"></b></a>
43
                        <ul class="dropdown-menu pull-right" role="menu" aria-labelledby="format">
43
                        <ul class="dropdown-menu pull-right" role="menu" aria-labelledby="format">
44
                            [% FOREACH option IN export_options %]
44
                            [% FOREACH option IN export_options %]
45
                                <li>
45
                                [% IF option == 'dc' %]
46
                                    <a role="menuitem" href="/cgi-bin/koha/opac-export.pl?op=export&amp;bib=[% biblionumber %]&amp;format=[% option %]">
46
                                    <li><a role="menuitem" href="#" data-toggle="modal" data-target="#myModal">Dublin Core</a></li>
47
                                        [% SWITCH option %]
47
                                [% ELSE %]
48
                                            [% CASE 'bibtex' %]BIBTEX
48
                                    <li>
49
                                            [% CASE 'dc' %]Dublin Core (XML)
49
                                        <a role="menuitem" href="/cgi-bin/koha/opac-export.pl?op=export&amp;bib=[% biblionumber %]&amp;format=[% option %]">
50
                                            [% CASE 'endnote' %]EndNote
50
                                            [% SWITCH option %]
51
                                            [% CASE 'marcxml' %]MARCXML
51
                                                [% CASE 'bibtex' %]BIBTEX
52
                                            [% CASE 'marc8' %]MARC (non-Unicode/MARC-8)
52
                                                [% CASE 'endnote' %]EndNote
53
                                            [% CASE 'utf8' %]MARC (Unicode/UTF-8)
53
                                                [% CASE 'marcxml' %]MARCXML
54
                                            [% CASE 'marcstd' %]MARC (Unicode/UTF-8, Standard)
54
                                                [% CASE 'marc8' %]MARC (non-Unicode/MARC-8)
55
                                            [% CASE 'mods' %]MODS (XML)
55
                                                [% CASE 'utf8' %]MARC (Unicode/UTF-8)
56
                                            [% CASE 'ris' %]RIS
56
                                                [% CASE 'marcstd' %]MARC (Unicode/UTF-8, Standard)
57
                                        [% END %]
57
                                                [% CASE 'mods' %]MODS (XML)
58
                                    </a>
58
                                                [% CASE 'ris' %]RIS
59
                                </li>
59
                                            [% END %]
60
                                        </a>
61
                                    </li>
62
                                [% END %]
60
                            [% END %]
63
                            [% END %]
61
                        </ul>
64
                        </ul>
62
                </div>
65
                </div>
(-)a/koha-tmpl/opac-tmpl/bootstrap/js/script.js (-1 / +68 lines)
Lines 63-66 $(document).ready(function(){ Link Here
63
            $("#members").removeAttr("style");
63
            $("#members").removeAttr("style");
64
        }
64
        }
65
    });
65
    });
66
});
66
});
67
68
    //JQuery for Dublin Core Exporter
69
    $(document).ready(function(){
70
        $("#input-simple").click(function(){
71
            $(".rdfoptions").removeAttr("disabled");
72
            $(".xmloptions").attr("disabled","disabled");
73
            $("#dc-rdf").toggle();
74
            $("#dc-xml").hide();
75
        });
76
    });
77
78
    $(document).ready(function(){
79
        $("#input-rdf").click(function(){
80
            $(".rdfoptions").removeAttr("disabled");
81
            $(".xmloptions").attr("disabled","disabled");
82
            $("#dc-rdf").toggle();
83
            $("#dc-xml").hide();
84
        });
85
    });
86
87
    $(document).ready(function(){
88
        $("#input-xml").click(function(){
89
            $(".xmloptions").removeAttr("disabled");
90
            $(".rdfoptions").attr("disabled","disabled");
91
                if($("#root_checked").is(':checked')){
92
                    $("#root_value").removeAttr("disabled");
93
                } else {
94
                    $("#root_value").attr("disabled","disabled");
95
                }
96
                if($("#schema_checked").is(':checked')){
97
                    $("#schema_value").removeAttr("disabled");
98
                } else {
99
                    $("#schema_value").attr("disabled","disabled");
100
                }
101
                $("#dc-xml").toggle();
102
                $("#dc-rdf").hide();
103
        });
104
    });
105
106
    $(document).ready(function(){
107
        $("#root_checked").click(function(){
108
            if($("#root_checked").is(':checked')){
109
                $("#root_value").removeAttr("disabled");
110
            } else {
111
                $("#root_value").attr("disabled","disabled");
112
            }
113
        });
114
    });
115
116
    $(document).ready(function(){
117
        $("#schema_checked").click(function(){
118
            if($("#schema_checked").is(':checked')){
119
                $("#schema_value").removeAttr("disabled");
120
            } else {
121
                $("#schema_value").attr("disabled","disabled");
122
            }
123
        });
124
    });
125
126
    $(document).ready(function(){
127
        $("#input-oai").click(function(){
128
            $(".rdfoptions").attr("disabled","disabled");
129
            $(".xmloptions").attr("disabled","disabled");
130
            $("#dc-rdf").hide();
131
            $("#dc-xml").hide();
132
        });
133
    });
(-)a/opac/opac-export.pl (-2 / +28 lines)
Lines 34-39 my $format=$query->param("format")||'utf8'; Link Here
34
my $biblionumber = $query->param("bib")||0;
34
my $biblionumber = $query->param("bib")||0;
35
$biblionumber = int($biblionumber);
35
$biblionumber = int($biblionumber);
36
my ($marc, $error)= ('','');
36
my ($marc, $error)= ('','');
37
my $recommendation = $query->param("recommendation");
38
my $formats = $query->param("formats");
39
my $qualifier = $query->param("qualifier");
40
my $root_element = $query->param("root_element");
41
my $xsischemalocation = $query->param("xsischemalocation");
42
my $resource_url = $query->url(-base => 1) . '/cgi-bin/koha/opac-detail.pl?biblionumber=' . $biblionumber;
37
43
38
$marc = GetMarcBiblio($biblionumber, 1) if $biblionumber;
44
$marc = GetMarcBiblio($biblionumber, 1) if $biblionumber;
39
if(!$marc) {
45
if(!$marc) {
Lines 61-68 elsif ($format =~ /bibtex/) { Link Here
61
    $format = 'bibtex';
67
    $format = 'bibtex';
62
}
68
}
63
elsif ($format =~ /dc/) {
69
elsif ($format =~ /dc/) {
64
    ($error,$marc) = marc2dcxml($marc,1);
70
    SWITCH:
65
    $format = "dublin-core.xml";
71
        for ($recommendation) {
72
            if (/^simple-dc-rdf/) {
73
                ($error,$marc) = marc2dcxml($recommendation, $marc, 0,
74
                1, undef, undef, $resource_url , $formats);
75
                $format = "dublin-core." . $formats;
76
                last SWITCH; }
77
            if (/^dc-rdf/) {
78
                ($error,$marc) = marc2dcxml($recommendation, $marc, 1,
79
                1, undef, undef, $resource_url, $formats);
80
                $format = "dublin-core." . $formats;
81
                last SWITCH; }
82
            if (/^dc-xml/) {
83
                ($error,$marc) = marc2dcxml($recommendation, $marc, $qualifier,
84
                1, $root_element, $xsischemalocation, undef, undef);
85
                $format = "dublin-core.xml";
86
                last SWITCH; }
87
            if (/^oai-dc/) {
88
                ($error,$marc) = marc2dcxml($recommendation, $marc);
89
                $format = "dublin-core.xml";
90
                last SWITCH; }
91
        }
66
}
92
}
67
elsif ($format =~ /marc8/) {
93
elsif ($format =~ /marc8/) {
68
    ($error,$marc) = changeEncoding($marc,"MARC","MARC21","MARC-8");
94
    ($error,$marc) = changeEncoding($marc,"MARC","MARC21","MARC-8");
(-)a/tags/list.pl (-93 lines)
Lines 1-93 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2011 Athens County Public Libraries
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use warnings;
21
use strict;
22
use CGI qw ( -utf8 );
23
24
use C4::Auth qw(:DEFAULT check_cookie_auth);
25
use C4::Biblio;
26
use C4::Context;
27
use C4::Dates qw(format_date);
28
use C4::Items;
29
use C4::Koha;
30
use C4::Tags qw(get_tags remove_tag get_tag_rows);
31
use C4::Output;
32
33
my $needed_flags = { tools => 'moderate_tags'
34
};    # FIXME: replace when more specific permission is created.
35
36
my $query        = CGI->new;
37
my $op           = $query->param('op') || '';
38
my $biblionumber = $query->param('biblionumber');
39
my $tag          = $query->param('tag');
40
my $tag_id       = $query->param('tag_id');
41
42
my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
43
    {
44
        template_name   => "tags/list.tt",
45
        query           => $query,
46
        type            => "intranet",
47
        debug           => 1,
48
        authnotrequired => 0,
49
        flagsrequired   => $needed_flags,
50
    }
51
);
52
53
if ( $op eq "del" ) {
54
    remove_tag($tag_id);
55
    print $query->redirect("/cgi-bin/koha/tags/list.pl?tag=$tag");
56
}
57
else {
58
59
    my $marcflavour = C4::Context->preference('marcflavour');
60
    my @results;
61
62
    if ($tag) {
63
        my $taglist = get_tag_rows( { term => $tag } );
64
        for ( @{$taglist} ) {
65
            my $dat    = &GetBiblioData( $_->{biblionumber} );
66
            my $record = &GetMarcBiblio( $_->{biblionumber} );
67
            $dat->{'subtitle'} =
68
              GetRecordValue( 'subtitle', $record,
69
                GetFrameworkCode( $_->{biblionumber} ) );
70
            my @items = GetItemsInfo( $_->{biblionumber} );
71
            $dat->{biblionumber} = $_->{biblionumber};
72
            $dat->{tag_id}       = $_->{tag_id};
73
            $dat->{items}        = \@items;
74
            $dat->{TagLoop}      = get_tags(
75
                {
76
                    biblionumber => $_->{biblionumber},
77
                    'sort'       => '-weight',
78
                    limit        => 10
79
                }
80
            );
81
            push( @results, $dat );
82
        }
83
84
        my $resultsarray = \@results;
85
86
        $template->param(
87
            tag    => $tag,
88
            titles => $resultsarray,
89
        );
90
    }
91
}
92
93
output_html_with_http_headers $query, $cookie, $template->output;
(-)a/tags/review.pl (-234 lines)
Lines 1-234 Link Here
1
#!/usr/bin/perl
2
3
# This software is placed under the gnu General Public License, v2 (http://www.gnu.org/licenses/gpl.html)
4
5
# Copyright 2008 LibLime
6
#
7
# This file is part of Koha.
8
#
9
# Koha is free software; you can redistribute it and/or modify it under the
10
# terms of the GNU General Public License as published by the Free Software
11
# Foundation; either version 2 of the License, or (at your option) any later
12
# version.
13
#
14
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
17
#
18
# You should have received a copy of the GNU General Public License along
19
# with Koha; if not, write to the Free Software Foundation, Inc.,
20
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
22
use warnings;
23
use strict;
24
use Data::Dumper;
25
use POSIX;
26
use CGI qw ( -utf8 );
27
use CGI::Cookie; # need to check cookies before having CGI parse the POST request
28
29
use C4::Auth qw(:DEFAULT check_cookie_auth);
30
use C4::Context;
31
use C4::Dates qw(format_date format_date_in_iso);
32
# use C4::Koha;
33
use C4::Output qw(:html :ajax pagination_bar);
34
use C4::Debug;
35
use C4::Tags qw(get_tags get_approval_rows approval_counts whitelist blacklist is_approved);
36
37
my $script_name = "/cgi-bin/koha/tags/review.pl";
38
my $needed_flags = { tools => 'moderate_tags' };	# FIXME: replace when more specific permission is created.
39
40
sub ajax_auth_cgi ($) {		# returns CGI object
41
	my $needed_flags = shift;
42
	my %cookies = fetch CGI::Cookie;
43
	my $input = CGI->new;
44
    my $sessid = $cookies{'CGISESSID'}->value;
45
	my ($auth_status, $auth_sessid) = check_cookie_auth($sessid, $needed_flags);
46
	$debug and
47
	print STDERR "($auth_status, $auth_sessid) = check_cookie_auth($sessid," . Dumper($needed_flags) . ")\n";
48
	if ($auth_status ne "ok") {
49
		output_with_http_headers $input, undef,
50
			"window.alert('Your CGI session cookie ($sessid) is not current.  " . 
51
			"Please refresh the page and try again.');\n", 'js';
52
		exit 0;
53
	}
54
	$debug and print STDERR "AJAX request: " . Dumper($input),
55
		"\n(\$auth_status,\$auth_sessid) = ($auth_status,$auth_sessid)\n";
56
	return $input;
57
}
58
59
if (is_ajax()) {
60
	my $input = &ajax_auth_cgi($needed_flags);
61
	my $operator = C4::Context->userenv->{'number'};  # must occur AFTER auth
62
	$debug and print STDERR "op: " . Dumper($operator) . "\n";
63
	my ($tag, $js_reply);
64
	if ($tag = $input->param('test')) {
65
		my $check = is_approved($tag);
66
		$js_reply = ( $check >=  1 ? 'success' :
67
					  $check <= -1 ? 'failure' : 'indeterminate' ) . "_test('$tag');\n";
68
	}
69
	if ($tag = $input->param('ok')) {
70
		$js_reply = (   whitelist($operator,$tag) ? 'success' : 'failure') . "_approve('$tag');\n";
71
	} 
72
	if ($tag = $input->param('rej')) {
73
		$js_reply = (   blacklist($operator,$tag) ? 'success' : 'failure')  . "_reject('$tag');\n";
74
	}
75
	output_with_http_headers $input, undef, $js_reply, 'js';
76
	exit;
77
}
78
79
### Below is the sad, boring, necessary non-AJAX HTML code.
80
81
my $input = CGI->new;
82
my ($template, $borrowernumber, $cookie) = get_template_and_user(
83
    {
84
        template_name   => "tags/review.tt",
85
        query           => $input,
86
        type            => "intranet",
87
        debug           => 1,
88
        authnotrequired => 0,
89
        flagsrequired   => $needed_flags,
90
    }
91
);
92
93
my ($op, @errors, @tags);
94
95
foreach (qw( approve reject test )) {
96
    $op = $_ if ( $input->param("op-$_") );
97
}
98
$op ||= 'none';
99
100
@tags = $input->param('tags');
101
102
$borrowernumber == 0 and push @errors, {op_zero=>1};
103
     if ($op eq 'approve') {
104
	foreach (@tags) {
105
	 	whitelist($borrowernumber,$_) or push @errors, {failed_ok=>$_};
106
	}
107
} elsif ($op eq 'reject' ) {
108
	foreach (@tags) {
109
	 	blacklist($borrowernumber,$_) or push @errors, {failed_rej=>$_};
110
	}
111
} elsif ($op eq 'test'   ) {
112
	my $tag = $input->param('test');
113
	push @tags, $tag;
114
	my $check = is_approved($tag);
115
	$template->param(
116
		test_term => $tag,
117
		( $check >=  1 ? 'verdict_ok' :
118
		  $check <= -1 ? 'verdict_rej' : 'verdict_indeterminate' ) => 1,
119
	);
120
}
121
122
my $counts = &approval_counts;
123
foreach (keys %$counts) {
124
	$template->param($_ => $counts->{$_});
125
}
126
127
sub pagination_calc ($;$) {
128
	my $query = shift or return undef;	
129
	my $hardlimit = (@_) ? shift : 100;	# hardcoded, could be another syspref
130
	my $pagesize = $query->param('limit' ) || $hardlimit;
131
	my $page     = $query->param('page'  ) || 1;
132
	my $offset   = $query->param('offset') || 0;
133
	($pagesize <= $hardlimit) or $pagesize = $hardlimit;
134
	if ($page > 1) {
135
		$offset = ($page-1)*$pagesize;
136
	} else {
137
		$page = 1;
138
	}
139
	return ($pagesize,$page,$offset);
140
}
141
142
my ($pagesize,$page,$offset) = pagination_calc($input,100);
143
144
my %filters = (
145
	limit => $offset ? "$offset,$pagesize" : $pagesize,
146
	 sort => 'approved,-weight_total,+term',
147
);
148
my ($filter,$date_from,$date_to);
149
if (defined $input->param('approved')) { # 0 is valid value, must check defined
150
	$filter = $input->param('approved');
151
} else {
152
	$filter = 0;
153
}
154
if ($filter eq 'all') {
155
	$template->param(filter_approved_all => 1);
156
} elsif ($filter =~ /-?[01]/) {
157
	$filters{approved} = $filter;
158
	$template->param(
159
		($filter == 1  ? 'filter_approved_ok'      : 
160
		 $filter == 0  ? 'filter_approved_pending' :
161
		 $filter == -1 ? 'filter_approved_rej'     :
162
		'filter_approved') => 1
163
	);
164
}
165
166
# my $q_count = get_approval_rows({limit=>$pagesize, sort=>'approved,-weight_total,+term', count=>1});
167
if ($filter = $input->param('tag')) {
168
	$template->param(filter_tag=>$filter);
169
	$filters{term} = $filter;
170
}
171
if ($filter = $input->param('from')) {
172
	if ($date_from = format_date_in_iso($filter)) {
173
		$template->param(filter_date_approved_from=>$filter);
174
		$filters{date_approved} = ">=$date_from";
175
	} else {
176
		push @errors, {date_from=>$filter};
177
	}
178
}
179
if ($filter = $input->param('to')) {
180
	if ($date_to = format_date_in_iso($filter)) {
181
		$template->param(filter_date_approved_to=>$filter);
182
		$filters{date_approved} = "<=$date_to";
183
	} else {
184
		push @errors, {date_to=>$filter};
185
	}
186
}
187
if ($filter = $input->param('approver')) {		# name (or borrowernumber) from input box
188
	if ($filter =~ /^\d+$/ and $filter > 0) {
189
		# $filter=get borrowernumber from name
190
		# FIXME: get borrowernumber from name not implemented.
191
		$template->param(filter_approver=>$filter);
192
		$filters{approved_by} = $filter;
193
	} else {
194
		push @errors, {approver=>$filter};
195
	}
196
}
197
if ($filter = $input->param('approved_by')) {	# borrowernumber from link
198
	if ($filter =~ /^\d+$/ and $filter > 0) {
199
		$template->param(filter_approver=>$filter);
200
		$filters{approved_by} = $filter;
201
	} else {
202
		push @errors, {approved_by=>$filter};
203
	}
204
}
205
$debug and print STDERR "filters: " . Dumper(\%filters);
206
my $tagloop = get_approval_rows(\%filters);
207
my $qstring = $input->query_string;
208
$qstring =~ s/([&;])*\blimit=\d+//;		# remove pagination var
209
$qstring =~ s/^;+//;					# remove leading delims
210
$qstring = "limit=$pagesize" . ($qstring ? '&amp;' . $qstring : '');
211
$debug and print STDERR "number of approval_rows: " . scalar(@$tagloop) . "rows\n";
212
(scalar @errors) and $template->param(message_loop=>\@errors);
213
$template->param(
214
	offset => $offset,	# req'd for EXPR
215
	op => $op,
216
	op_count => scalar(@tags),
217
	script_name => $script_name,
218
	approved => 0,		# dummy value (also EXPR)
219
	tagloop => $tagloop,
220
	pagination_bar => pagination_bar(
221
		"$script_name?$qstring\&amp;",
222
		ceil($counts->{approved_total}/$pagesize),	# $page, 'page'
223
	)
224
);
225
226
output_html_with_http_headers $input, $cookie, $template->output;
227
__END__
228
229
=head1 AUTHOR
230
231
Joe Atzberger
232
atz AT liblime.com
233
234
=cut
(-)a/test/README (-3 lines)
Lines 1-3 Link Here
1
A collection of cgi and command line scripts that are useful for some testing,
2
but for one reason or another cannot be made into automated test in t.
3
Use with templates in koha-tmpl/intranet-tmpl/prog/en/modules/test
(-)a/test/progressbar.pl (-55 lines)
Lines 1-55 Link Here
1
#!/usr/bin/perl
2
3
# Script for testing progressbar, part 1 - initial screem
4
# it is split into two scripts so we can use firebug to debug it
5
6
# Koha library project  www.koha-community.org
7
8
# Licensed under the GPL
9
10
# Copyright 2010 Catalyst IT, Ltd
11
#
12
# This file is part of Koha.
13
#
14
# Koha is free software; you can redistribute it and/or modify it under the
15
# terms of the GNU General Public License as published by the Free Software
16
# Foundation; either version 2 of the License, or (at your option) any later
17
# version.
18
#
19
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
20
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
21
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
22
#
23
# You should have received a copy of the GNU General Public License along
24
# with Koha; if not, write to the Free Software Foundation, Inc.,
25
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
26
27
use strict;
28
use warnings;
29
30
# standard or CPAN modules used
31
use CGI qw ( -utf8 );
32
use CGI::Cookie;
33
34
# Koha modules used
35
use C4::Context;
36
use C4::Auth;
37
use C4::Output;
38
use C4::BackgroundJob;
39
40
my $input = new CGI;
41
my $dbh = C4::Context->dbh;
42
$dbh->{AutoCommit} = 0;
43
44
my ($template, $loggedinuser, $cookie)
45
    = get_template_and_user({template_name => "test/progressbar.tt",
46
					query => $input,
47
					type => "intranet",
48
					debug => 1,
49
					});
50
51
output_html_with_http_headers $input, $cookie, $template->output;
52
53
exit 0;
54
55
(-)a/test/progressbarsubmit.pl (-104 lines)
Lines 1-104 Link Here
1
#!/usr/bin/perl
2
3
# Script for testing progressbar, part 2 - json submit handler
4
#   and Z39.50 lookups
5
6
# Koha library project  www.koha-community.org
7
8
# Licensed under the GPL
9
10
# Copyright 2010  Catalyst IT, Ltd
11
#
12
# This file is part of Koha.
13
#
14
# Koha is free software; you can redistribute it and/or modify it under the
15
# terms of the GNU General Public License as published by the Free Software
16
# Foundation; either version 2 of the License, or (at your option) any later
17
# version.
18
#
19
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
20
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
21
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
22
#
23
# You should have received a copy of the GNU General Public License along
24
# with Koha; if not, write to the Free Software Foundation, Inc.,
25
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
26
27
use strict;
28
use warnings;
29
30
# standard or CPAN modules used
31
use CGI qw ( -utf8 );
32
use CGI::Cookie;
33
34
# Koha modules used
35
use C4::Context;
36
use C4::Auth;
37
use C4::Output;
38
use C4::BackgroundJob;
39
40
my $input = new CGI;
41
42
my $submitted=$input->param('submitted');
43
my $runinbackground = $input->param('runinbackground');
44
my $jobID = $input->param('jobID');
45
my $completedJobID = $input->param('completedJobID');
46
47
my ($template, $loggedinuser, $cookie)
48
    = get_template_and_user({template_name => "test/progressbar.tt",
49
                    query => $input,
50
                    type => "intranet",
51
                    debug => 1,
52
                    });
53
54
my %cookies = parse CGI::Cookie($cookie);
55
my $sessionID = $cookies{'CGISESSID'}->value;
56
if ($completedJobID) {
57
} elsif ($submitted) {
58
    my $job = undef;
59
    if ($runinbackground) {
60
        my $job_size = 100;
61
        $job = C4::BackgroundJob->new($sessionID, undef, $ENV{'SCRIPT_NAME'}, $job_size);
62
        $jobID = $job->id();
63
64
        # fork off
65
        if (my $pid = fork) {
66
            # parent
67
            # return job ID as JSON
68
            
69
            # prevent parent exiting from
70
            # destroying the kid's database handle
71
            # FIXME: according to DBI doc, this may not work for Oracle
72
73
            my $reply = CGI->new("");
74
            print $reply->header(-type => 'text/html');
75
            print '{"jobID":"' . $jobID . '"}';
76
            exit 0;
77
        } elsif (defined $pid) {
78
        # if we get here, we're a child that has detached
79
        # itself from Apache
80
81
            # close STDOUT to signal to Apache that
82
            # we're now running in the background
83
            close STDOUT;
84
            close STDERR;
85
86
            foreach (1..100) {
87
                $job->progress( $_ );
88
                sleep 1;
89
            }
90
            $job->finish();
91
        } else {
92
            # fork failed, so exit immediately
93
            die "fork failed while attempting to run $ENV{'SCRIPT_NAME'} as a background job";
94
        }
95
96
    }
97
} else {
98
    # initial form
99
    die "We should not be here";
100
}
101
102
exit 0;
103
104
(-)a/test/search.pl (-74 lines)
Lines 1-74 Link Here
1
#!/usr/bin/perl -w
2
3
use C4::Search;
4
5
my @SEARCH = (
6
    { operators => [
7
          'and',
8
          'and'
9
      ],
10
      operands => [
11
          'shakespeare, "(william)"',
12
          'dream'
13
      ],
14
      indexes => [
15
          'au,wrdl',
16
          'ti',
17
          'kw'
18
      ],
19
      limits => [
20
          'yr,st-numeric=2000-'
21
      ],
22
      sort_by => [
23
          'relevance'
24
      ],
25
      lang => 'en',
26
    },
27
);
28
29
30
foreach ( @SEARCH ) {
31
    my ($expected, @mismatch);
32
    my( $error,
33
        $query,
34
        $simple_query,
35
        $query_cgi,
36
        $query_desc,
37
        $limit,
38
        $limit_cgi,
39
        $limit_desc,
40
        $stopwords_removed,
41
        $query_type )
42
      = buildQuery( $_->{operators}, $_->{operands}, $_->{indexes}, $_->{limits}, $_->{sort_by}, 0,  $_->{lang} );
43
44
    die $error if $error;
45
46
    $expected = $_->{query};
47
    push @mismatch, "Query: $query (not: $expected)" unless $query eq $expected;
48
49
    $expected = $_->{simple_query};
50
    push @mismatch, "Simple Query: $simple_query (not: $expected)" unless $simple_query eq $expected;
51
52
    $expected = $_->{query_cgi};
53
    push @mismatch, "Query CGI: $query_cgi (not: $expected)" unless $query_cgi eq $expected;
54
55
    $expected = $_->{query_desc};
56
    push @mismatch, "Query desc: $query_desc (not: $expected)" unless $query_desc eq $expected;
57
58
    $expected = $_->{limit};
59
    push @mismatch, "Limit: $limit (not: $expected)" unless $limit eq $expected;
60
61
    $expected = $_->{limit_cgi};
62
    push @mismatch, "Limit CGI: $limit_cgi (not: $expected)" unless $limit_cgi eq $expected;
63
64
    $expected = $_->{limit_desc};
65
    push @mismatch, "Limit desc: $limit_desc (not: $expected)" unless $limit_desc eq $expected;
66
67
    $expected = $_->{stopwords_removed};
68
    push @mismatch, "Stopwords removed: $stopwords_removed (not: $expected)" unless $stopwords_removed eq $expected;
69
70
    $expected = $_->{query_type};
71
    push @mismatch, "Query Type: $query_type (not: $expected)" unless $query_type eq $expected;
72
73
    die map "$_\n", @mismatch if @mismatch;
74
}
(-)a/tmp/modified_authorities/README.txt (-1 lines)
Line 1 Link Here
1
do not remove this file, used to avoid the vcs from deleting this directory

Return to bug 13642