Bug 6756: Fix bad behaviors if AnonymousPatron is not defined
[koha.git] / opac / oai.pl
blobeef15bb4d33e495aba15cebae1da22bb6a464e20
1 #!/usr/bin/perl
3 # Copyright Biblibre 2008
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
21 use strict;
22 use warnings;
24 use CGI qw/:standard -oldstyle_urls/;
25 use vars qw( $GZIP );
26 use C4::Context;
29 BEGIN {
30 eval { require PerlIO::gzip };
31 $GZIP = ($@) ? 0 : 1;
34 unless ( C4::Context->preference('OAI-PMH') ) {
35 print
36 header(
37 -type => 'text/plain; charset=utf-8',
38 -charset => 'utf-8',
39 -status => '404 OAI-PMH service is disabled',
41 "OAI-PMH service is disabled";
42 exit;
45 my @encodings = http('HTTP_ACCEPT_ENCODING');
46 if ( $GZIP && grep { defined($_) && $_ eq 'gzip' } @encodings ) {
47 print header(
48 -type => 'text/xml; charset=utf-8',
49 -charset => 'utf-8',
50 -Content-Encoding => 'gzip',
52 binmode( STDOUT, ":gzip" );
54 else {
55 print header(
56 -type => 'text/xml; charset=utf-8',
57 -charset => 'utf-8',
61 binmode STDOUT, ':encoding(UTF-8)';
62 my $repository = C4::OAI::Repository->new();
64 # __END__ Main Prog
68 # Extends HTTP::OAI::ResumptionToken
69 # A token is identified by:
70 # - metadataPrefix
71 # - from
72 # - until
73 # - offset
75 package C4::OAI::ResumptionToken;
77 use strict;
78 use warnings;
79 use HTTP::OAI;
81 use base ("HTTP::OAI::ResumptionToken");
84 sub new {
85 my ($class, %args) = @_;
87 my $self = $class->SUPER::new(%args);
89 my ($metadata_prefix, $offset, $from, $until, $set);
90 if ( $args{ resumptionToken } ) {
91 ($metadata_prefix, $offset, $from, $until, $set)
92 = split( '/', $args{resumptionToken} );
94 else {
95 $metadata_prefix = $args{ metadataPrefix };
96 $from = $args{ from } || '1970-01-01';
97 $until = $args{ until };
98 unless ( $until) {
99 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime( time );
100 $until = sprintf( "%.4d-%.2d-%.2d", $year+1900, $mon+1,$mday );
102 $offset = $args{ offset } || 0;
103 $set = $args{set};
106 $self->{ metadata_prefix } = $metadata_prefix;
107 $self->{ offset } = $offset;
108 $self->{ from } = $from;
109 $self->{ until } = $until;
110 $self->{ set } = $set;
112 $self->resumptionToken(
113 join( '/', $metadata_prefix, $offset, $from, $until, $set ) );
114 $self->cursor( $offset );
116 return $self;
119 # __END__ C4::OAI::ResumptionToken
123 package C4::OAI::Identify;
125 use strict;
126 use warnings;
127 use HTTP::OAI;
128 use C4::Context;
130 use base ("HTTP::OAI::Identify");
132 sub new {
133 my ($class, $repository) = @_;
135 my ($baseURL) = $repository->self_url() =~ /(.*)\?.*/;
136 my $self = $class->SUPER::new(
137 baseURL => $baseURL,
138 repositoryName => C4::Context->preference("LibraryName"),
139 adminEmail => C4::Context->preference("KohaAdminEmailAddress"),
140 MaxCount => C4::Context->preference("OAI-PMH:MaxCount"),
141 granularity => 'YYYY-MM-DD',
142 earliestDatestamp => '0001-01-01',
143 deletedRecord => 'no',
146 # FIXME - alas, the description element is not so simple; to validate
147 # against the OAI-PMH schema, it cannot contain just a string,
148 # but one or more elements that validate against another XML schema.
149 # For now, simply omitting it.
150 # $self->description( "Koha OAI Repository" );
152 $self->compression( 'gzip' );
154 return $self;
157 # __END__ C4::OAI::Identify
161 package C4::OAI::ListMetadataFormats;
163 use strict;
164 use warnings;
165 use HTTP::OAI;
167 use base ("HTTP::OAI::ListMetadataFormats");
169 sub new {
170 my ($class, $repository) = @_;
172 my $self = $class->SUPER::new();
174 if ( $repository->{ conf } ) {
175 foreach my $name ( @{ $repository->{ koha_metadata_format } } ) {
176 my $format = $repository->{ conf }->{ format }->{ $name };
177 $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
178 metadataPrefix => $format->{metadataPrefix},
179 schema => $format->{schema},
180 metadataNamespace => $format->{metadataNamespace}, ) );
183 else {
184 $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
185 metadataPrefix => 'oai_dc',
186 schema => 'http://www.openarchives.org/OAI/2.0/oai_dc.xsd',
187 metadataNamespace => 'http://www.openarchives.org/OAI/2.0/oai_dc/'
188 ) );
189 $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
190 metadataPrefix => 'marcxml',
191 schema => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim.xsd',
192 metadataNamespace => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim'
193 ) );
196 return $self;
199 # __END__ C4::OAI::ListMetadataFormats
203 package C4::OAI::Record;
205 use strict;
206 use warnings;
207 use HTTP::OAI;
208 use HTTP::OAI::Metadata::OAI_DC;
210 use base ("HTTP::OAI::Record");
212 sub new {
213 my ($class, $repository, $marcxml, $timestamp, $setSpecs, %args) = @_;
215 my $self = $class->SUPER::new(%args);
217 $timestamp =~ s/ /T/, $timestamp .= 'Z';
218 $self->header( new HTTP::OAI::Header(
219 identifier => $args{identifier},
220 datestamp => $timestamp,
221 ) );
223 foreach my $setSpec (@$setSpecs) {
224 $self->header->setSpec($setSpec);
227 my $parser = XML::LibXML->new();
228 my $record_dom = $parser->parse_string( $marcxml );
229 my $format = $args{metadataPrefix};
230 if ( $format ne 'marcxml' ) {
231 my %args = (
232 OPACBaseURL => "'" . C4::Context->preference('OPACBaseURL') . "'"
234 $record_dom = $repository->stylesheet($format)->transform($record_dom, %args);
236 $self->metadata( HTTP::OAI::Metadata->new( dom => $record_dom ) );
238 return $self;
241 # __END__ C4::OAI::Record
245 package C4::OAI::GetRecord;
247 use strict;
248 use warnings;
249 use HTTP::OAI;
250 use C4::OAI::Sets;
252 use base ("HTTP::OAI::GetRecord");
255 sub new {
256 my ($class, $repository, %args) = @_;
258 my $self = HTTP::OAI::GetRecord->new(%args);
260 my $dbh = C4::Context->dbh;
261 my $sth = $dbh->prepare("
262 SELECT marcxml, timestamp
263 FROM biblioitems
264 WHERE biblionumber=? " );
265 my $prefix = $repository->{koha_identifier} . ':';
266 my ($biblionumber) = $args{identifier} =~ /^$prefix(.*)/;
267 $sth->execute( $biblionumber );
268 my ($marcxml, $timestamp);
269 unless ( ($marcxml, $timestamp) = $sth->fetchrow ) {
270 return HTTP::OAI::Response->new(
271 requestURL => $repository->self_url(),
272 errors => [ new HTTP::OAI::Error(
273 code => 'idDoesNotExist',
274 message => "There is no biblio record with this identifier",
275 ) ] ,
279 my $oai_sets = GetOAISetsBiblio($biblionumber);
280 my @setSpecs;
281 foreach (@$oai_sets) {
282 push @setSpecs, $_->{spec};
285 #$self->header( HTTP::OAI::Header->new( identifier => $args{identifier} ) );
286 $self->record( C4::OAI::Record->new(
287 $repository, $marcxml, $timestamp, \@setSpecs, %args ) );
289 return $self;
292 # __END__ C4::OAI::GetRecord
296 package C4::OAI::ListIdentifiers;
298 use strict;
299 use warnings;
300 use HTTP::OAI;
301 use C4::OAI::Sets;
303 use base ("HTTP::OAI::ListIdentifiers");
306 sub new {
307 my ($class, $repository, %args) = @_;
309 my $self = HTTP::OAI::ListIdentifiers->new(%args);
311 my $token = new C4::OAI::ResumptionToken( %args );
312 my $dbh = C4::Context->dbh;
313 my $set;
314 if(defined $token->{'set'}) {
315 $set = GetOAISetBySpec($token->{'set'});
317 my $max = $repository->{koha_max_count};
318 my $sql = "
319 SELECT biblioitems.biblionumber, biblioitems.timestamp
320 FROM biblioitems
322 $sql .= " JOIN oai_sets_biblios ON biblioitems.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
323 $sql .= " WHERE DATE(timestamp) >= ? AND DATE(timestamp) <= ? ";
324 $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
325 $sql .= "
326 LIMIT " . ($max+1) . "
327 OFFSET $token->{offset}
329 my $sth = $dbh->prepare( $sql );
330 my @bind_params = ($token->{'from'}, $token->{'until'});
331 push @bind_params, $set->{'id'} if defined $set;
332 $sth->execute( @bind_params );
334 my $count = 0;
335 while ( my ($biblionumber, $timestamp) = $sth->fetchrow ) {
336 $count++;
337 if ( $count > $max ) {
338 $self->resumptionToken(
339 new C4::OAI::ResumptionToken(
340 metadataPrefix => $token->{metadata_prefix},
341 from => $token->{from},
342 until => $token->{until},
343 offset => $token->{offset} + $max,
344 set => $token->{set}
347 last;
349 $timestamp =~ s/ /T/, $timestamp .= 'Z';
350 $self->identifier( new HTTP::OAI::Header(
351 identifier => $repository->{ koha_identifier} . ':' . $biblionumber,
352 datestamp => $timestamp,
353 ) );
356 # Return error if no results
357 unless ($count) {
358 return HTTP::OAI::Response->new(
359 requestURL => $repository->self_url(),
360 errors => [ new HTTP::OAI::Error( code => 'noRecordsMatch' ) ],
364 return $self;
367 # __END__ C4::OAI::ListIdentifiers
369 package C4::OAI::Description;
371 use strict;
372 use warnings;
373 use HTTP::OAI;
374 use HTTP::OAI::SAXHandler qw/ :SAX /;
376 sub new {
377 my ( $class, %args ) = @_;
379 my $self = {};
381 if(my $setDescription = $args{setDescription}) {
382 $self->{setDescription} = $setDescription;
384 if(my $handler = $args{handler}) {
385 $self->{handler} = $handler;
388 bless $self, $class;
389 return $self;
392 sub set_handler {
393 my ( $self, $handler ) = @_;
395 $self->{handler} = $handler if $handler;
397 return $self;
400 sub generate {
401 my ( $self ) = @_;
403 g_data_element($self->{handler}, 'http://www.openarchives.org/OAI/2.0/', 'setDescription', {}, $self->{setDescription});
405 return $self;
408 # __END__ C4::OAI::Description
410 package C4::OAI::ListSets;
412 use strict;
413 use warnings;
414 use HTTP::OAI;
415 use C4::OAI::Sets;
417 use base ("HTTP::OAI::ListSets");
419 sub new {
420 my ( $class, $repository, %args ) = @_;
422 my $self = HTTP::OAI::ListSets->new(%args);
424 my $token = C4::OAI::ResumptionToken->new(%args);
425 my $sets = GetOAISets;
426 my $pos = 0;
427 foreach my $set (@$sets) {
428 if ($pos < $token->{offset}) {
429 $pos++;
430 next;
432 my @descriptions;
433 foreach my $desc (@{$set->{'descriptions'}}) {
434 push @descriptions, C4::OAI::Description->new(
435 setDescription => $desc,
438 $self->set(
439 HTTP::OAI::Set->new(
440 setSpec => $set->{'spec'},
441 setName => $set->{'name'},
442 setDescription => \@descriptions,
445 $pos++;
446 last if ($pos + 1 - $token->{offset}) > $repository->{koha_max_count};
449 $self->resumptionToken(
450 new C4::OAI::ResumptionToken(
451 metadataPrefix => $token->{metadata_prefix},
452 offset => $pos
454 ) if ( $pos > $token->{offset} );
456 return $self;
459 # __END__ C4::OAI::ListSets;
461 package C4::OAI::ListRecords;
463 use strict;
464 use warnings;
465 use HTTP::OAI;
466 use C4::OAI::Sets;
468 use base ("HTTP::OAI::ListRecords");
471 sub new {
472 my ($class, $repository, %args) = @_;
474 my $self = HTTP::OAI::ListRecords->new(%args);
476 my $token = new C4::OAI::ResumptionToken( %args );
477 my $dbh = C4::Context->dbh;
478 my $set;
479 if(defined $token->{'set'}) {
480 $set = GetOAISetBySpec($token->{'set'});
482 my $max = $repository->{koha_max_count};
483 my $sql = "
484 SELECT biblioitems.biblionumber, biblioitems.marcxml, biblioitems.timestamp
485 FROM biblioitems
487 $sql .= " JOIN oai_sets_biblios ON biblioitems.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
488 $sql .= " WHERE DATE(timestamp) >= ? AND DATE(timestamp) <= ? ";
489 $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
490 $sql .= "
491 LIMIT " . ($max + 1) . "
492 OFFSET $token->{offset}
495 my $sth = $dbh->prepare( $sql );
496 my @bind_params = ($token->{'from'}, $token->{'until'});
497 push @bind_params, $set->{'id'} if defined $set;
498 $sth->execute( @bind_params );
500 my $count = 0;
501 while ( my ($biblionumber, $marcxml, $timestamp) = $sth->fetchrow ) {
502 $count++;
503 if ( $count > $max ) {
504 $self->resumptionToken(
505 new C4::OAI::ResumptionToken(
506 metadataPrefix => $token->{metadata_prefix},
507 from => $token->{from},
508 until => $token->{until},
509 offset => $token->{offset} + $max,
510 set => $token->{set}
513 last;
515 my $oai_sets = GetOAISetsBiblio($biblionumber);
516 my @setSpecs;
517 foreach (@$oai_sets) {
518 push @setSpecs, $_->{spec};
520 $self->record( C4::OAI::Record->new(
521 $repository, $marcxml, $timestamp, \@setSpecs,
522 identifier => $repository->{ koha_identifier } . ':' . $biblionumber,
523 metadataPrefix => $token->{metadata_prefix}
524 ) );
527 # Return error if no results
528 unless ($count) {
529 return HTTP::OAI::Response->new(
530 requestURL => $repository->self_url(),
531 errors => [ new HTTP::OAI::Error( code => 'noRecordsMatch' ) ],
535 return $self;
538 # __END__ C4::OAI::ListRecords
542 package C4::OAI::Repository;
544 use base ("HTTP::OAI::Repository");
546 use strict;
547 use warnings;
549 use HTTP::OAI;
550 use HTTP::OAI::Repository qw/:validate/;
552 use XML::SAX::Writer;
553 use XML::LibXML;
554 use XML::LibXSLT;
555 use YAML::Syck qw( LoadFile );
556 use CGI qw/:standard -oldstyle_urls/;
558 use C4::Context;
559 use C4::Biblio;
562 sub new {
563 my ($class, %args) = @_;
564 my $self = $class->SUPER::new(%args);
566 $self->{ koha_identifier } = C4::Context->preference("OAI-PMH:archiveID");
567 $self->{ koha_max_count } = C4::Context->preference("OAI-PMH:MaxCount");
568 $self->{ koha_metadata_format } = ['oai_dc', 'marcxml'];
569 $self->{ koha_stylesheet } = { }; # Build when needed
571 # Load configuration file if defined in OAI-PMH:ConfFile syspref
572 if ( my $file = C4::Context->preference("OAI-PMH:ConfFile") ) {
573 $self->{ conf } = LoadFile( $file );
574 my @formats = keys %{ $self->{conf}->{format} };
575 $self->{ koha_metadata_format } = \@formats;
578 # Check for grammatical errors in the request
579 my @errs = validate_request( CGI::Vars() );
581 # Is metadataPrefix supported by the respository?
582 my $mdp = param('metadataPrefix') || '';
583 if ( $mdp && !grep { $_ eq $mdp } @{$self->{ koha_metadata_format }} ) {
584 push @errs, new HTTP::OAI::Error(
585 code => 'cannotDisseminateFormat',
586 message => "Dissemination as '$mdp' is not supported",
590 my $response;
591 if ( @errs ) {
592 $response = HTTP::OAI::Response->new(
593 requestURL => self_url(),
594 errors => \@errs,
597 else {
598 my %attr = CGI::Vars();
599 my $verb = delete( $attr{verb} );
600 if ( $verb eq 'ListSets' ) {
601 $response = C4::OAI::ListSets->new($self, %attr);
603 elsif ( $verb eq 'Identify' ) {
604 $response = C4::OAI::Identify->new( $self );
606 elsif ( $verb eq 'ListMetadataFormats' ) {
607 $response = C4::OAI::ListMetadataFormats->new( $self );
609 elsif ( $verb eq 'GetRecord' ) {
610 $response = C4::OAI::GetRecord->new( $self, %attr );
612 elsif ( $verb eq 'ListRecords' ) {
613 $response = C4::OAI::ListRecords->new( $self, %attr );
615 elsif ( $verb eq 'ListIdentifiers' ) {
616 $response = C4::OAI::ListIdentifiers->new( $self, %attr );
620 $response->set_handler( XML::SAX::Writer->new( Output => *STDOUT ) );
621 $response->generate;
623 bless $self, $class;
624 return $self;
628 sub stylesheet {
629 my ( $self, $format ) = @_;
631 my $stylesheet = $self->{ koha_stylesheet }->{ $format };
632 unless ( $stylesheet ) {
633 my $xsl_file = $self->{ conf }
634 ? $self->{ conf }->{ format }->{ $format }->{ xsl_file }
635 : ( C4::Context->config('intrahtdocs') .
636 '/prog/en/xslt/' .
637 C4::Context->preference('marcflavour') .
638 'slim2OAIDC.xsl' );
639 my $parser = XML::LibXML->new();
640 my $xslt = XML::LibXSLT->new();
641 my $style_doc = $parser->parse_file( $xsl_file );
642 $stylesheet = $xslt->parse_stylesheet( $style_doc );
643 $self->{ koha_stylesheet }->{ $format } = $stylesheet;
646 return $stylesheet;
651 =head1 NAME
653 C4::OAI::Repository - Handles OAI-PMH requests for a Koha database.
655 =head1 SYNOPSIS
657 use C4::OAI::Repository;
659 my $repository = C4::OAI::Repository->new();
661 =head1 DESCRIPTION
663 This object extend HTTP::OAI::Repository object.
664 It accepts OAI-PMH HTTP requests and returns result.
666 This OAI-PMH server can operate in a simple mode and extended one.
668 In simple mode, repository configuration comes entirely from Koha system
669 preferences (OAI-PMH:archiveID and OAI-PMH:MaxCount) and the server returns
670 records in marcxml or dublin core format. Dublin core records are created from
671 koha marcxml records tranformed with XSLT. Used XSL file is located in
672 koha-tmpl/intranet-tmpl/prog/en/xslt directory and choosed based on marcflavour,
673 respecively MARC21slim2OAIDC.xsl for MARC21 and MARC21slim2OAIDC.xsl for
674 UNIMARC.
676 In extende mode, it's possible to parameter other format than marcxml or Dublin
677 Core. A new syspref OAI-PMH:ConfFile specify a YAML configuration file which
678 list available metadata formats and XSL file used to create them from marcxml
679 records. If this syspref isn't set, Koha OAI server works in simple mode. A
680 configuration file koha-oai.conf can look like that:
683 format:
685 metadataPrefix: vs
686 metadataNamespace: http://veryspecial.tamil.fr/vs/format-pivot/1.1/vs
687 schema: http://veryspecial.tamil.fr/vs/format-pivot/1.1/vs.xsd
688 xsl_file: /usr/local/koha/xslt/vs.xsl
689 marcxml:
690 metadataPrefix: marxml
691 metadataNamespace: http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim
692 schema: http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd
693 oai_dc:
694 metadataPrefix: oai_dc
695 metadataNamespace: http://www.openarchives.org/OAI/2.0/oai_dc/
696 schema: http://www.openarchives.org/OAI/2.0/oai_dc.xsd
697 xsl_file: /usr/local/koha/koha-tmpl/intranet-tmpl/xslt/UNIMARCslim2OAIDC.xsl
699 =cut