opac/oai.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4
   5 use C4::Context;
   6 use C4::Biblio;
   7
   8 =head1 OAI-PMH for koha
   9
  10 This file is an implementation of the OAI-PMH protocol for koha. Its purpose
  11 is to share metadata in Dublin core format with harvester like PKP-Harverster.
  12 Presently, all the bibliographic records managed by the runing koha instance
  13 are publicly shared (as the opac is).
  14
  15 =head1 Package MARC::Record::KOHADC
  16
  17 This package is a sub-class of the MARC::File::USMARC. It add methods and functions
  18 to map the content of a marc record (of any flavor) to Dublin core.
  19 As soon as it is possible, mapping between marc fields and there semantic
  20 are got from ::GetMarcFromKohaField fonction from C4::Biblio (see also the "Koha
  21 to MARC mapping" preferences).
  22
  23 =cut
  24
  25 package MARC::Record::KOHADC;
  26 use vars ('@ISA');
  27 @ISA = qw(MARC::Record);
  28
  29 use MARC::File::USMARC;
  30
  31 sub new { # Get a MAR::Record as parameter and bless it as MARC::Record::KOHADC
  32         shift;
  33         my $marc = shift;
  34         bless $marc  if( ref( $marc ) );
  35 }
  36
  37 sub subfield {
  38     my $self = shift;
  39     my ($t,$sf) = @_;
  40
  41     return $self->SUPER::subfield( @_ ) unless wantarray;
  42
  43     my @field = $self->field($t);
  44     my @list = ();
  45     my $f;
  46
  47     foreach $f ( @field ) {
  48                 push( @list, $f->subfield( $sf ) );
  49     }
  50     return @list;
  51 }
  52
  53 sub getfields {
  54 my $marc = shift;
  55 my @result = ();
  56
  57         foreach my $kohafield ( @_ ) {
  58                 my ( $field, $subfield ) = ::GetMarcFromKohaField( $kohafield, '' );
  59                 next unless defined $field; # $kohafield not defined in framework
  60                 push( @result, $field < 10 ? $marc->field( $field )->as_string() : $marc->subfield( $field, $subfield ) );
  61         }
  62 #        @result>1 ? \@result : $result[0];
  63         \@result;
  64 }
  65
  66 sub XMLescape {
  67 my ($t) = shift;
  68
  69         foreach (@$t ) {
  70                 s/\&/\&amp;/g; s/</&lt;/g;
  71         }
  72         $t;
  73 }
  74
  75 sub Status {
  76   my $self = shift;
  77         undef;
  78 }
  79
  80 sub Title {
  81   my $self = shift;
  82         &XMLescape( $self->getfields('biblio.title') );
  83 }
  84
  85 sub Creator {
  86   my $self = shift;
  87         &XMLescape( $self->getfields('biblio.author') );
  88 }
  89
  90 sub Subject {
  91   my $self = shift;
  92         &XMLescape( $self->getfields('bibliosubject.subject') );
  93 }
  94
  95 sub DateStamp {
  96   my $self = shift;
  97         my ($d,$h) = split( ' ', $self->{'biblio.timestamp'} );
  98         $d . "T" . $h . "Z";
  99 }
 100
 101 sub Date {
 102   my $self = shift;
 103     my ($str) = @{$self->getfields('biblioitems.publicationyear')};
 104     my ($y,$m,$d) = (substr($str,0,4), substr($str,4,2), substr($str,6,2));
 105
 106     $y=1970 unless($y>0); $m=1 unless($m>0); $d=1 unless($d>0);
 107
 108     sprintf( "%.4d-%.2d-%.2d", $y,$m,$d);
 109 }
 110
 111 sub Description {
 112   my $self = shift;
 113         undef;
 114 }
 115
 116 sub Identifier {
 117   my $self = shift;
 118   my $id = $self->getfields('biblio.biblionumber')->[0];
 119
 120 # get url of this script and assume that OAI server is in the same place as opac-detail script
 121 # and build a direct link to the record.
 122   my $uri = $ENV{'SCRIPT_URI'};
 123   $uri= "http://" . $ENV{'HTTP_HOST'} . $ENV{'REQUEST_URI'} unless( $uri ); # SCRIPT_URI doesn't exist on all httpd server
 124   $uri =~ s#[^/]+$##;
 125         [
 126                 C4::Context->preference("OAI-PMH:archiveID") .":" .$id,
 127                 "${uri}opac-detail.pl?bib=$id",
 128                 @{$self->getfields('biblioitems.isbn', 'biblioitems.issn')}
 129         ];
 130 }
 131
 132 sub Language {
 133   my $self = shift;
 134         undef;
 135 }
 136
 137 sub Type {
 138   my $self = shift;
 139         &XMLescape( $self->getfields('biblioitems.itemtype') );
 140 }
 141
 142 sub Publisher {
 143   my $self = shift;
 144         &XMLescape( $self->getfields('biblioitems.publishercode') );
 145 }
 146
 147 sub Set {
 148 my $set = &OAI::KOHA::Set();
 149         [ map( $_=$_->[0], @$set) ];
 150 }
 151
 152 =head1 The OAI::KOHA package
 153
 154 This package is a subclass of the OAI::DC data provider. It overides needed methods
 155 and provide the links between the OAI-PMH request and the koha application.
 156 The data used in answers are from the koha table I<bibio>.
 157
 158 =cut
 159
 160 package OAI::KOHA;
 161
 162 use C4::OAI::DC;
 163 use vars ('@ISA');
 164 @ISA = ("C4::OAI::DC");
 165
 166 =head2 Set
 167
 168 return the Set list to the I<verb=ListSets> query. Data are from the 'OAI-PMH:Set' preference.
 169
 170 =cut
 171
 172 sub Set {
 173 #   [
 174 #       ['BRISE','Experimental unimarc set for BRISE network'],
 175 #       ['BRISE:EMSE','EMSE set in BRISE network']
 176 #   ];
 177 #
 178 # A blinder correctement
 179         [ map( $_ = [ split(",", $_)], split( "\n",C4::Context->preference("OAI-PMH:Set") ) ) ];
 180 }
 181
 182 =head2 new
 183
 184 The new method is the constructor for this class. It doesn't have any parameters and
 185 get required data from koha preferences. Koha I<LibraryName> is used to identify the
 186 OAI-PMH repository, I<OAI-PMH:MaxCount> is used to set the maximun number of records
 187 returned at the same time in answers to I<verb=ListRecords> or I<verb=ListIdentifiers>
 188 queries.
 189
 190 The method return a blessed reference.
 191
 192 =cut
 193
 194 # constructor
 195 sub new
 196 {
 197    my $classname = shift;
 198    my $self = $classname->SUPER::new ();
 199
 200    # set configuration
 201    $self->{'repositoryName'} = C4::Context->preference("LibraryName");
 202    $self->{'MaxCount'} = C4::Context->preference("OAI-PMH:MaxCount");
 203    $self->{'adminEmail'} = C4::Context->preference("KohaAdminEmailAddress");
 204
 205    bless $self, $classname;
 206    return $self;
 207 }
 208
 209 =head2 dispose
 210
 211 The dispose method is used as a destructor. It call just the SUPER::dispose method.
 212
 213 =cut
 214
 215 # destructor
 216 sub dispose
 217 {
 218    my ($self) = @_;
 219    $self->SUPER::dispose ();
 220 }
 221
 222 # now date
 223 sub now {
 224 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime( time );
 225
 226         sprintf( "%.4d-%.2d-%.2d", $year+1900, $mon+1,$mday );
 227 }
 228
 229 # build the resumptionTocken fom ($metadataPrefix,$offset,$from,$until)
 230
 231 =head2 buildResumptionToken and parseResumptionToken
 232
 233 Theses two functions are used to manage resumption tokens. The choosed syntax is simple as
 234 possible, a token is only the metadata prefix, the offset in the full answer, the from and
 235 the until date (in the yyyy-mm-dd format) joined by ':' caracter.
 236
 237 I<buildResumptionToken> get the four elements as parameters and return the ':' separated
 238 string.
 239
 240 I<parseResumptionToken> is used to set the default values to the from and until date, the
 241 metadata prefix using the resumption tocken if necessary. This function have four parameters
 242 (from,until,metadata prefix and resumption tocken) which can be undefined and return every
 243 time this list of values correctly set. The missing values are set with defaults: offset=0,
 244 from= 1970-01-01 and until is set to current date.
 245
 246 =cut
 247
 248 sub buildResumptionToken {
 249         join( ':', @_ );
 250 }
 251
 252 # parse the resumptionTocken
 253 sub parseResumptionToken {
 254 my ($from, $until, $metadataPrefix, $resumptionToken) = @_;
 255 my $offset = 0;
 256
 257         if( $resumptionToken ) {
 258                 ($metadataPrefix,$offset,$from,$until) = split( ':', $resumptionToken );
 259         }
 260
 261         $from  = "1970-01-01" unless( $from );
 262         $until = &now unless( $until );
 263         ($metadataPrefix, $offset, $from, $until );
 264 }
 265
 266 =head2 Archive_ListSets
 267
 268 return the full list Set to the I<verb=ListSets> query. Data are from the 'OAI-PMH:Set' preference.
 269
 270 =cut
 271
 272 # get full list of sets from the archive
 273 sub Archive_ListSets
 274 {
 275         &Set();
 276 }
 277
 278 =head2 Archive_GetRecord
 279
 280 This method select the record specified as its first parameter from the koha I<biblio>
 281 table and return a reference to a MARC::Record::KOHADC object.
 282
 283 =cut
 284
 285 # get a single record from the archive
 286 sub Archive_GetRecord
 287 {
 288    my ($self, $identifier, $metadataFormat) = @_;
 289    my $dbh = C4::Context->dbh;
 290    my $sth = $dbh->prepare("SELECT biblionumber,timestamp FROM biblio WHERE biblionumber=?");
 291    my $prefixID = C4::Context->preference("OAI-PMH:archiveID"); $prefixID=qr{$prefixID:};
 292
 293    $identifier =~ s/^$prefixID//;
 294
 295    $sth->execute( $identifier );
 296
 297    if( my $r = $sth->fetchrow_hashref() ) {
 298         my $marc = new MARC::Record::KOHADC( ::GetMarcBiblio( $identifier ) );
 299         if( $marc ) {
 300                 $marc->{'biblio.timestamp'} = $r->{'timestamp'};
 301                 return $marc ;
 302         }
 303         else {
 304                 warn("Archive_GetRecord : no MARC record for " . C4::Context->preference("OAI-PMH:archiveID") . ":" . $identifier);
 305         }
 306    }
 307
 308    $self->AddError ('idDoesNotExist', 'The value of the identifier argument is unknown or illegal in this repository');
 309    undef;
 310 }
 311
 312 =head2 Archive_ListRecords
 313
 314 This method return a list of 'MaxCount' references to MARC::Record::KOHADC object build from the
 315 koha I<biblio> table according to its parameters : set, from and until date, metadata prefix
 316 and resumption token.
 317
 318 =cut
 319
 320 # list metadata records from the archive
 321 sub Archive_ListRecords
 322 {
 323    my ($self, $set, $from, $until, $metadataPrefix, $resumptionToken) = @_;
 324
 325    my @allrows = ();
 326    my $marc;
 327    my $offset;
 328    my $tokenInfo;
 329    my $dbh = C4::Context->dbh;
 330    my $sth = $dbh->prepare("SELECT biblionumber,timestamp FROM biblio WHERE DATE(timestamp) >= ? and DATE(timestamp) <= ? LIMIT ? OFFSET ?");
 331    my $count;
 332
 333         ($metadataPrefix, $offset, $from, $until ) = &parseResumptionToken($from, $until, $metadataPrefix, $resumptionToken);
 334
 335 #warn( "Archive_ListRecords : $set, $from, $until, $metadataPrefix, $resumptionToken\n");
 336         $sth->execute( $from,$until,$self->{'MaxCount'}?$self->{'MaxCount'}:100000, $offset );
 337
 338         while( my $r = $sth->fetchrow_hashref() ) {
 339                 my $marc = new MARC::Record::KOHADC( ::GetMarcBiblio( $r->{'biblionumber'} ) );
 340                 unless( $marc ) { # somme time there is problems within koha, and we can't get valid marc record
 341                         warn("Archive_ListRecords : no MARC record for " . C4::Context->preference("OAI-PMH:archiveID") .":" . $r->{'biblionumber'} );
 342                         next;
 343                 }
 344                 $marc->{'biblio.timestamp'} = $r->{'timestamp'};
 345                 push( @allrows, $marc );
 346         }
 347
 348         $sth = $dbh->prepare("SELECT count(*) FROM biblioitems WHERE DATE(timestamp) >= ? and DATE(timestamp) <= ?");
 349         $sth->execute($from, $until);
 350         ( $count ) = $sth->fetchrow_array();
 351
 352         unless( @allrows ) {
 353                 $self->AddError ('noRecordsMatch', 'The combination of the values of arguments results in an empty set');
 354         }
 355
 356         if( $offset + $self->{'MaxCount'} < $count ) { # Not at the end
 357                 $offset = $offset + $self->{'MaxCount'};
 358                 $resumptionToken = &buildResumptionToken($metadataPrefix,$offset,$from,$until);
 359                 $tokenInfo = { 'completeListSize' => $count, 'cursor' => $offset };
 360         }
 361         else {
 362                 $resumptionToken = '';
 363                 $tokenInfo = {};
 364         }
 365         ( \@allrows, $resumptionToken, $metadataPrefix, $tokenInfo );
 366 }
 367
 368 package main;
 369
 370 =head1 Main package
 371
 372 The I<main> function is the starting point of the service. The first step is
 373 to verify if the service is enable using the 'OAI-PMH' preference value
 374 (See Koha systeme preferences).
 375
 376 If the service is enable, it create a new instance of the OAI::KOHA data
 377 provider (see before) and run the service.
 378
 379 =cut
 380
 381 sub disable {
 382         print "Status:404 OAI-PMH service is disabled\n";
 383         print "Content-type: text/plain\n\n";
 384
 385         print "OAI-PMH service is disable.\n";
 386 }
 387
 388 sub main
 389 {
 390    return &disable() unless( C4::Context->preference('OAI-PMH') );
 391
 392    my $OAI = new OAI::KOHA();
 393    $OAI->Run;
 394    $OAI->dispose;
 395 }
 396
 397 main;
 398
 399 1;