opac/oai.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use diagnostics;
   6
   7 use CGI qw/:standard -oldstyle_urls/;
   8 use vars qw( $GZIP );
   9 use C4::Context;
  10
  11
  12 BEGIN {
  13     eval { require PerlIO::gzip };
  14     $GZIP = $@ ? 0 : 1;
  15 }
  16
  17 unless ( C4::Context->preference('OAI-PMH') ) {
  18     print
  19         header(
  20             -type       => 'text/plain; charset=utf-8',
  21             -charset    => 'utf-8',
  22             -status     => '404 OAI-PMH service is disabled',
  23         ),
  24         "OAI-PMH service is disabled";
  25     exit;
  26 }
  27
  28 my @encodings = http('HTTP_ACCEPT_ENCODING');
  29 if ( $GZIP && grep { defined($_) && $_ eq 'gzip' } @encodings ) {
  30     print header(
  31         -type               => 'text/xml; charset=utf-8',
  32         -charset            => 'utf-8',
  33         -Content-Encoding   => 'gzip',
  34     );
  35     binmode( STDOUT, ":gzip" );
  36 }
  37 else {
  38     print header(
  39         -type       => 'text/xml; charset=utf-8',
  40         -charset    => 'utf-8',
  41     );
  42 }
  43
  44 binmode( STDOUT, ":utf8" );
  45 my $repository = C4::OAI::Repository->new();
  46
  47 # __END__ Main Prog
  48
  49
  50 #
  51 # Extends HTTP::OAI::ResumptionToken
  52 # A token is identified by:
  53 # - metadataPrefix
  54 # - from
  55 # - until
  56 # - offset
  57 #
  58 package C4::OAI::ResumptionToken;
  59
  60 use strict;
  61 use warnings;
  62 use diagnostics;
  63 use HTTP::OAI;
  64
  65 use base ("HTTP::OAI::ResumptionToken");
  66
  67
  68 sub new {
  69     my ($class, %args) = @_;
  70
  71     my $self = $class->SUPER::new(%args);
  72
  73     my ($metadata_prefix, $offset, $from, $until);
  74     if ( $args{ resumptionToken } ) {
  75         ($metadata_prefix, $offset, $from, $until)
  76             = split( ':', $args{resumptionToken} );
  77     }
  78     else {
  79         $metadata_prefix = $args{ metadataPrefix };
  80         $from = $args{ from } || '1970-01-01';
  81         $until = $args{ until };
  82         unless ( $until) {
  83             my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime( time );
  84             $until = sprintf( "%.4d-%.2d-%.2d", $year+1900, $mon+1,$mday );
  85         }
  86         $offset = $args{ offset } || 0;
  87     }
  88
  89     $self->{ metadata_prefix } = $metadata_prefix;
  90     $self->{ offset          } = $offset;
  91     $self->{ from            } = $from;
  92     $self->{ until           } = $until;
  93
  94     $self->resumptionToken(
  95         join( ':', $metadata_prefix, $offset, $from, $until ) );
  96     $self->cursor( $offset );
  97
  98     return $self;
  99 }
 100
 101 # __END__ C4::OAI::ResumptionToken
 102
 103
 104
 105 package C4::OAI::Identify;
 106
 107 use strict;
 108 use warnings;
 109 use diagnostics;
 110 use HTTP::OAI;
 111 use C4::Context;
 112
 113 use base ("HTTP::OAI::Identify");
 114
 115 sub new {
 116     my ($class, $repository) = @_;
 117
 118     my ($baseURL) = $repository->self_url() =~ /(.*)\?.*/;
 119     my $self = $class->SUPER::new(
 120         baseURL             => $baseURL,
 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',
 127     );
 128
 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" );
 134
 135     $self->compression( 'gzip' );
 136
 137     return $self;
 138 }
 139
 140 # __END__ C4::OAI::Identify
 141
 142
 143
 144 package C4::OAI::ListMetadataFormats;
 145
 146 use strict;
 147 use warnings;
 148 use diagnostics;
 149 use HTTP::OAI;
 150
 151 use base ("HTTP::OAI::ListMetadataFormats");
 152
 153 sub new {
 154     my ($class, $repository) = @_;
 155
 156     my $self = $class->SUPER::new();
 157
 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/'
 162     ) );
 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'
 167     ) );
 168
 169     return $self;
 170 }
 171
 172 # __END__ C4::OAI::ListMetadataFormats
 173
 174
 175
 176 package C4::OAI::Record;
 177
 178 use strict;
 179 use warnings;
 180 use diagnostics;
 181 use HTTP::OAI;
 182 use HTTP::OAI::Metadata::OAI_DC;
 183
 184 use base ("HTTP::OAI::Record");
 185
 186 sub new {
 187     my ($class, $repository, $marcxml, $timestamp, %args) = @_;
 188
 189     my $self = $class->SUPER::new(%args);
 190
 191     $timestamp =~ s/ /T/, $timestamp .= 'Z';
 192     $self->header( new HTTP::OAI::Header(
 193         identifier  => $args{identifier},
 194         datestamp   => $timestamp,
 195     ) );
 196
 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 );
 201     }
 202     $self->metadata( HTTP::OAI::Metadata->new( dom => $record_dom ) );
 203
 204     return $self;
 205 }
 206
 207 # __END__ C4::OAI::Record
 208
 209
 210
 211 package C4::OAI::GetRecord;
 212
 213 use strict;
 214 use warnings;
 215 use diagnostics;
 216 use HTTP::OAI;
 217
 218 use base ("HTTP::OAI::GetRecord");
 219
 220
 221 sub new {
 222     my ($class, $repository, %args) = @_;
 223
 224     my $self = HTTP::OAI::GetRecord->new(%args);
 225
 226     my $dbh = C4::Context->dbh;
 227     my $sth = $dbh->prepare("
 228         SELECT marcxml, timestamp
 229         FROM   biblioitems
 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",
 241                 ) ] ,
 242         );
 243     }
 244
 245     #$self->header( HTTP::OAI::Header->new( identifier  => $args{identifier} ) );
 246     $self->record( C4::OAI::Record->new(
 247         $repository, $marcxml, $timestamp, %args ) );
 248
 249     return $self;
 250 }
 251
 252 # __END__ C4::OAI::GetRecord
 253
 254
 255
 256 package C4::OAI::ListIdentifiers;
 257
 258 use strict;
 259 use warnings;
 260 use diagnostics;
 261 use HTTP::OAI;
 262
 263 use base ("HTTP::OAI::ListIdentifiers");
 264
 265
 266 sub new {
 267     my ($class, $repository, %args) = @_;
 268
 269     my $self = HTTP::OAI::ListIdentifiers->new(%args);
 270
 271     my $token = new C4::OAI::ResumptionToken( %args );
 272     my $dbh = C4::Context->dbh;
 273     my $sql = "SELECT biblionumber, timestamp
 274                FROM   biblioitems
 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} );
 280
 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,
 287         ) );
 288         $pos++;
 289         }
 290         $self->resumptionToken( new C4::OAI::ResumptionToken(
 291         metadataPrefix  => $token->{metadata_prefix},
 292         from            => $token->{from},
 293         until           => $token->{until},
 294         offset          => $pos ) );
 295
 296     return $self;
 297 }
 298
 299 # __END__ C4::OAI::ListIdentifiers
 300
 301
 302
 303 package C4::OAI::ListRecords;
 304
 305 use strict;
 306 use warnings;
 307 use diagnostics;
 308 use HTTP::OAI;
 309
 310 use base ("HTTP::OAI::ListRecords");
 311
 312
 313 sub new {
 314     my ($class, $repository, %args) = @_;
 315
 316     my $self = HTTP::OAI::ListRecords->new(%args);
 317
 318     my $token = new C4::OAI::ResumptionToken( %args );
 319     my $dbh = C4::Context->dbh;
 320     my $sql = "SELECT biblionumber, marcxml, timestamp
 321                FROM   biblioitems
 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} );
 327
 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}
 334         ) );
 335         $pos++;
 336         }
 337         $self->resumptionToken( new C4::OAI::ResumptionToken(
 338         metadataPrefix  => $token->{metadata_prefix},
 339         from            => $token->{from},
 340         until           => $token->{until},
 341         offset          => $pos ) );
 342
 343     return $self;
 344 }
 345
 346 # __END__ C4::OAI::ListRecords
 347
 348
 349
 350 package C4::OAI::Repository;
 351
 352 use base ("HTTP::OAI::Repository");
 353
 354 use strict;
 355 use warnings;
 356 use diagnostics;
 357
 358 use HTTP::OAI;
 359 use HTTP::OAI::Repository qw/:validate/;
 360
 361 use XML::SAX::Writer;
 362 use XML::LibXML;
 363 use XML::LibXSLT;
 364 use CGI qw/:standard -oldstyle_urls/;
 365
 366 use C4::Context;
 367 use C4::Biblio;
 368
 369
 370 =head1 NAME
 371
 372 C4::OAI::Repository - Handles OAI-PMH requests for a Koha database.
 373
 374 =head1 SYNOPSIS
 375
 376   use C4::OAI::Repository;
 377
 378   my $repository = C4::OAI::Repository->new();
 379
 380 =head1 DESCRIPTION
 381
 382 This object extend HTTP::OAI::Repository object.
 383
 384 =cut
 385
 386
 387
 388 sub new {
 389     my ($class, %args) = @_;
 390     my $self = $class->SUPER::new(%args);
 391
 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'];
 395
 396     # Check for grammatical errors in the request
 397     my @errs = validate_request( CGI::Vars() );
 398
 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",
 405         );
 406     }
 407
 408     my $response;
 409     if ( @errs ) {
 410         $response = HTTP::OAI::Response->new(
 411             requestURL  => self_url(),
 412             errors      => \@errs,
 413         );
 414     }
 415     else {
 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",
 424                     ) ] ,
 425             );
 426         }
 427         elsif ( $verb eq 'Identify' ) {
 428             $response = C4::OAI::Identify->new( $self );
 429         }
 430         elsif ( $verb eq 'ListMetadataFormats' ) {
 431             $response = C4::OAI::ListMetadataFormats->new( $self );
 432         }
 433         elsif ( $verb eq 'GetRecord' ) {
 434             $response = C4::OAI::GetRecord->new( $self, %attr );
 435         }
 436         elsif ( $verb eq 'ListRecords' ) {
 437             $response = C4::OAI::ListRecords->new( $self, %attr );
 438         }
 439         elsif ( $verb eq 'ListIdentifiers' ) {
 440             $response = C4::OAI::ListIdentifiers->new( $self, %attr );
 441         }
 442     }
 443
 444     $response->set_handler( XML::SAX::Writer->new( Output => *STDOUT ) );
 445     $response->generate;
 446
 447     bless $self, $class;
 448     return $self;
 449 }
 450
 451
 452 #
 453 # XSLT stylesheet used to transform MARCXML record into OAI Dublin Core.
 454 # The object is constructed the fist time this method is called.
 455 #
 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
 460 #
 461 sub oai_dc_stylesheet {
 462     my $self = shift;
 463
 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') .
 468                         "slim2OAIDC.xsl";
 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;
 474     }
 475
 476     return $self->{ oai_dc_stylesheet };
 477 }
 478