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     if ( $repository->{ conf } ) {
 159         foreach my $name ( @{ $repository->{ koha_metadata_format } } ) {
 160             my $format = $repository->{ conf }->{ format }->{ $name };
 161             $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
 162                 metadataPrefix    => $format->{metadataPrefix},
 163                 schema            => $format->{schema},
 164                 metadataNamespace => $format->{metadataNamespace}, ) );
 165         }
 166     }
 167     else {
 168         $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
 169             metadataPrefix    => 'oai_dc',
 170             schema            => 'http://www.openarchives.org/OAI/2.0/oai_dc.xsd',
 171             metadataNamespace => 'http://www.openarchives.org/OAI/2.0/oai_dc/'
 172         ) );
 173         $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
 174             metadataPrefix    => 'marcxml',
 175             schema            => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim.xsd',
 176             metadataNamespace => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim'
 177         ) );
 178     }
 179
 180     return $self;
 181 }
 182
 183 # __END__ C4::OAI::ListMetadataFormats
 184
 185
 186
 187 package C4::OAI::Record;
 188
 189 use strict;
 190 use warnings;
 191 use diagnostics;
 192 use HTTP::OAI;
 193 use HTTP::OAI::Metadata::OAI_DC;
 194
 195 use base ("HTTP::OAI::Record");
 196
 197 sub new {
 198     my ($class, $repository, $marcxml, $timestamp, %args) = @_;
 199
 200     my $self = $class->SUPER::new(%args);
 201
 202     $timestamp =~ s/ /T/, $timestamp .= 'Z';
 203     $self->header( new HTTP::OAI::Header(
 204         identifier  => $args{identifier},
 205         datestamp   => $timestamp,
 206     ) );
 207
 208     my $parser = XML::LibXML->new();
 209     my $record_dom = $parser->parse_string( $marcxml );
 210     my $format =  $args{metadataPrefix};
 211     if ( $format ne 'marcxml' ) {
 212         $record_dom = $repository->stylesheet($format)->transform( $record_dom );
 213     }
 214     $self->metadata( HTTP::OAI::Metadata->new( dom => $record_dom ) );
 215
 216     return $self;
 217 }
 218
 219 # __END__ C4::OAI::Record
 220
 221
 222
 223 package C4::OAI::GetRecord;
 224
 225 use strict;
 226 use warnings;
 227 use diagnostics;
 228 use HTTP::OAI;
 229
 230 use base ("HTTP::OAI::GetRecord");
 231
 232
 233 sub new {
 234     my ($class, $repository, %args) = @_;
 235
 236     my $self = HTTP::OAI::GetRecord->new(%args);
 237
 238     my $dbh = C4::Context->dbh;
 239     my $sth = $dbh->prepare("
 240         SELECT marcxml, timestamp
 241         FROM   biblioitems
 242         WHERE  biblionumber=? " );
 243     my $prefix = $repository->{koha_identifier} . ':';
 244     my ($biblionumber) = $args{identifier} =~ /^$prefix(.*)/;
 245     $sth->execute( $biblionumber );
 246     my ($marcxml, $timestamp);
 247     unless ( ($marcxml, $timestamp) = $sth->fetchrow ) {
 248         return HTTP::OAI::Response->new(
 249             requestURL  => $repository->self_url(),
 250             errors      => [ new HTTP::OAI::Error(
 251                 code    => 'idDoesNotExist',
 252                 message => "There is no biblio record with this identifier",
 253                 ) ] ,
 254         );
 255     }
 256
 257     #$self->header( HTTP::OAI::Header->new( identifier  => $args{identifier} ) );
 258     $self->record( C4::OAI::Record->new(
 259         $repository, $marcxml, $timestamp, %args ) );
 260
 261     return $self;
 262 }
 263
 264 # __END__ C4::OAI::GetRecord
 265
 266
 267
 268 package C4::OAI::ListIdentifiers;
 269
 270 use strict;
 271 use warnings;
 272 use diagnostics;
 273 use HTTP::OAI;
 274
 275 use base ("HTTP::OAI::ListIdentifiers");
 276
 277
 278 sub new {
 279     my ($class, $repository, %args) = @_;
 280
 281     my $self = HTTP::OAI::ListIdentifiers->new(%args);
 282
 283     my $token = new C4::OAI::ResumptionToken( %args );
 284     my $dbh = C4::Context->dbh;
 285     my $sql = "SELECT biblionumber, timestamp
 286                FROM   biblioitems
 287                WHERE  timestamp >= ? AND timestamp <= ?
 288                LIMIT  " . $repository->{koha_max_count} . "
 289                OFFSET " . $token->{offset};
 290     my $sth = $dbh->prepare( $sql );
 291         $sth->execute( $token->{from}, $token->{until} );
 292
 293     my $pos = $token->{offset};
 294         while ( my ($biblionumber, $timestamp) = $sth->fetchrow ) {
 295             $timestamp =~ s/ /T/, $timestamp .= 'Z';
 296         $self->identifier( new HTTP::OAI::Header(
 297             identifier => $repository->{ koha_identifier} . ':' . $biblionumber,
 298             datestamp  => $timestamp,
 299         ) );
 300         $pos++;
 301         }
 302         $self->resumptionToken( new C4::OAI::ResumptionToken(
 303         metadataPrefix  => $token->{metadata_prefix},
 304         from            => $token->{from},
 305         until           => $token->{until},
 306         offset          => $pos ) ) if ($pos > $token->{offset});
 307
 308     return $self;
 309 }
 310
 311 # __END__ C4::OAI::ListIdentifiers
 312
 313
 314
 315 package C4::OAI::ListRecords;
 316
 317 use strict;
 318 use warnings;
 319 use diagnostics;
 320 use HTTP::OAI;
 321
 322 use base ("HTTP::OAI::ListRecords");
 323
 324
 325 sub new {
 326     my ($class, $repository, %args) = @_;
 327
 328     my $self = HTTP::OAI::ListRecords->new(%args);
 329
 330     my $token = new C4::OAI::ResumptionToken( %args );
 331     my $dbh = C4::Context->dbh;
 332     my $sql = "SELECT biblionumber, marcxml, timestamp
 333                FROM   biblioitems
 334                WHERE  timestamp >= ? AND timestamp <= ?
 335                LIMIT  " . $repository->{koha_max_count} . "
 336                OFFSET " . $token->{offset};
 337     my $sth = $dbh->prepare( $sql );
 338         $sth->execute( $token->{from}, $token->{until} );
 339
 340     my $pos = $token->{offset};
 341         while ( my ($biblionumber, $marcxml, $timestamp) = $sth->fetchrow ) {
 342         $self->record( C4::OAI::Record->new(
 343             $repository, $marcxml, $timestamp,
 344             identifier      => $repository->{ koha_identifier } . ':' . $biblionumber,
 345             metadataPrefix  => $token->{metadata_prefix}
 346         ) );
 347         $pos++;
 348         }
 349         $self->resumptionToken( new C4::OAI::ResumptionToken(
 350         metadataPrefix  => $token->{metadata_prefix},
 351         from            => $token->{from},
 352         until           => $token->{until},
 353         offset          => $pos ) ) if ($pos > $token->{offset});
 354
 355     return $self;
 356 }
 357
 358 # __END__ C4::OAI::ListRecords
 359
 360
 361
 362 package C4::OAI::Repository;
 363
 364 use base ("HTTP::OAI::Repository");
 365
 366 use strict;
 367 use warnings;
 368 use diagnostics;
 369
 370 use HTTP::OAI;
 371 use HTTP::OAI::Repository qw/:validate/;
 372
 373 use XML::SAX::Writer;
 374 use XML::LibXML;
 375 use XML::LibXSLT;
 376 use YAML::Syck qw( LoadFile );
 377 use CGI qw/:standard -oldstyle_urls/;
 378
 379 use C4::Context;
 380 use C4::Biblio;
 381
 382
 383 sub new {
 384     my ($class, %args) = @_;
 385     my $self = $class->SUPER::new(%args);
 386
 387     $self->{ koha_identifier      } = C4::Context->preference("OAI-PMH:archiveID");
 388     $self->{ koha_max_count       } = C4::Context->preference("OAI-PMH:MaxCount");
 389     $self->{ koha_metadata_format } = ['oai_dc', 'marcxml'];
 390     $self->{ koha_stylesheet      } = { }; # Build when needed
 391
 392     # Load configuration file if defined in OAI-PMH:ConfFile syspref
 393     if ( my $file = C4::Context->preference("OAI-PMH:ConfFile") ) {
 394         $self->{ conf } = LoadFile( $file );
 395         my @formats = keys %{ $self->{conf}->{format} };
 396         $self->{ koha_metadata_format } =  \@formats;
 397     }
 398
 399     # Check for grammatical errors in the request
 400     my @errs = validate_request( CGI::Vars() );
 401
 402     # Is metadataPrefix supported by the respository?
 403     my $mdp = param('metadataPrefix') || '';
 404     if ( $mdp && !grep { $_ eq $mdp } @{$self->{ koha_metadata_format }} ) {
 405         push @errs, new HTTP::OAI::Error(
 406             code    => 'cannotDisseminateFormat',
 407             message => "Dissemination as '$mdp' is not supported",
 408         );
 409     }
 410
 411     my $response;
 412     if ( @errs ) {
 413         $response = HTTP::OAI::Response->new(
 414             requestURL  => self_url(),
 415             errors      => \@errs,
 416         );
 417     }
 418     else {
 419         my %attr = CGI::Vars();
 420         my $verb = delete( $attr{verb} );
 421         if ( grep { $_ eq $verb } qw( ListSets ) ) {
 422             $response = HTTP::OAI::Response->new(
 423                 requestURL  => $self->self_url(),
 424                 errors      => [ new HTTP::OAI::Error(
 425                     code    => 'noSetHierarchy',
 426                     message => "Koha repository doesn't have sets",
 427                     ) ] ,
 428             );
 429         }
 430         elsif ( $verb eq 'Identify' ) {
 431             $response = C4::OAI::Identify->new( $self );
 432         }
 433         elsif ( $verb eq 'ListMetadataFormats' ) {
 434             $response = C4::OAI::ListMetadataFormats->new( $self );
 435         }
 436         elsif ( $verb eq 'GetRecord' ) {
 437             $response = C4::OAI::GetRecord->new( $self, %attr );
 438         }
 439         elsif ( $verb eq 'ListRecords' ) {
 440             $response = C4::OAI::ListRecords->new( $self, %attr );
 441         }
 442         elsif ( $verb eq 'ListIdentifiers' ) {
 443             $response = C4::OAI::ListIdentifiers->new( $self, %attr );
 444         }
 445     }
 446
 447     $response->set_handler( XML::SAX::Writer->new( Output => *STDOUT ) );
 448     $response->generate;
 449
 450     bless $self, $class;
 451     return $self;
 452 }
 453
 454
 455 sub stylesheet {
 456     my ( $self, $format ) = @_;
 457
 458     my $stylesheet = $self->{ koha_stylesheet }->{ $format };
 459     unless ( $stylesheet ) {
 460         my $xsl_file = $self->{ conf }
 461                        ? $self->{ conf }->{ format }->{ $format }->{ xsl_file }
 462                        : ( C4::Context->config('intrahtdocs') .
 463                          '/prog/en/xslt/' .
 464                          C4::Context->preference('marcflavour') .
 465                          'slim2OAIDC.xsl' );
 466         my $parser = XML::LibXML->new();
 467         my $xslt = XML::LibXSLT->new();
 468         my $style_doc = $parser->parse_file( $xsl_file );
 469         $stylesheet = $xslt->parse_stylesheet( $style_doc );
 470         $self->{ koha_stylesheet }->{ $format } = $stylesheet;
 471     }
 472
 473     return $stylesheet;
 474 }
 475
 476
 477
 478 =head1 NAME
 479
 480 C4::OAI::Repository - Handles OAI-PMH requests for a Koha database.
 481
 482 =head1 SYNOPSIS
 483
 484   use C4::OAI::Repository;
 485
 486   my $repository = C4::OAI::Repository->new();
 487
 488 =head1 DESCRIPTION
 489
 490 This object extend HTTP::OAI::Repository object.
 491 It accepts OAI-PMH HTTP requests and returns result.
 492
 493 This OAI-PMH server can operate in a simple mode and extended one.
 494
 495 In simple mode, repository configuration comes entirely from Koha system
 496 preferences (OAI-PMH:archiveID and OAI-PMH:MaxCount) and the server returns
 497 records in marcxml or dublin core format. Dublin core records are created from
 498 koha marcxml records tranformed with XSLT. Used XSL file is located in
 499 koha-tmpl/intranet-tmpl/prog/en/xslt directory and choosed based on marcflavour,
 500 respecively MARC21slim2OAIDC.xsl for MARC21 and  MARC21slim2OAIDC.xsl for
 501 UNIMARC.
 502
 503 In extende mode, it's possible to parameter other format than marcxml or Dublin
 504 Core. A new syspref OAI-PMH:ConfFile specify a YAML configuration file which
 505 list available metadata formats and XSL file used to create them from marcxml
 506 records. If this syspref isn't set, Koha OAI server works in simple mode. A
 507 configuration file koha-oai.conf can look like that:
 508
 509   ---
 510   format:
 511     vs:
 512       metadataPrefix: vs
 513       metadataNamespace: http://veryspecial.tamil.fr/vs/format-pivot/1.1/vs
 514       schema: http://veryspecial.tamil.fr/vs/format-pivot/1.1/vs.xsd
 515       xsl_file: /usr/local/koha/xslt/vs.xsl
 516     marcxml:
 517       metadataPrefix: marxml
 518       metadataNamespace: http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim
 519       schema: http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd
 520     oai_dc:
 521       metadataPrefix: oai_dc
 522       metadataNamespace: http://www.openarchives.org/OAI/2.0/oai_dc/
 523       schema: http://www.openarchives.org/OAI/2.0/oai_dc.xsd
 524       xsl_file: /usr/local/koha/koha-tmpl/intranet-tmpl/xslt/UNIMARCslim2OAIDC.xsl
 525
 526 =cut
 527
 528
 529