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
   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.
  11 #
  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.
  16 #
  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>.
  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 $max = $repository->{koha_max_count};
 318     my $sql = "
 319         SELECT biblioitems.biblionumber, biblioitems.timestamp
 320         FROM biblioitems
 321     ";
 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}
 328     ";
 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 );
 333
 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}
 345                 )
 346             );
 347             last;
 348         }
 349         $timestamp =~ s/ /T/, $timestamp .= 'Z';
 350         $self->identifier( new HTTP::OAI::Header(
 351             identifier => $repository->{ koha_identifier} . ':' . $biblionumber,
 352             datestamp  => $timestamp,
 353         ) );
 354     }
 355
 356     return $self;
 357 }
 358
 359 # __END__ C4::OAI::ListIdentifiers
 360
 361 package C4::OAI::Description;
 362
 363 use strict;
 364 use warnings;
 365 use HTTP::OAI;
 366 use HTTP::OAI::SAXHandler qw/ :SAX /;
 367
 368 sub new {
 369     my ( $class, %args ) = @_;
 370
 371     my $self = {};
 372
 373     if(my $setDescription = $args{setDescription}) {
 374         $self->{setDescription} = $setDescription;
 375     }
 376     if(my $handler = $args{handler}) {
 377         $self->{handler} = $handler;
 378     }
 379
 380     bless $self, $class;
 381     return $self;
 382 }
 383
 384 sub set_handler {
 385     my ( $self, $handler ) = @_;
 386
 387     $self->{handler} = $handler if $handler;
 388
 389     return $self;
 390 }
 391
 392 sub generate {
 393     my ( $self ) = @_;
 394
 395     g_data_element($self->{handler}, 'http://www.openarchives.org/OAI/2.0/', 'setDescription', {}, $self->{setDescription});
 396
 397     return $self;
 398 }
 399
 400 # __END__ C4::OAI::Description
 401
 402 package C4::OAI::ListSets;
 403
 404 use strict;
 405 use warnings;
 406 use HTTP::OAI;
 407 use C4::OAI::Sets;
 408
 409 use base ("HTTP::OAI::ListSets");
 410
 411 sub new {
 412     my ( $class, $repository, %args ) = @_;
 413
 414     my $self = HTTP::OAI::ListSets->new(%args);
 415
 416     my $token = C4::OAI::ResumptionToken->new(%args);
 417     my $sets = GetOAISets;
 418     my $pos = 0;
 419     foreach my $set (@$sets) {
 420         if ($pos < $token->{offset}) {
 421             $pos++;
 422             next;
 423         }
 424         my @descriptions;
 425         foreach my $desc (@{$set->{'descriptions'}}) {
 426             push @descriptions, C4::OAI::Description->new(
 427                 setDescription => $desc,
 428             );
 429         }
 430         $self->set(
 431             HTTP::OAI::Set->new(
 432                 setSpec => $set->{'spec'},
 433                 setName => $set->{'name'},
 434                 setDescription => \@descriptions,
 435             )
 436         );
 437         $pos++;
 438         last if ($pos + 1 - $token->{offset}) > $repository->{koha_max_count};
 439     }
 440
 441     $self->resumptionToken(
 442         new C4::OAI::ResumptionToken(
 443             metadataPrefix => $token->{metadata_prefix},
 444             offset         => $pos
 445         )
 446     ) if ( $pos > $token->{offset} );
 447
 448     return $self;
 449 }
 450
 451 # __END__ C4::OAI::ListSets;
 452
 453 package C4::OAI::ListRecords;
 454
 455 use strict;
 456 use warnings;
 457 use HTTP::OAI;
 458 use C4::OAI::Sets;
 459
 460 use base ("HTTP::OAI::ListRecords");
 461
 462
 463 sub new {
 464     my ($class, $repository, %args) = @_;
 465
 466     my $self = HTTP::OAI::ListRecords->new(%args);
 467
 468     my $token = new C4::OAI::ResumptionToken( %args );
 469     my $dbh = C4::Context->dbh;
 470     my $set;
 471     if(defined $token->{'set'}) {
 472         $set = GetOAISetBySpec($token->{'set'});
 473     }
 474     my $max = $repository->{koha_max_count};
 475     my $sql = "
 476         SELECT biblioitems.biblionumber, biblioitems.marcxml, biblioitems.timestamp
 477         FROM biblioitems
 478     ";
 479     $sql .= " JOIN oai_sets_biblios ON biblioitems.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
 480     $sql .= " WHERE DATE(timestamp) >= ? AND DATE(timestamp) <= ? ";
 481     $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
 482     $sql .= "
 483         LIMIT " . ($max + 1) . "
 484         OFFSET $token->{offset}
 485     ";
 486
 487     my $sth = $dbh->prepare( $sql );
 488     my @bind_params = ($token->{'from'}, $token->{'until'});
 489     push @bind_params, $set->{'id'} if defined $set;
 490     $sth->execute( @bind_params );
 491
 492     my $count = 0;
 493     while ( my ($biblionumber, $marcxml, $timestamp) = $sth->fetchrow ) {
 494         $count++;
 495         if ( $count > $max ) {
 496             $self->resumptionToken(
 497                 new C4::OAI::ResumptionToken(
 498                     metadataPrefix  => $token->{metadata_prefix},
 499                     from            => $token->{from},
 500                     until           => $token->{until},
 501                     offset          => $token->{offset} + $max,
 502                     set             => $token->{set}
 503                 )
 504             );
 505             last;
 506         }
 507         my $oai_sets = GetOAISetsBiblio($biblionumber);
 508         my @setSpecs;
 509         foreach (@$oai_sets) {
 510             push @setSpecs, $_->{spec};
 511         }
 512         $self->record( C4::OAI::Record->new(
 513             $repository, $marcxml, $timestamp, \@setSpecs,
 514             identifier      => $repository->{ koha_identifier } . ':' . $biblionumber,
 515             metadataPrefix  => $token->{metadata_prefix}
 516         ) );
 517     }
 518
 519     return $self;
 520 }
 521
 522 # __END__ C4::OAI::ListRecords
 523
 524
 525
 526 package C4::OAI::Repository;
 527
 528 use base ("HTTP::OAI::Repository");
 529
 530 use strict;
 531 use warnings;
 532
 533 use HTTP::OAI;
 534 use HTTP::OAI::Repository qw/:validate/;
 535
 536 use XML::SAX::Writer;
 537 use XML::LibXML;
 538 use XML::LibXSLT;
 539 use YAML::Syck qw( LoadFile );
 540 use CGI qw/:standard -oldstyle_urls/;
 541
 542 use C4::Context;
 543 use C4::Biblio;
 544
 545
 546 sub new {
 547     my ($class, %args) = @_;
 548     my $self = $class->SUPER::new(%args);
 549
 550     $self->{ koha_identifier      } = C4::Context->preference("OAI-PMH:archiveID");
 551     $self->{ koha_max_count       } = C4::Context->preference("OAI-PMH:MaxCount");
 552     $self->{ koha_metadata_format } = ['oai_dc', 'marcxml'];
 553     $self->{ koha_stylesheet      } = { }; # Build when needed
 554
 555     # Load configuration file if defined in OAI-PMH:ConfFile syspref
 556     if ( my $file = C4::Context->preference("OAI-PMH:ConfFile") ) {
 557         $self->{ conf } = LoadFile( $file );
 558         my @formats = keys %{ $self->{conf}->{format} };
 559         $self->{ koha_metadata_format } =  \@formats;
 560     }
 561
 562     # Check for grammatical errors in the request
 563     my @errs = validate_request( CGI::Vars() );
 564
 565     # Is metadataPrefix supported by the respository?
 566     my $mdp = param('metadataPrefix') || '';
 567     if ( $mdp && !grep { $_ eq $mdp } @{$self->{ koha_metadata_format }} ) {
 568         push @errs, new HTTP::OAI::Error(
 569             code    => 'cannotDisseminateFormat',
 570             message => "Dissemination as '$mdp' is not supported",
 571         );
 572     }
 573
 574     my $response;
 575     if ( @errs ) {
 576         $response = HTTP::OAI::Response->new(
 577             requestURL  => self_url(),
 578             errors      => \@errs,
 579         );
 580     }
 581     else {
 582         my %attr = CGI::Vars();
 583         my $verb = delete( $attr{verb} );
 584         if ( $verb eq 'ListSets' ) {
 585             $response = C4::OAI::ListSets->new($self, %attr);
 586         }
 587         elsif ( $verb eq 'Identify' ) {
 588             $response = C4::OAI::Identify->new( $self );
 589         }
 590         elsif ( $verb eq 'ListMetadataFormats' ) {
 591             $response = C4::OAI::ListMetadataFormats->new( $self );
 592         }
 593         elsif ( $verb eq 'GetRecord' ) {
 594             $response = C4::OAI::GetRecord->new( $self, %attr );
 595         }
 596         elsif ( $verb eq 'ListRecords' ) {
 597             $response = C4::OAI::ListRecords->new( $self, %attr );
 598         }
 599         elsif ( $verb eq 'ListIdentifiers' ) {
 600             $response = C4::OAI::ListIdentifiers->new( $self, %attr );
 601         }
 602     }
 603
 604     $response->set_handler( XML::SAX::Writer->new( Output => *STDOUT ) );
 605     $response->generate;
 606
 607     bless $self, $class;
 608     return $self;
 609 }
 610
 611
 612 sub stylesheet {
 613     my ( $self, $format ) = @_;
 614
 615     my $stylesheet = $self->{ koha_stylesheet }->{ $format };
 616     unless ( $stylesheet ) {
 617         my $xsl_file = $self->{ conf }
 618                        ? $self->{ conf }->{ format }->{ $format }->{ xsl_file }
 619                        : ( C4::Context->config('intrahtdocs') .
 620                          '/prog/en/xslt/' .
 621                          C4::Context->preference('marcflavour') .
 622                          'slim2OAIDC.xsl' );
 623         my $parser = XML::LibXML->new();
 624         my $xslt = XML::LibXSLT->new();
 625         my $style_doc = $parser->parse_file( $xsl_file );
 626         $stylesheet = $xslt->parse_stylesheet( $style_doc );
 627         $self->{ koha_stylesheet }->{ $format } = $stylesheet;
 628     }
 629
 630     return $stylesheet;
 631 }
 632
 633
 634
 635 =head1 NAME
 636
 637 C4::OAI::Repository - Handles OAI-PMH requests for a Koha database.
 638
 639 =head1 SYNOPSIS
 640
 641   use C4::OAI::Repository;
 642
 643   my $repository = C4::OAI::Repository->new();
 644
 645 =head1 DESCRIPTION
 646
 647 This object extend HTTP::OAI::Repository object.
 648 It accepts OAI-PMH HTTP requests and returns result.
 649
 650 This OAI-PMH server can operate in a simple mode and extended one.
 651
 652 In simple mode, repository configuration comes entirely from Koha system
 653 preferences (OAI-PMH:archiveID and OAI-PMH:MaxCount) and the server returns
 654 records in marcxml or dublin core format. Dublin core records are created from
 655 koha marcxml records tranformed with XSLT. Used XSL file is located in
 656 koha-tmpl/intranet-tmpl/prog/en/xslt directory and choosed based on marcflavour,
 657 respecively MARC21slim2OAIDC.xsl for MARC21 and  MARC21slim2OAIDC.xsl for
 658 UNIMARC.
 659
 660 In extende mode, it's possible to parameter other format than marcxml or Dublin
 661 Core. A new syspref OAI-PMH:ConfFile specify a YAML configuration file which
 662 list available metadata formats and XSL file used to create them from marcxml
 663 records. If this syspref isn't set, Koha OAI server works in simple mode. A
 664 configuration file koha-oai.conf can look like that:
 665
 666   ---
 667   format:
 668     vs:
 669       metadataPrefix: vs
 670       metadataNamespace: http://veryspecial.tamil.fr/vs/format-pivot/1.1/vs
 671       schema: http://veryspecial.tamil.fr/vs/format-pivot/1.1/vs.xsd
 672       xsl_file: /usr/local/koha/xslt/vs.xsl
 673     marcxml:
 674       metadataPrefix: marxml
 675       metadataNamespace: http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim
 676       schema: http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd
 677     oai_dc:
 678       metadataPrefix: oai_dc
 679       metadataNamespace: http://www.openarchives.org/OAI/2.0/oai_dc/
 680       schema: http://www.openarchives.org/OAI/2.0/oai_dc.xsd
 681       xsl_file: /usr/local/koha/koha-tmpl/intranet-tmpl/xslt/UNIMARCslim2OAIDC.xsl
 682
 683 =cut
 684
 685
 686