7 use CGI qw/:standard -oldstyle_urls/;
13 eval { require PerlIO::gzip };
17 unless ( C4::Context->preference('OAI-PMH') ) {
20 -type => 'text/plain; charset=utf-8',
22 -status => '404 OAI-PMH service is disabled',
24 "OAI-PMH service is disabled";
28 my @encodings = http('HTTP_ACCEPT_ENCODING');
29 if ( $GZIP && grep { defined($_) && $_ eq 'gzip' } @encodings ) {
31 -type => 'text/xml; charset=utf-8',
33 -Content-Encoding => 'gzip',
35 binmode( STDOUT, ":gzip" );
39 -type => 'text/xml; charset=utf-8',
44 binmode( STDOUT, ":utf8" );
45 my $repository = C4::OAI::Repository->new();
51 # Extends HTTP::OAI::ResumptionToken
52 # A token is identified by:
58 package C4::OAI::ResumptionToken;
65 use base ("HTTP::OAI::ResumptionToken");
69 my ($class, %args) = @_;
71 my $self = $class->SUPER::new(%args);
73 my ($metadata_prefix, $offset, $from, $until);
74 if ( $args{ resumptionToken } ) {
75 ($metadata_prefix, $offset, $from, $until)
76 = split( ':', $args{resumptionToken} );
79 $metadata_prefix = $args{ metadataPrefix };
80 $from = $args{ from } || '1970-01-01';
81 $until = $args{ until };
83 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime( time );
84 $until = sprintf( "%.4d-%.2d-%.2d", $year+1900, $mon+1,$mday );
86 $offset = $args{ offset } || 0;
89 $self->{ metadata_prefix } = $metadata_prefix;
90 $self->{ offset } = $offset;
91 $self->{ from } = $from;
92 $self->{ until } = $until;
94 $self->resumptionToken(
95 join( ':', $metadata_prefix, $offset, $from, $until ) );
96 $self->cursor( $offset );
101 # __END__ C4::OAI::ResumptionToken
105 package C4::OAI::Identify;
113 use base ("HTTP::OAI::Identify");
116 my ($class, $repository) = @_;
118 my ($baseURL) = $repository->self_url() =~ /(.*)\?.*/;
119 my $self = $class->SUPER::new(
121 repositoryName => C4::Context->preference("LibraryName"),
122 adminEmail => C4::Context->preference("KohaAdminEmailAddress"),
123 MaxCount => C4::Context->preference("OAI-PMH:MaxCount"),
124 granularity => 'YYYY-MM-DD',
125 earliestDatestamp => '0001-01-01',
126 deletedRecord => 'no',
129 # FIXME - alas, the description element is not so simple; to validate
130 # against the OAI-PMH schema, it cannot contain just a string,
131 # but one or more elements that validate against another XML schema.
132 # For now, simply omitting it.
133 # $self->description( "Koha OAI Repository" );
135 $self->compression( 'gzip' );
140 # __END__ C4::OAI::Identify
144 package C4::OAI::ListMetadataFormats;
151 use base ("HTTP::OAI::ListMetadataFormats");
154 my ($class, $repository) = @_;
156 my $self = $class->SUPER::new();
158 $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
159 metadataPrefix => 'oai_dc',
160 schema => 'http://www.openarchives.org/OAI/2.0/oai_dc.xsd',
161 metadataNamespace => 'http://www.openarchives.org/OAI/2.0/oai_dc/'
163 $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
164 metadataPrefix => 'marcxml',
165 schema => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim.xsd',
166 metadataNamespace => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim'
172 # __END__ C4::OAI::ListMetadataFormats
176 package C4::OAI::Record;
182 use HTTP::OAI::Metadata::OAI_DC;
184 use base ("HTTP::OAI::Record");
187 my ($class, $repository, $marcxml, $timestamp, %args) = @_;
189 my $self = $class->SUPER::new(%args);
191 $timestamp =~ s/ /T/, $timestamp .= 'Z';
192 $self->header( new HTTP::OAI::Header(
193 identifier => $args{identifier},
194 datestamp => $timestamp,
197 my $parser = XML::LibXML->new();
198 my $record_dom = $parser->parse_string( $marcxml );
199 if ( $args{metadataPrefix} ne 'marcxml' ) {
200 $record_dom = $repository->oai_dc_stylesheet()->transform( $record_dom );
202 $self->metadata( HTTP::OAI::Metadata->new( dom => $record_dom ) );
207 # __END__ C4::OAI::Record
211 package C4::OAI::GetRecord;
218 use base ("HTTP::OAI::GetRecord");
222 my ($class, $repository, %args) = @_;
224 my $self = HTTP::OAI::GetRecord->new(%args);
226 my $dbh = C4::Context->dbh;
227 my $sth = $dbh->prepare("
228 SELECT marcxml, timestamp
230 WHERE biblionumber=? " );
231 my $prefix = $repository->{koha_identifier} . ':';
232 my ($biblionumber) = $args{identifier} =~ /^$prefix(.*)/;
233 $sth->execute( $biblionumber );
234 my ($marcxml, $timestamp);
235 unless ( ($marcxml, $timestamp) = $sth->fetchrow ) {
236 return HTTP::OAI::Response->new(
237 requestURL => $repository->self_url(),
238 errors => [ new HTTP::OAI::Error(
239 code => 'idDoesNotExist',
240 message => "There is no biblio record with this identifier",
245 #$self->header( HTTP::OAI::Header->new( identifier => $args{identifier} ) );
246 $self->record( C4::OAI::Record->new(
247 $repository, $marcxml, $timestamp, %args ) );
252 # __END__ C4::OAI::GetRecord
256 package C4::OAI::ListIdentifiers;
263 use base ("HTTP::OAI::ListIdentifiers");
267 my ($class, $repository, %args) = @_;
269 my $self = HTTP::OAI::ListIdentifiers->new(%args);
271 my $token = new C4::OAI::ResumptionToken( %args );
272 my $dbh = C4::Context->dbh;
273 my $sql = "SELECT biblionumber, timestamp
275 WHERE timestamp >= ? AND timestamp <= ?
276 LIMIT " . $repository->{koha_max_count} . "
277 OFFSET " . $token->{offset};
278 my $sth = $dbh->prepare( $sql );
279 $sth->execute( $token->{from}, $token->{until} );
281 my $pos = $token->{offset};
282 while ( my ($biblionumber, $timestamp) = $sth->fetchrow ) {
283 $timestamp =~ s/ /T/, $timestamp .= 'Z';
284 $self->identifier( new HTTP::OAI::Header(
285 identifier => $repository->{ koha_identifier} . ':' . $biblionumber,
286 datestamp => $timestamp,
290 $self->resumptionToken( new C4::OAI::ResumptionToken(
291 metadataPrefix => $token->{metadata_prefix},
292 from => $token->{from},
293 until => $token->{until},
299 # __END__ C4::OAI::ListIdentifiers
303 package C4::OAI::ListRecords;
310 use base ("HTTP::OAI::ListRecords");
314 my ($class, $repository, %args) = @_;
316 my $self = HTTP::OAI::ListRecords->new(%args);
318 my $token = new C4::OAI::ResumptionToken( %args );
319 my $dbh = C4::Context->dbh;
320 my $sql = "SELECT biblionumber, marcxml, timestamp
322 WHERE timestamp >= ? AND timestamp <= ?
323 LIMIT " . $repository->{koha_max_count} . "
324 OFFSET " . $token->{offset};
325 my $sth = $dbh->prepare( $sql );
326 $sth->execute( $token->{from}, $token->{until} );
328 my $pos = $token->{offset};
329 while ( my ($biblionumber, $marcxml, $timestamp) = $sth->fetchrow ) {
330 $self->record( C4::OAI::Record->new(
331 $repository, $marcxml, $timestamp,
332 identifier => $repository->{ koha_identifier } . ':' . $biblionumber,
333 metadataPrefix => $token->{metadata_prefix}
337 $self->resumptionToken( new C4::OAI::ResumptionToken(
338 metadataPrefix => $token->{metadata_prefix},
339 from => $token->{from},
340 until => $token->{until},
346 # __END__ C4::OAI::ListRecords
350 package C4::OAI::Repository;
352 use base ("HTTP::OAI::Repository");
359 use HTTP::OAI::Repository qw/:validate/;
361 use XML::SAX::Writer;
364 use CGI qw/:standard -oldstyle_urls/;
372 C4::OAI::Repository - Handles OAI-PMH requests for a Koha database.
376 use C4::OAI::Repository;
378 my $repository = C4::OAI::Repository->new();
382 This object extend HTTP::OAI::Repository object.
389 my ($class, %args) = @_;
390 my $self = $class->SUPER::new(%args);
392 $self->{ koha_identifier } = C4::Context->preference("OAI-PMH:archiveID");
393 $self->{ koha_max_count } = C4::Context->preference("OAI-PMH:MaxCount");
394 $self->{ koha_metadata_format } = ['oai_dc', 'marcxml'];
396 # Check for grammatical errors in the request
397 my @errs = validate_request( CGI::Vars() );
399 # Is metadataPrefix supported by the respository?
400 my $mdp = param('metadataPrefix') || '';
401 if ( $mdp && !grep { $_ eq $mdp } @{$self->{ koha_metadata_format }} ) {
402 push @errs, new HTTP::OAI::Error(
403 code => 'cannotDisseminateFormat',
404 message => "Dissemination as '$mdp' is not supported",
410 $response = HTTP::OAI::Response->new(
411 requestURL => self_url(),
416 my %attr = CGI::Vars();
417 my $verb = delete( $attr{verb} );
418 if ( grep { $_ eq $verb } qw( ListSets ) ) {
419 $response = HTTP::OAI::Response->new(
420 requestURL => $self->self_url(),
421 errors => [ new HTTP::OAI::Error(
422 code => 'noSetHierarchy',
423 message => "Koha repository doesn't have sets",
427 elsif ( $verb eq 'Identify' ) {
428 $response = C4::OAI::Identify->new( $self );
430 elsif ( $verb eq 'ListMetadataFormats' ) {
431 $response = C4::OAI::ListMetadataFormats->new( $self );
433 elsif ( $verb eq 'GetRecord' ) {
434 $response = C4::OAI::GetRecord->new( $self, %attr );
436 elsif ( $verb eq 'ListRecords' ) {
437 $response = C4::OAI::ListRecords->new( $self, %attr );
439 elsif ( $verb eq 'ListIdentifiers' ) {
440 $response = C4::OAI::ListIdentifiers->new( $self, %attr );
444 $response->set_handler( XML::SAX::Writer->new( Output => *STDOUT ) );
453 # XSLT stylesheet used to transform MARCXML record into OAI Dublin Core.
454 # The object is constructed the fist time this method is called.
456 # Styleeet file is located in /koha-tmpl/intranet-tmpl/prog/en/xslt/ directory.
457 # Its name is constructed with 'marcflavour' syspref:
458 # - MARC21slim2OAIDC.xsl
459 # - UNIMARCslim2OADIC.xsl
461 sub oai_dc_stylesheet {
464 unless ( $self->{ oai_dc_stylesheet } ) {
465 my $xslt_file = C4::Context->config('intranetdir') .
466 "/koha-tmpl/intranet-tmpl/prog/en/xslt/" .
467 C4::Context->preference('marcflavour') .
469 my $parser = XML::LibXML->new();
470 my $xslt = XML::LibXSLT->new();
471 my $style_doc = $parser->parse_file( $xslt_file );
472 my $stylesheet = $xslt->parse_stylesheet( $style_doc );
473 $self->{ oai_dc_stylesheet } = $stylesheet;
476 return $self->{ oai_dc_stylesheet };