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     );
 127     $self->description( "Koha OAI Repository" );
 128     $self->compression( 'gzip' );
 129
 130     return $self;
 131 }
 132
 133 # __END__ C4::OAI::Identify
 134
 135
 136
 137 package C4::OAI::ListMetadataFormats;
 138
 139 use strict;
 140 use warnings;
 141 use diagnostics;
 142 use HTTP::OAI;
 143
 144 use base ("HTTP::OAI::ListMetadataFormats");
 145
 146 sub new {
 147     my ($class, $repository) = @_;
 148
 149     my $self = $class->SUPER::new();
 150
 151     $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
 152         metadataPrefix    => 'oai_dc',
 153         schema            => 'http://www.openarchives.org/OAI/2.0/oai_dc.xsd',
 154         metadataNamespace => 'http://www.openarchives.org/OAI/2.0/oai_dc/'
 155     ) );
 156     $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
 157         metadataPrefix    => 'marcxml',
 158         schema            => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim.xsd',
 159         metadataNamespace => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim'
 160     ) );
 161
 162     return $self;
 163 }
 164
 165 # __END__ C4::OAI::ListMetadataFormats
 166
 167
 168
 169 package C4::OAI::Record;
 170
 171 use strict;
 172 use warnings;
 173 use diagnostics;
 174 use HTTP::OAI;
 175 use HTTP::OAI::Metadata::OAI_DC;
 176
 177 use base ("HTTP::OAI::Record");
 178
 179 sub new {
 180     my ($class, $repository, $marcxml, $timestamp, %args) = @_;
 181
 182     my $self = $class->SUPER::new(%args);
 183
 184     $timestamp =~ s/ /T/, $timestamp .= 'Z';
 185     $self->header( new HTTP::OAI::Header(
 186         identifier  => $args{identifier},
 187         datestamp   => $timestamp,
 188     ) );
 189
 190     my $parser = XML::LibXML->new();
 191     my $record_dom = $parser->parse_string( $marcxml );
 192     if ( $args{metadataPrefix} ne 'marcxml' ) {
 193         $record_dom = $repository->oai_dc_stylesheet()->transform( $record_dom );
 194     }
 195     $self->metadata( HTTP::OAI::Metadata->new( dom => $record_dom ) );
 196
 197     return $self;
 198 }
 199
 200 # __END__ C4::OAI::Record
 201
 202
 203
 204 package C4::OAI::GetRecord;
 205
 206 use strict;
 207 use warnings;
 208 use diagnostics;
 209 use HTTP::OAI;
 210
 211 use base ("HTTP::OAI::GetRecord");
 212
 213
 214 sub new {
 215     my ($class, $repository, %args) = @_;
 216
 217     my $self = HTTP::OAI::GetRecord->new(%args);
 218
 219     my $dbh = C4::Context->dbh;
 220     my $sth = $dbh->prepare("
 221         SELECT marcxml, timestamp
 222         FROM   biblioitems
 223         WHERE  biblionumber=? " );
 224     my $prefix = $repository->{koha_identifier} . ':';
 225     my ($biblionumber) = $args{identifier} =~ /^$prefix(.*)/;
 226     $sth->execute( $biblionumber );
 227     my ($marcxml, $timestamp);
 228     unless ( ($marcxml, $timestamp) = $sth->fetchrow ) {
 229         return HTTP::OAI::Response->new(
 230             requestURL  => $repository->self_url(),
 231             errors      => [ new HTTP::OAI::Error(
 232                 code    => 'idDoesNotExist',
 233                 message => "There is no biblio record with this identifier",
 234                 ) ] ,
 235         );
 236     }
 237
 238     #$self->header( HTTP::OAI::Header->new( identifier  => $args{identifier} ) );
 239     $self->record( C4::OAI::Record->new(
 240         $repository, $marcxml, $timestamp, %args ) );
 241
 242     return $self;
 243 }
 244
 245 # __END__ C4::OAI::GetRecord
 246
 247
 248
 249 package C4::OAI::ListIdentifiers;
 250
 251 use strict;
 252 use warnings;
 253 use diagnostics;
 254 use HTTP::OAI;
 255
 256 use base ("HTTP::OAI::ListIdentifiers");
 257
 258
 259 sub new {
 260     my ($class, $repository, %args) = @_;
 261
 262     my $self = HTTP::OAI::ListIdentifiers->new(%args);
 263
 264     my $token = new C4::OAI::ResumptionToken( %args );
 265     my $dbh = C4::Context->dbh;
 266     my $sql = "SELECT biblionumber, timestamp
 267                FROM   biblioitems
 268                WHERE  timestamp >= ? AND timestamp <= ?
 269                LIMIT  " . $repository->{koha_max_count} . "
 270                OFFSET " . $token->{offset};
 271     my $sth = $dbh->prepare( $sql );
 272         $sth->execute( $token->{from}, $token->{until} );
 273
 274     my $pos = $token->{offset};
 275         while ( my ($biblionumber, $timestamp) = $sth->fetchrow ) {
 276             $timestamp =~ s/ /T/, $timestamp .= 'Z';
 277         $self->identifier( new HTTP::OAI::Header(
 278             identifier => $repository->{ koha_identifier} . ':' . $biblionumber,
 279             datestamp  => $timestamp,
 280         ) );
 281         $pos++;
 282         }
 283         $self->resumptionToken( new C4::OAI::ResumptionToken(
 284         metadataPrefix  => $token->{metadata_prefix},
 285         from            => $token->{from},
 286         until           => $token->{until},
 287         offset          => $pos ) );
 288
 289     return $self;
 290 }
 291
 292 # __END__ C4::OAI::ListIdentifiers
 293
 294
 295
 296 package C4::OAI::ListRecords;
 297
 298 use strict;
 299 use warnings;
 300 use diagnostics;
 301 use HTTP::OAI;
 302
 303 use base ("HTTP::OAI::ListRecords");
 304
 305
 306 sub new {
 307     my ($class, $repository, %args) = @_;
 308
 309     my $self = HTTP::OAI::ListRecords->new(%args);
 310
 311     my $token = new C4::OAI::ResumptionToken( %args );
 312     my $dbh = C4::Context->dbh;
 313     my $sql = "SELECT biblionumber, marcxml, timestamp
 314                FROM   biblioitems
 315                WHERE  timestamp >= ? AND timestamp <= ?
 316                LIMIT  " . $repository->{koha_max_count} . "
 317                OFFSET " . $token->{offset};
 318     my $sth = $dbh->prepare( $sql );
 319         $sth->execute( $token->{from}, $token->{until} );
 320
 321     my $pos = $token->{offset};
 322         while ( my ($biblionumber, $marcxml, $timestamp) = $sth->fetchrow ) {
 323         $self->record( C4::OAI::Record->new(
 324             $repository, $marcxml, $timestamp,
 325             identifier      => $repository->{ koha_identifier } . ':' . $biblionumber,
 326             metadataPrefix  => $token->{metadata_prefix}
 327         ) );
 328         $pos++;
 329         }
 330         $self->resumptionToken( new C4::OAI::ResumptionToken(
 331         metadataPrefix  => $token->{metadata_prefix},
 332         from            => $token->{from},
 333         until           => $token->{until},
 334         offset          => $pos ) );
 335
 336     return $self;
 337 }
 338
 339 # __END__ C4::OAI::ListRecords
 340
 341
 342
 343 package C4::OAI::Repository;
 344
 345 use base ("HTTP::OAI::Repository");
 346
 347 use strict;
 348 use warnings;
 349 use diagnostics;
 350
 351 use HTTP::OAI;
 352 use HTTP::OAI::Repository qw/:validate/;
 353
 354 use XML::SAX::Writer;
 355 use XML::LibXML;
 356 use XML::LibXSLT;
 357 use CGI qw/:standard -oldstyle_urls/;
 358
 359 use C4::Context;
 360 use C4::Biblio;
 361
 362
 363 =head1 NAME
 364
 365 C4::OAI::Repository - Handles OAI-PMH requests for a Koha database.
 366
 367 =head1 SYNOPSIS
 368
 369   use C4::OAI::Repository;
 370
 371   my $repository = C4::OAI::Repository->new();
 372
 373 =head1 DESCRIPTION
 374
 375 This object extend HTTP::OAI::Repository object.
 376
 377 =cut
 378
 379
 380
 381 sub new {
 382     my ($class, %args) = @_;
 383     my $self = $class->SUPER::new(%args);
 384
 385     $self->{ koha_identifier      } = C4::Context->preference("OAI-PMH:archiveID");
 386     $self->{ koha_max_count       } = C4::Context->preference("OAI-PMH:MaxCount");
 387     $self->{ koha_metadata_format } = ['oai_dc', 'marcxml'];
 388
 389     # Check for grammatical errors in the request
 390     my @errs = validate_request( CGI::Vars() );
 391
 392     # Is metadataPrefix supported by the respository?
 393     my $mdp = param('metadataPrefix') || '';
 394     if ( $mdp && !grep { $_ eq $mdp } @{$self->{ koha_metadata_format }} ) {
 395         push @errs, new HTTP::OAI::Error(
 396             code    => 'cannotDisseminateFormat',
 397             message => "Dissemination as '$mdp' is not supported",
 398         );
 399     }
 400
 401     my $response;
 402     if ( @errs ) {
 403         $response = HTTP::OAI::Response->new(
 404             requestURL  => self_url(),
 405             errors      => \@errs,
 406         );
 407     }
 408     else {
 409         my %attr = CGI::Vars();
 410         my $verb = delete( $attr{verb} );
 411         if ( grep { $_ eq $verb } qw( ListSets ) ) {
 412             $response = HTTP::OAI::Response->new(
 413                 requestURL  => $self->self_url(),
 414                 errors      => [ new HTTP::OAI::Error(
 415                     code    => 'noSetHierarchy',
 416                     message => "Koha repository doesn't have sets",
 417                     ) ] ,
 418             );
 419         }
 420         elsif ( $verb eq 'Identify' ) {
 421             $response = C4::OAI::Identify->new( $self );
 422         }
 423         elsif ( $verb eq 'ListMetadataFormats' ) {
 424             $response = C4::OAI::ListMetadataFormats->new( $self );
 425         }
 426         elsif ( $verb eq 'GetRecord' ) {
 427             $response = C4::OAI::GetRecord->new( $self, %attr );
 428         }
 429         elsif ( $verb eq 'ListRecords' ) {
 430             $response = C4::OAI::ListRecords->new( $self, %attr );
 431         }
 432         elsif ( $verb eq 'ListIdentifiers' ) {
 433             $response = C4::OAI::ListIdentifiers->new( $self, %attr );
 434         }
 435     }
 436
 437     $response->set_handler( XML::SAX::Writer->new( Output => *STDOUT ) );
 438     $response->generate;
 439
 440     bless $self, $class;
 441     return $self;
 442 }
 443
 444
 445 #
 446 # XSLT stylesheet used to transform MARCXML record into OAI Dublin Core.
 447 # The object is constructed the fist time this method is called.
 448 #
 449 # Styleeet file is located in /koha-tmpl/intranet-tmpl/prog/en/xslt/ directory.
 450 # Its name is constructed with 'marcflavour' syspref:
 451 #   - MARC21slim2OAIDC.xsl
 452 #   - UNIMARCslim2OADIC.xsl
 453 #
 454 sub oai_dc_stylesheet {
 455     my $self = shift;
 456
 457     unless ( $self->{ oai_dc_stylesheet } ) {
 458         my $xslt_file = C4::Context->config('intranetdir') .
 459                         "/koha-tmpl/intranet-tmpl/prog/en/xslt/" .
 460                         C4::Context->preference('marcflavour') .
 461                         "slim2OAIDC.xsl";
 462         my $parser = XML::LibXML->new();
 463         my $xslt = XML::LibXSLT->new();
 464         my $style_doc = $parser->parse_file( $xslt_file );
 465         my $stylesheet = $xslt->parse_stylesheet( $style_doc );
 466         $self->{ oai_dc_stylesheet } = $stylesheet;
 467     }
 468
 469     return $self->{ oai_dc_stylesheet };
 470 }
 471