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