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