opac/oai.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright Biblibre 2008
   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
  21 use strict;
  22 use warnings;
  23
  24 use CGI qw( :standard -oldstyle_urls -utf8 );
  25 use vars qw( $GZIP );
  26 use C4::Context;
  27
  28
  29 BEGIN {
  30     eval { require PerlIO::gzip };
  31     $GZIP = ($@) ? 0 : 1;
  32 }
  33
  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',
  40         ),
  41         "OAI-PMH service is disabled";
  42     exit;
  43 }
  44
  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',
  51     );
  52     binmode( STDOUT, ":gzip" );
  53 }
  54 else {
  55     print header(
  56         -type       => 'text/xml; charset=utf-8',
  57         -charset    => 'utf-8',
  58     );
  59 }
  60
  61 binmode STDOUT, ':encoding(UTF-8)';
  62 my $repository = C4::OAI::Repository->new();
  63
  64 # __END__ Main Prog
  65
  66
  67 #
  68 # Extends HTTP::OAI::ResumptionToken
  69 # A token is identified by:
  70 # - metadataPrefix
  71 # - from
  72 # - until
  73 # - offset
  74 #
  75 package C4::OAI::ResumptionToken;
  76
  77 use strict;
  78 use warnings;
  79 use HTTP::OAI;
  80
  81 use base ("HTTP::OAI::ResumptionToken");
  82
  83
  84 sub new {
  85     my ($class, %args) = @_;
  86
  87     my $self = $class->SUPER::new(%args);
  88
  89     my ($metadata_prefix, $offset, $from, $until, $set);
  90     if ( $args{ resumptionToken } ) {
  91         ($metadata_prefix, $offset, $from, $until, $set)
  92             = split( '/', $args{resumptionToken} );
  93     }
  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 );
 101         }
 102         $offset = $args{ offset } || 0;
 103         $set = $args{set};
 104     }
 105
 106     $self->{ metadata_prefix } = $metadata_prefix;
 107     $self->{ offset          } = $offset;
 108     $self->{ from            } = $from;
 109     $self->{ until           } = $until;
 110     $self->{ set             } = $set;
 111
 112     $self->resumptionToken(
 113         join( '/', $metadata_prefix, $offset, $from, $until, $set ) );
 114     $self->cursor( $offset );
 115
 116     return $self;
 117 }
 118
 119 # __END__ C4::OAI::ResumptionToken
 120
 121
 122
 123 package C4::OAI::Identify;
 124
 125 use strict;
 126 use warnings;
 127 use HTTP::OAI;
 128 use C4::Context;
 129
 130 use base ("HTTP::OAI::Identify");
 131
 132 sub new {
 133     my ($class, $repository) = @_;
 134
 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',
 144     );
 145
 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" );
 151
 152     $self->compression( 'gzip' );
 153
 154     return $self;
 155 }
 156
 157 # __END__ C4::OAI::Identify
 158
 159
 160
 161 package C4::OAI::ListMetadataFormats;
 162
 163 use strict;
 164 use warnings;
 165 use HTTP::OAI;
 166
 167 use base ("HTTP::OAI::ListMetadataFormats");
 168
 169 sub new {
 170     my ($class, $repository) = @_;
 171
 172     my $self = $class->SUPER::new();
 173
 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}, ) );
 181         }
 182     }
 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         ) );
 194     }
 195
 196     return $self;
 197 }
 198
 199 # __END__ C4::OAI::ListMetadataFormats
 200
 201
 202
 203 package C4::OAI::Record;
 204
 205 use strict;
 206 use warnings;
 207 use HTTP::OAI;
 208 use HTTP::OAI::Metadata::OAI_DC;
 209
 210 use base ("HTTP::OAI::Record");
 211
 212 sub new {
 213     my ($class, $repository, $marcxml, $timestamp, $setSpecs, %args) = @_;
 214
 215     my $self = $class->SUPER::new(%args);
 216
 217     $timestamp =~ s/ /T/, $timestamp .= 'Z';
 218     $self->header( new HTTP::OAI::Header(
 219         identifier  => $args{identifier},
 220         datestamp   => $timestamp,
 221     ) );
 222
 223     foreach my $setSpec (@$setSpecs) {
 224         $self->header->setSpec($setSpec);
 225     }
 226
 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') . "'"
 233         );
 234         $record_dom = $repository->stylesheet($format)->transform($record_dom, %args);
 235     }
 236     $self->metadata( HTTP::OAI::Metadata->new( dom => $record_dom ) );
 237
 238     return $self;
 239 }
 240
 241 # __END__ C4::OAI::Record
 242
 243
 244
 245 package C4::OAI::GetRecord;
 246
 247 use strict;
 248 use warnings;
 249 use HTTP::OAI;
 250 use C4::OAI::Sets;
 251
 252 use base ("HTTP::OAI::GetRecord");
 253
 254
 255 sub new {
 256     my ($class, $repository, %args) = @_;
 257
 258     my $self = HTTP::OAI::GetRecord->new(%args);
 259
 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                 ) ] ,
 276         );
 277     }
 278
 279     my $oai_sets = GetOAISetsBiblio($biblionumber);
 280     my @setSpecs;
 281     foreach (@$oai_sets) {
 282         push @setSpecs, $_->{spec};
 283     }
 284
 285     #$self->header( HTTP::OAI::Header->new( identifier  => $args{identifier} ) );
 286     $self->record( C4::OAI::Record->new(
 287         $repository, $marcxml, $timestamp, \@setSpecs, %args ) );
 288
 289     return $self;
 290 }
 291
 292 # __END__ C4::OAI::GetRecord
 293
 294
 295
 296 package C4::OAI::ListIdentifiers;
 297
 298 use strict;
 299 use warnings;
 300 use HTTP::OAI;
 301 use C4::OAI::Sets;
 302
 303 use base ("HTTP::OAI::ListIdentifiers");
 304
 305
 306 sub new {
 307     my ($class, $repository, %args) = @_;
 308
 309     my $self = HTTP::OAI::ListIdentifiers->new(%args);
 310
 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'});
 316     }
 317     my $sql = "
 318         SELECT biblioitems.biblionumber, biblioitems.timestamp
 319         FROM biblioitems
 320     ";
 321     $sql .= " JOIN oai_sets_biblios ON biblioitems.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
 322     $sql .= " WHERE DATE(timestamp) >= ? AND DATE(timestamp) <= ? ";
 323     $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
 324     $sql .= "
 325         LIMIT $repository->{'koha_max_count'}
 326         OFFSET $token->{'offset'}
 327     ";
 328     my $sth = $dbh->prepare( $sql );
 329     my @bind_params = ($token->{'from'}, $token->{'until'});
 330     push @bind_params, $set->{'id'} if defined $set;
 331     $sth->execute( @bind_params );
 332
 333     my $pos = $token->{offset};
 334     while ( my ($biblionumber, $timestamp) = $sth->fetchrow ) {
 335         $timestamp =~ s/ /T/, $timestamp .= 'Z';
 336         $self->identifier( new HTTP::OAI::Header(
 337             identifier => $repository->{ koha_identifier} . ':' . $biblionumber,
 338             datestamp  => $timestamp,
 339         ) );
 340         $pos++;
 341     }
 342     $self->resumptionToken(
 343         new C4::OAI::ResumptionToken(
 344             metadataPrefix  => $token->{metadata_prefix},
 345             from            => $token->{from},
 346             until           => $token->{until},
 347             offset          => $pos,
 348             set             => $token->{set}
 349         )
 350     ) if ($pos > $token->{offset});
 351
 352     return $self;
 353 }
 354
 355 # __END__ C4::OAI::ListIdentifiers
 356
 357 package C4::OAI::Description;
 358
 359 use strict;
 360 use warnings;
 361 use HTTP::OAI;
 362 use HTTP::OAI::SAXHandler qw/ :SAX /;
 363
 364 sub new {
 365     my ( $class, %args ) = @_;
 366
 367     my $self = {};
 368
 369     if(my $setDescription = $args{setDescription}) {
 370         $self->{setDescription} = $setDescription;
 371     }
 372     if(my $handler = $args{handler}) {
 373         $self->{handler} = $handler;
 374     }
 375
 376     bless $self, $class;
 377     return $self;
 378 }
 379
 380 sub set_handler {
 381     my ( $self, $handler ) = @_;
 382
 383     $self->{handler} = $handler if $handler;
 384
 385     return $self;
 386 }
 387
 388 sub generate {
 389     my ( $self ) = @_;
 390
 391     g_data_element($self->{handler}, 'http://www.openarchives.org/OAI/2.0/', 'setDescription', {}, $self->{setDescription});
 392
 393     return $self;
 394 }
 395
 396 # __END__ C4::OAI::Description
 397
 398 package C4::OAI::ListSets;
 399
 400 use strict;
 401 use warnings;
 402 use HTTP::OAI;
 403 use C4::OAI::Sets;
 404
 405 use base ("HTTP::OAI::ListSets");
 406
 407 sub new {
 408     my ( $class, $repository, %args ) = @_;
 409
 410     my $self = HTTP::OAI::ListSets->new(%args);
 411
 412     my $token = C4::OAI::ResumptionToken->new(%args);
 413     my $sets = GetOAISets;
 414     my $pos = 0;
 415     foreach my $set (@$sets) {
 416         if ($pos < $token->{offset}) {
 417             $pos++;
 418             next;
 419         }
 420         my @descriptions;
 421         foreach my $desc (@{$set->{'descriptions'}}) {
 422             push @descriptions, C4::OAI::Description->new(
 423                 setDescription => $desc,
 424             );
 425         }
 426         $self->set(
 427             HTTP::OAI::Set->new(
 428                 setSpec => $set->{'spec'},
 429                 setName => $set->{'name'},
 430                 setDescription => \@descriptions,
 431             )
 432         );
 433         $pos++;
 434         last if ($pos + 1 - $token->{offset}) > $repository->{koha_max_count};
 435     }
 436
 437     $self->resumptionToken(
 438         new C4::OAI::ResumptionToken(
 439             metadataPrefix => $token->{metadata_prefix},
 440             offset         => $pos
 441         )
 442     ) if ( $pos > $token->{offset} );
 443
 444     return $self;
 445 }
 446
 447 # __END__ C4::OAI::ListSets;
 448
 449 package C4::OAI::ListRecords;
 450
 451 use strict;
 452 use warnings;
 453 use HTTP::OAI;
 454 use C4::OAI::Sets;
 455
 456 use base ("HTTP::OAI::ListRecords");
 457
 458
 459 sub new {
 460     my ($class, $repository, %args) = @_;
 461
 462     my $self = HTTP::OAI::ListRecords->new(%args);
 463
 464     my $token = new C4::OAI::ResumptionToken( %args );
 465     my $dbh = C4::Context->dbh;
 466     my $set;
 467     if(defined $token->{'set'}) {
 468         $set = GetOAISetBySpec($token->{'set'});
 469     }
 470     my $sql = "
 471         SELECT biblioitems.biblionumber, biblioitems.marcxml, biblioitems.timestamp
 472         FROM biblioitems
 473     ";
 474     $sql .= " JOIN oai_sets_biblios ON biblioitems.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
 475     $sql .= " WHERE DATE(timestamp) >= ? AND DATE(timestamp) <= ? ";
 476     $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
 477     $sql .= "
 478         LIMIT $repository->{'koha_max_count'}
 479         OFFSET $token->{'offset'}
 480     ";
 481
 482     my $sth = $dbh->prepare( $sql );
 483     my @bind_params = ($token->{'from'}, $token->{'until'});
 484     push @bind_params, $set->{'id'} if defined $set;
 485     $sth->execute( @bind_params );
 486
 487     my $pos = $token->{offset};
 488     while ( my ($biblionumber, $marcxml, $timestamp) = $sth->fetchrow ) {
 489         my $oai_sets = GetOAISetsBiblio($biblionumber);
 490         my @setSpecs;
 491         foreach (@$oai_sets) {
 492             push @setSpecs, $_->{spec};
 493         }
 494         $self->record( C4::OAI::Record->new(
 495             $repository, $marcxml, $timestamp, \@setSpecs,
 496             identifier      => $repository->{ koha_identifier } . ':' . $biblionumber,
 497             metadataPrefix  => $token->{metadata_prefix}
 498         ) );
 499         $pos++;
 500     }
 501     $self->resumptionToken(
 502         new C4::OAI::ResumptionToken(
 503             metadataPrefix  => $token->{metadata_prefix},
 504             from            => $token->{from},
 505             until           => $token->{until},
 506             offset          => $pos,
 507             set             => $token->{set}
 508         )
 509     ) if ($pos > $token->{offset});
 510
 511     return $self;
 512 }
 513
 514 # __END__ C4::OAI::ListRecords
 515
 516
 517
 518 package C4::OAI::Repository;
 519
 520 use base ("HTTP::OAI::Repository");
 521
 522 use strict;
 523 use warnings;
 524
 525 use HTTP::OAI;
 526 use HTTP::OAI::Repository qw/:validate/;
 527
 528 use XML::SAX::Writer;
 529 use XML::LibXML;
 530 use XML::LibXSLT;
 531 use YAML::Syck qw( LoadFile );
 532 use CGI qw/:standard -oldstyle_urls/;
 533
 534 use C4::Context;
 535 use C4::Biblio;
 536
 537
 538 sub new {
 539     my ($class, %args) = @_;
 540     my $self = $class->SUPER::new(%args);
 541
 542     $self->{ koha_identifier      } = C4::Context->preference("OAI-PMH:archiveID");
 543     $self->{ koha_max_count       } = C4::Context->preference("OAI-PMH:MaxCount");
 544     $self->{ koha_metadata_format } = ['oai_dc', 'marcxml'];
 545     $self->{ koha_stylesheet      } = { }; # Build when needed
 546
 547     # Load configuration file if defined in OAI-PMH:ConfFile syspref
 548     if ( my $file = C4::Context->preference("OAI-PMH:ConfFile") ) {
 549         $self->{ conf } = LoadFile( $file );
 550         my @formats = keys %{ $self->{conf}->{format} };
 551         $self->{ koha_metadata_format } =  \@formats;
 552     }
 553
 554     # Check for grammatical errors in the request
 555     my @errs = validate_request( CGI::Vars() );
 556
 557     # Is metadataPrefix supported by the respository?
 558     my $mdp = param('metadataPrefix') || '';
 559     if ( $mdp && !grep { $_ eq $mdp } @{$self->{ koha_metadata_format }} ) {
 560         push @errs, new HTTP::OAI::Error(
 561             code    => 'cannotDisseminateFormat',
 562             message => "Dissemination as '$mdp' is not supported",
 563         );
 564     }
 565
 566     my $response;
 567     if ( @errs ) {
 568         $response = HTTP::OAI::Response->new(
 569             requestURL  => self_url(),
 570             errors      => \@errs,
 571         );
 572     }
 573     else {
 574         my %attr = CGI::Vars();
 575         my $verb = delete( $attr{verb} );
 576         if ( $verb eq 'ListSets' ) {
 577             $response = C4::OAI::ListSets->new($self, %attr);
 578         }
 579         elsif ( $verb eq 'Identify' ) {
 580             $response = C4::OAI::Identify->new( $self );
 581         }
 582         elsif ( $verb eq 'ListMetadataFormats' ) {
 583             $response = C4::OAI::ListMetadataFormats->new( $self );
 584         }
 585         elsif ( $verb eq 'GetRecord' ) {
 586             $response = C4::OAI::GetRecord->new( $self, %attr );
 587         }
 588         elsif ( $verb eq 'ListRecords' ) {
 589             $response = C4::OAI::ListRecords->new( $self, %attr );
 590         }
 591         elsif ( $verb eq 'ListIdentifiers' ) {
 592             $response = C4::OAI::ListIdentifiers->new( $self, %attr );
 593         }
 594     }
 595
 596     $response->set_handler( XML::SAX::Writer->new( Output => *STDOUT ) );
 597     $response->generate;
 598
 599     bless $self, $class;
 600     return $self;
 601 }
 602
 603
 604 sub stylesheet {
 605     my ( $self, $format ) = @_;
 606
 607     my $stylesheet = $self->{ koha_stylesheet }->{ $format };
 608     unless ( $stylesheet ) {
 609         my $xsl_file = $self->{ conf }
 610                        ? $self->{ conf }->{ format }->{ $format }->{ xsl_file }
 611                        : ( C4::Context->config('intrahtdocs') .
 612                          '/prog/en/xslt/' .
 613                          C4::Context->preference('marcflavour') .
 614                          'slim2OAIDC.xsl' );
 615         my $parser = XML::LibXML->new();
 616         my $xslt = XML::LibXSLT->new();
 617         my $style_doc = $parser->parse_file( $xsl_file );
 618         $stylesheet = $xslt->parse_stylesheet( $style_doc );
 619         $self->{ koha_stylesheet }->{ $format } = $stylesheet;
 620     }
 621
 622     return $stylesheet;
 623 }
 624
 625
 626
 627 =head1 NAME
 628
 629 C4::OAI::Repository - Handles OAI-PMH requests for a Koha database.
 630
 631 =head1 SYNOPSIS
 632
 633   use C4::OAI::Repository;
 634
 635   my $repository = C4::OAI::Repository->new();
 636
 637 =head1 DESCRIPTION
 638
 639 This object extend HTTP::OAI::Repository object.
 640 It accepts OAI-PMH HTTP requests and returns result.
 641
 642 This OAI-PMH server can operate in a simple mode and extended one.
 643
 644 In simple mode, repository configuration comes entirely from Koha system
 645 preferences (OAI-PMH:archiveID and OAI-PMH:MaxCount) and the server returns
 646 records in marcxml or dublin core format. Dublin core records are created from
 647 koha marcxml records tranformed with XSLT. Used XSL file is located in
 648 koha-tmpl/intranet-tmpl/prog/en/xslt directory and choosed based on marcflavour,
 649 respecively MARC21slim2OAIDC.xsl for MARC21 and  MARC21slim2OAIDC.xsl for
 650 UNIMARC.
 651
 652 In extende mode, it's possible to parameter other format than marcxml or Dublin
 653 Core. A new syspref OAI-PMH:ConfFile specify a YAML configuration file which
 654 list available metadata formats and XSL file used to create them from marcxml
 655 records. If this syspref isn't set, Koha OAI server works in simple mode. A
 656 configuration file koha-oai.conf can look like that:
 657
 658   ---
 659   format:
 660     vs:
 661       metadataPrefix: vs
 662       metadataNamespace: http://veryspecial.tamil.fr/vs/format-pivot/1.1/vs
 663       schema: http://veryspecial.tamil.fr/vs/format-pivot/1.1/vs.xsd
 664       xsl_file: /usr/local/koha/xslt/vs.xsl
 665     marcxml:
 666       metadataPrefix: marxml
 667       metadataNamespace: http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim
 668       schema: http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd
 669     oai_dc:
 670       metadataPrefix: oai_dc
 671       metadataNamespace: http://www.openarchives.org/OAI/2.0/oai_dc/
 672       schema: http://www.openarchives.org/OAI/2.0/oai_dc.xsd
 673       xsl_file: /usr/local/koha/koha-tmpl/intranet-tmpl/xslt/UNIMARCslim2OAIDC.xsl
 674
 675 =cut
 676
 677
 678