[Koha-patches] [PATCH] changed OAI-PMH implementation
Galen Charlton
galen.charlton at liblime.com
Fri Apr 24 18:25:05 CEST 2009
Replaced older OAI-PMH server implementation
with new one by Frédéric Demians.
---
C4/OAI/DC.pm | 232 --------------
C4/OAI/DP.pm | 923 -----------------------------------------------------
C4/OAI/Utility.pm | 204 ------------
opac/oai.pl | 680 ++++++++++++++++++++++------------------
opac/oai2.pl | 471 ---------------------------
5 files changed, 376 insertions(+), 2134 deletions(-)
delete mode 100644 C4/OAI/DC.pm
delete mode 100644 C4/OAI/DP.pm
delete mode 100644 C4/OAI/Utility.pm
delete mode 100755 opac/oai2.pl
diff --git a/C4/OAI/DC.pm b/C4/OAI/DC.pm
deleted file mode 100644
index e19dd5e..0000000
--- a/C4/OAI/DC.pm
+++ /dev/null
@@ -1,232 +0,0 @@
-# ---------------------------------------------------------------------
-# Dublin Core helper class
-# v1.0
-# January 2007
-# ------------------+--------------------------------------------------
-# Ph. Jaillon |
-# ------------------+----------------------+---------------------------
-# Department of Computer Science |
-# -----------------------------------------+-------------+-------------
-# Ecole Nationale Superieure des Mines de St-Etienne | www.emse.fr
-# -------------------------------------------------------+-------------
-
-=head1 OAI::DC Dublin Core formating helper
-
-OAI::DC is an helper class for Dublin Core metadata. As Dublin Core have a well known
-set of fields, OAI::DC is a subclass of the OAI::DP class and it implements a default
-behavior to build correct answers. The data references returned by Archive_GetRecord
-and Archive_ListRecords must be instance providing the following method (they are used
-to translate your own data to Dublin Core) : Title(), Identifier(), Subject(), Creator(),
-Date(), Description(), Publisher(), Language() and Type(). The semantic of these methods is
-the same as the corresponding Dublin Core field.
-
-To return correct metadata, you must provide or overide theses methods:
-
-=over
-
-=over
-
-=item B<new>: initialization step,
-
-=item B<dispose>: clean up step,
-
-=item B<Archive_ListSets>: return list of defined sets,
-
-=item B<Archive_GetRecord>: return a record,
-
-=item B<Archive_ListRecords>: return a list of records,
-
-=item B<Archive_ListIdentifiers>: return a list of record identifiers,
-
-=back
-
-=back
-
-=head2 new
-
-=over
-
-Object of this method is to build a new instance of your OAI data provider. At this step
-you can overide somme default information about the repository, you can also initiate
-connexion to a database... Parameters to the new method are user defined.
-
-=back
-
-=head2 dispose
-
-=over
-
-It's time to disconnect from database (if required). Must explicitly call SUPER::dispose().
-
-=back
-
-=head2 Archive_ListSets
-
-=over
-
-Return a reference to an array of list set. Each list set is a reference to a two element array.
-The first element is the set name of the set and the second is its short description.
-
- sub Archive_ListSets {
- [
- [ 'SET1', 'Description of the SET1'],
- [ 'SET2', 'Description of the SET2'],
- ];
- }
-
-=back
-
-=head2 Archive_GetRecord
-
-=over
-
-This method take a record identifier and metadata format as parameter. It must return a reference to
-the data associated to identifier. Data are reference to a hash and must provide methodes describe
-at the begining of DC section.
-
-=back
-
-=head2 Archive_ListRecords
-
-=over
-
-Object of this method is to return a list of records occording to the user query. Parameters of the method
-are the set, the from date, the until date, the metadata type required and a resumption token if supported.
-
-The method must return a reference to a list of records, the metadata type of the answer and reference to
-token information. Token information must be undefined or a reference to a hash with the I<completeListSize>
-and the I<cursor> keys set.
-
-=back
-
-=cut
-
-package C4::OAI::DC;
-
-use C4::OAI::DP;
-use vars ('@ISA');
- at ISA = ("C4::OAI::DP");
-
-# format DC record
-sub FormatDC
-{
- my ($self, $hashref) = @_;
-
- return undef if( $hashref->Status() eq 'deleted' );
-
- {
- title => $hashref->Title(),
- identifier => $hashref->Identifier(),
- subject => $hashref->Subject(),
- creator => $hashref->Creator(),
- date => $hashref->Date(),
- description => $hashref->Description(),
- publisher => $hashref->Publisher(),
- language => $hashref->Language(),
- type => $hashref->Type(),
- mdorder => [ qw (title creator subject description contributor publisher date type format identifier source language relation coverage rights) ]
- };
-}
-
-# format header for ListIdentifiers
-sub Archive_FormatHeader
-{
- my ($self, $hashref, $metadataFormat) = @_;
-
- $self->FormatHeader ($hashref->Identifier()->[0] ,
- $hashref->DateStamp(),
- '',
- $hashref->Set()
- );
-}
-
-# retrieve records from the source archive as required
-sub Archive_FormatRecord
-{
- my ($self, $hashref, $metadataFormat) = @_;
-
- if ($self->MetadataFormatisValid ($metadataFormat) == 0)
- {
- $self->AddError ('cannotDisseminateFormat', 'The value of metadataPrefix ('.$metadataFormat.') is not supported by the repository');
- return '';
- }
-
- my $dc = $self->FormatDC ($hashref);
- my $header = "<oaidc:dc xmlns=\"http://purl.org/dc/elements/1.1/\" ".
- "xmlns:oaidc=\"http://www.openarchives.org/OAI/2.0/oai_dc/\" ".
- "xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" ".
- "xsi:schemaLocation=\"http://www.openarchives.org/OAI/2.0/oai_dc/ ".
- "http://www.openarchives.org/OAI/2.0/oai_dc.xsd\">\n";
- my $footer = "</oaidc:dc>\n";
- my $metadata = '';
-
- $metadata = $header . $self->{'utility'}->FormatXML($dc) . $footer if( $dc );
-
- $self->FormatRecord ($hashref->Identifier()->[0] ,
- $hashref->DateStamp(),
- $hashref->Status(),
- $hashref->Set(),
- $metadata,
- '',
- );
-}
-
-
-# get full list of mdps or list for specific identifier
-sub Archive_ListMetadataFormats
-{
- my ($self, $identifier) = @_;
-
- if ((! defined $identifier) || ($identifier eq '')) {
- return ['oai_dc'];
- }
- else {
- $self->AddError ('idDoesNotExist', 'The value of the identifier argument is unknown or illegal in this repository');
- }
- return [];
-}
-
-
-# get full list of sets from the archive
-sub Archive_ListSets
-{
- [];
-}
-
-
-# get a single record from the archive
-sub Archive_GetRecord
-{
- my ($self, $identifier, $metadataFormat) = @_;
-
- $self->AddError ('idDoesNotExist', 'The value of the identifier argument is unknown or illegal in this repository');
- undef;
-}
-
-# list metadata records from the archive
-sub Archive_ListRecords
-{
- my ($self, $set, $from, $until, $metadataPrefix, $resumptionToken) = @_;
- my $tokenInfo = undef;
-
- $self->AddError ('noRecordsMatch', 'The combination of the values of arguments results in an empty set');
- ( [], $resumptionToken, $metadataPrefix, $tokenInfo );
-}
-
-
-# list identifiers (headers) from the archive
-sub Archive_ListIdentifiers
-{
- my ($self, $set, $from, $until, $metadataPrefix, $resumptionToken) = @_;
-
- if (($metadataPrefix ne '') && ($self->MetadataFormatisValid ($metadataPrefix) == 0))
- {
- $self->AddError ('cannotDisseminateFormat', 'The value of metadataPrefix ('.$metadataPrefix.')is not supported by the repository');
- return '';
- }
-
- $self->Archive_ListRecords ($set, $from, $until, $metadataPrefix, $resumptionToken);
-}
-
-1;
-
diff --git a/C4/OAI/DP.pm b/C4/OAI/DP.pm
deleted file mode 100644
index 361c1fd..0000000
--- a/C4/OAI/DP.pm
+++ /dev/null
@@ -1,923 +0,0 @@
-# ---------------------------------------------------------------------
-# OAI Data Provider template (OAI-PMH v2.0)
-# v3.05
-# June 2002
-# ------------------+--------------------+-----------------------------
-# Hussein Suleman | hussein at vt.edu | www.husseinsspace.com
-# ------------------+--------------------+-+---------------------------
-# Department of Computer Science | www.cs.vt.edu
-# Digital Library Research Laboratory | www.dlib.vt.edu
-# -----------------------------------------+-------------+-------------
-# Virginia Polytechnic Institute and State University | www.vt.edu
-# -------------------------------------------------------+-------------
-# January 2008
-# ------------------+--------------------------------------------------
-# Ph. Jaillon |
-# ------------------+----------------------+---------------------------
-# Department of Computer Science |
-# -----------------------------------------+-------------+-------------
-# Ecole Nationale Superieure des Mines de St-Etienne | www.emse.fr
-# -------------------------------------------------------+-------------
-
-
-$VERSION = '1.0.0';
-
-package C4::OAI::DP;
-
-=head1 OAI::DP OAI Data Provider
-
-This module provide a full implementation of the OAI-PMH v2 protocol
-specification (http://www.openarchives.org/OAI/openarchivesprotocol.html).
-
-It is simple to use, to answer to OAI-PMH requests you must create a new OAI::DP
-instance and call its run() method.
-
-This new instance is an instance of a subclass of the OAI::DP class and the job
-of this subclass is to manage data and to format answers according to the meta data
-model used (see OAI::DC for an example).
-
-Tipical OAI service looks like:
-
- my $OAI = new A_OAI_SUBCLASS(some parameters);
-
- $OAI->run();
- $OAI->dispose();
-
-=cut
-
-use POSIX;
-
-use CGI;
-use C4::OAI::Utility;
-
-# setting binmode to utf8 (any characters printed on STDOUT are utf8 encoded)
-binmode(STDOUT, ":utf8");
-
-# constructor
-sub new
-{
- my ($classname) = @_;
-
- my $self = {
- class => $classname,
- xmlnsprefix => 'http://www.openarchives.org/OAI/2.0/',
- protocolversion => '2.0',
- repositoryName => 'NoName Repository',
- adminEmail => 'someone at somewhere.org',
- granularity => 'YYYY-MM-DD',
- deletedRecord => 'no',
- metadatanamespace => {
- oai_dc => 'http://www.openarchives.org/OAI/2.0/oai_dc/',
- },
- metadataschema => {
- oai_dc => 'http://www.openarchives.org/OAI/2.0/oai_dc.xsd',
- },
- metadataroot => {
- oai_dc => 'dc',
- },
- metadatarootparameters => {
- oai_dc => '',
- },
- utility => new C4::OAI::Utility,
- error => [],
- };
-
- bless $self, $classname;
- return $self;
-}
-
-
-# destructor
-sub dispose
-{
- my ($self) = @_;
-}
-
-
-# output XML HTTP header
-sub xmlheader
-{
- my ($self) = @_;
-
- # calculate timezone automatically
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime (time);
- my $timezone = 'Z';
- my $datestring = sprintf ("%04d-%02d-%02dT%02d:%02d:%02d%s",
- $year+1900, $mon+1, $mday, $hour, $min, $sec,
- $timezone);
-
- # make error strings
- my $errors = '';
- my $fullrequest = 1;
- foreach my $error (@{$self->{'error'}})
- {
- $errors .= "<error code=\"$error->[0]\">$error->[1]</error>\n";
- if (($error->[0] eq 'badVerb') || ($error->[0] eq 'badArgument'))
- {
- $fullrequest = 0;
- }
- }
-
- # add verb container if no errors
- my $verbcontainer = '';
- if ($#{$self->{'error'}} == -1)
- {
- $verbcontainer = '<'.$self->{'verb'}.">\n";
- }
-
- # compute request element with its parameters included if necessary
- my $request = '<request';
- if ($fullrequest == 1)
- {
- foreach my $param ($self->{'cgi'}->param)
- {
- $request .= " $param=\"".$self->{'cgi'}->param ($param)."\"";
- }
- }
- $request .= '>'.$self->{'cgi'}->{'baseURL'}.'</request>';
-
- "Content-type: text/xml\n\n".
- "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n\n".
- "<OAI-PMH xmlns=\"$self->{'xmlnsprefix'}\" ".
- "xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" ".
- "xsi:schemaLocation=\"$self->{'xmlnsprefix'} ".
- "$self->{'xmlnsprefix'}OAI-PMH.xsd\">\n\n".
- "<responseDate>$datestring</responseDate>\n".
- $request."\n\n".
- $errors.
- $verbcontainer;
-}
-
-
-# output XML HTTP footer
-sub xmlfooter
-{
- my ($self) = @_;
-
- # add verb container if no errors
- my $verbcontainer = '';
- if ($#{$self->{'error'}} == -1)
- {
- $verbcontainer = '</'.$self->{'verb'}.">\n";
- }
-
- $verbcontainer.
- "\n</OAI-PMH>\n";
-}
-
-
-# add an error to the running list of errors (if its not there already)
-sub AddError
-{
- my ($self, $errorcode, $errorstring) = @_;
-
- my $found = 0;
- foreach my $error (@{$self->{'error'}})
- {
- if (($error->[0] eq $errorcode) && ($error->[1] eq $errorstring))
- { $found = 1 };
- }
-
- if ($found == 0)
- {
- push (@{$self->{'error'}}, [ $errorcode, $errorstring ] );
- }
-}
-
-
-# create an error and output response
-sub Error
-{
- my ($self, $errorcode, $errorstring) = @_;
-
- $self->AddError ($errorcode, $errorstring);
- $self->xmlheader.$self->xmlfooter;
-}
-
-
-# check for the validity of the date according to the OAI spec
-sub DateisValid
-{
- my ($self, $date) = @_;
-
- my ($year, $month, $day, $hour, $minute, $second);
-
- if ($date =~ /^([0-9]{4})-([0-9]{2})-([0-9]{2})/)
- {
- $year = $1;
- if ($year <= 0)
- { return 0; }
-
- $month = $2;
- if (($month <= 0) || ($month > 12))
- { return 0; }
-
- $day = $3;
- my $daysinmonth;
- if ((((($year % 4) == 0) && (($year % 100) != 0)) || (($year % 400) == 0))
- && ($month == 2))
- { $daysinmonth = 29; }
- elsif (($month == 4) || ($month == 6) || ($month == 9) || ($month == 11))
- { $daysinmonth = 30; }
- elsif ($month == 2)
- { $daysinmonth = 28; }
- else
- { $daysinmonth = 31; }
- if (($day <= 0) || ($day > $daysinmonth))
- { return 0; }
- }
- else
- { return 0; }
-
- if ($date =~ /^[0-9]{4}-[0-9]{2}-[0-9]{2}T([0-9]{2}):([0-9]{2}):([0-9]{2})Z$/)
- {
- $hour = $1;
- $minute = $2;
- if (($hour < 0) || ($hour > 23) || ($minute < 0) || ($minute > 59))
- { return 0; }
-
- $second = $3;
- if (($second < 0) || ($second > 59))
- { return 0; }
- }
- elsif (length ($date) > 10)
- { return 0; }
-
- return 1;
-}
-
-
-# check that the granularity is ok
-sub GranularityisValid
-{
- my ($self, $date1, $date2) = @_;
-
- my $granularity = $self->{'granularity'};
-
- if (($granularity ne 'YYYY-MM-DDThh:mm:ssZ') && (length ($date1) > 10))
- {
- return 0;
- }
- if (defined $date2)
- {
- if (($granularity ne 'YYYY-MM-DDThh:mm:ssZ') && (length ($date2) > 10))
- {
- return 0;
- }
- if (length ($date1) != length ($date2))
- {
- return 0;
- }
- }
-
- return 1;
-}
-
-
-# check for bad arguments
-sub ArgumentisValid
-{
- my ($self) = @_;
-
- my %required = (
- 'Identify' => [],
- 'ListSets' => [],
- 'ListMetadataFormats' => [],
- 'ListIdentifiers' => [ 'metadataPrefix' ],
- 'GetRecord' => [ 'identifier', 'metadataPrefix' ],
- 'ListRecords' => [ 'metadataPrefix' ]
- );
- my %optional = (
- 'Identify' => [],
- 'ListSets' => [],
- 'ListMetadataFormats' => [ 'identifier' ],
- 'ListIdentifiers' => [ 'set', 'from', 'until', 'resumptionToken' ],
- 'GetRecord' => [],
- 'ListRecords' => [ 'set', 'from', 'until', 'resumptionToken' ]
- );
-
- # get parameter lists
- my $verb = $self->{'cgi'}->param ('verb');
- my @parmsrequired = @{$required{$verb}};
- my @parmsoptional = @{$optional{$verb}};
- my @parmsall = (@parmsrequired, @parmsoptional);
- my @names = $self->{'cgi'}->param;
- my %paramhash = ();
- foreach my $name (@names)
- {
- $paramhash{$name} = 1;
- }
-
- # check for required parameters
- foreach my $name (@parmsrequired)
- {
- if ((! exists $paramhash{$name}) &&
- ((($verb ne 'ListIdentifiers') && ($verb ne 'ListRecords')) ||
- (! exists $paramhash{'resumptionToken'})))
- {
- return $self->Error ('badArgument', "missing $name parameter");
- }
- }
-
- # check for illegal parameters
- foreach my $name (@names)
- {
- my $found = 0;
- foreach my $name2 (@parmsall)
- {
- if ($name eq $name2)
- { $found = 1; }
- }
- if (($found == 0) && ($name ne 'verb'))
- {
- return $self->Error ('badArgument', "$name is an illegal parameter");
- }
- }
-
- # check for duplicate parameters
- foreach my $name (@names)
- {
- my @values = $self->{'cgi'}->param ($name);
- if ($#values != 0)
- {
- return $self->Error ('badArgument', "multiple values are not allowed for the $name parameter");
- }
- }
-
- # check for resumptionToken exclusivity
- if ((($verb eq 'ListIdentifiers') || ($verb eq 'ListRecords')) &&
- (exists $paramhash{'resumptionToken'}) &&
- ($#names > 1))
- {
- return $self->Error ('badArgument', 'resumptionToken cannot be combined with other parameters');
- }
-
- return '';
-}
-
-
-# convert date/timestamp into seconds for comparisons
-sub ToSeconds
-{
- my ($self, $date, $from) = @_;
-
- my ($month, $day, $hour, $minute, $second);
-
- if ((defined $from) && ($from == 1))
- {
- ($month, $day, $hour, $minute, $second) = (1, 1, 0, 0, 0);
- }
- else
- {
- ($month, $day, $hour, $minute, $second) = (12, 31, 23, 59, 59);
- }
-
- if ($date =~ /([0-9]{4})-([0-9]{2})-([0-9]{2})T([0-9]{2}):([0-9]{2}):([0-9]{2})Z/)
- {
- return mktime ($6, $5, $4, $3, $2-1, $1-1900);
- }
- elsif ($date =~ /([0-9]{4})-([0-9]{2})-([0-9]{2})/)
- {
- return mktime ($second, $minute, $hour, $3, $2-1, $1-1900);
- }
- else
- {
- return 0;
- }
-}
-
-
-# check if the metadata format is valid
-sub MetadataFormatisValid
-{
- my ($self, $metadataFormat) = @_;
-
- my $found = 0;
- foreach my $i (keys %{$self->{'metadatanamespace'}})
- {
- if ($metadataFormat eq $i)
- { $found = 1; }
- }
-
- if ($found == 1)
- { return 1; }
- else
- { return 0; }
-}
-
-
-# format the header for a record
-sub FormatHeader
-{
- my ($self, $identifier, $datestamp, $status, $setSpecs) = @_;
-
- my $statusattribute = '';
- if ((defined $status) && ($status eq 'deleted'))
- {
- $statusattribute = " status=\"deleted\"";
- }
-
- my $setstring = '';
- if (defined $setSpecs)
- {
- foreach my $setSpec (@$setSpecs)
- {
- $setstring .= '<setSpec>'.$setSpec."</setSpec>\n";
- }
- }
-
- "<header$statusattribute>\n".
- "<identifier>$identifier</identifier>\n".
- "<datestamp>$datestamp</datestamp>\n".
- $setstring.
- "</header>\n";
-}
-
-
-# format the record by encapsulating it in a "record" container
-sub FormatRecord
-{
- my ($self, $identifier, $datestamp, $status, $setSpecs, $metadata, $about) = @_;
-
- my $header = $self->FormatHeader ($identifier, $datestamp, $status, $setSpecs);
-
- my $output =
- "<record>\n".
- $header;
-
- if ((defined $metadata) && ($metadata ne ''))
- {
- $output .= "<metadata>\n$metadata</metadata>\n";
- }
- if ((defined $about) && ($about ne ''))
- {
- $output .= "<about>\n$about</about>\n";
- }
-
- $output."</record>\n";
-}
-
-
-# standard handler for Identify verb
-sub Identify
-{
- my ($self) = @_;
-
- my $identity = $self->Archive_Identify;
- if (! exists $identity->{'repositoryName'})
- {
- $identity->{'repositoryName'} = $self->{'repositoryName'};
- }
- if (! exists $identity->{'adminEmail'})
- {
- $identity->{'adminEmail'} = $self->{'adminEmail'};
- }
- $identity->{'protocolVersion'} = $self->{'protocolversion'};
- $identity->{'baseURL'} = $self->{'cgi'}->{'baseURL'};
- if (! exists $identity->{'granularity'})
- {
- $identity->{'granularity'} = $self->{'granularity'};
- }
- if (! exists $identity->{'deletedRecord'})
- {
- $identity->{'deletedRecord'} = $self->{'deletedRecord'};
- }
- if (! exists $identity->{'earliestDatestamp'})
- {
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime (0);
- my $timezone = 'Z';
- my $datestring = sprintf ("%04d-%02d-%02dT%02d:%02d:%02d%s",
- $year+1900, $mon+1, $mday, $hour, $min, $sec,
- $timezone);
- $identity->{'earliestDatestamp'} = $datestring;
- }
-
- $identity->{'mdorder'} = [ qw ( repositoryName baseURL protocolVersion adminEmail earliestDatestamp deletedRecord granularity compression description ) ];
-
- # add in description for toolkit
- if (! exists $identity->{'description'})
- {
- $identity->{'description'} = [];
- }
- my $desc = {
- 'toolkit' => [[
- {
- 'xmlns' => 'http://oai.dlib.vt.edu/OAI/metadata/toolkit',
- 'xsi:schemaLocation' =>
- 'http://oai.dlib.vt.edu/OAI/metadata/toolkit '.
- 'http://oai.dlib.vt.edu/OAI/metadata/toolkit.xsd'
- },
- {
- 'title' => 'VTOAI Perl Data Provider',
- 'author' => [
- {
- 'name' => 'Hussein Suleman',
- 'email' => 'hussein at vt.edu',
- 'institution' => 'Virginia Tech',
- 'mdorder' => [ qw ( name email institution ) ],
- },
- {
- 'name' => 'Philippe Jaillon',
- 'email' => 'jaillon at emse.fr',
- 'institution' => 'École Nationale Supérieure des Mines de Saint-Étienne',
- 'mdorder' => [ qw ( name email institution ) ],
- }
- ],
- 'version' => '3.05',
- 'URL' => [
- 'http://www.dlib.vt.edu/projects/OAI/',
- 'http://oai-pmh.emse.fr/'
- ],
- 'mdorder' => [ qw ( title author version URL ) ]
- },
- ]]
- };
- push (@{$identity->{'description'}}, $desc);
-
- $self->xmlheader.
- $self->{'utility'}->FormatXML ($identity).
- $self->xmlfooter;
-}
-
-
-# standard handler for ListMetadataFormats verb
-sub ListMetadataFormats
-{
- my ($self) = @_;
-
- my $identifier = $self->{'cgi'}->param ('identifier');
- my $metadataNamespace = $self->{'metadatanamespace'};
- my $metadataSchema = $self->{'metadataschema'};
-
- my $lmf = $self->Archive_ListMetadataFormats ($identifier);
- if ($#$lmf > 0)
- {
- $metadataNamespace = $$lmf[0];
- $metadataSchema = $$lmf[1];
- }
-
- my $buffer = $self->xmlheader;
- if ($#{$self->{'error'}} == -1)
- {
- foreach my $i (keys %{$metadataNamespace})
- {
- $buffer .= "<metadataFormat>\n".
- "<metadataPrefix>$i</metadataPrefix>\n".
- "<schema>$metadataSchema->{$i}</schema>\n".
- "<metadataNamespace>$metadataNamespace->{$i}</metadataNamespace>\n".
- "</metadataFormat>\n";
- }
- }
- $buffer.$self->xmlfooter;
-}
-
-
-# standard handler for ListSets verb
-sub ListSets
-{
- my ($self) = @_;
-
- my $setlist = $self->Archive_ListSets;
-
- if ($#$setlist == -1)
- {
- $self->AddError ('noSetHierarchy', 'The repository does not support sets');
- }
-
- my $buffer = $self->xmlheader;
- if ($#{$self->{'error'}} == -1)
- {
- foreach my $item (@$setlist)
- {
- $buffer .= "<set>\n".
- " <setSpec>".$self->{'utility'}->lclean ($$item[0])."</setSpec>\n".
- " <setName>".$self->{'utility'}->lclean ($$item[1])."</setName>\n";
- if (defined $$item[2])
- {
- $buffer .= '<setDescription>'.$$item[2].'</setDescription>';
- }
- $buffer .= "</set>\n";
- }
- }
- $buffer.$self->xmlfooter;
-}
-
-
-# standard handler for GetRecord verb
-sub GetRecord
-{
- my ($self) = @_;
-
- my $identifier = $self->{'cgi'}->param ('identifier');
- my $metadataPrefix = $self->{'cgi'}->param ('metadataPrefix');
-
- my $recref = $self->Archive_GetRecord ($identifier, $metadataPrefix);
- my $recbuffer;
- if ($recref)
- {
- $recbuffer = $self->Archive_FormatRecord ($recref, $metadataPrefix);
- }
-
- my $buffer = $self->xmlheader;
- if ($#{$self->{'error'}} == -1)
- {
- $buffer .= $recbuffer;
- }
- $buffer.$self->xmlfooter;
-}
-
-
-# create extended resumptionToken
-sub createResumptionToken
-{
- my ($self, $resumptionToken, $resumptionParameters) = @_;
-
- my $attrs = '';
- if (defined $resumptionParameters)
- {
- foreach my $key (keys %{$resumptionParameters})
- {
- $attrs .= " $key=\"$resumptionParameters->{$key}\"";
- }
- }
-
- if (($resumptionToken ne '') || ($attrs ne ''))
- {
- "<resumptionToken".$attrs.">$resumptionToken</resumptionToken>\n";
- }
- else
- {
- '';
- }
-}
-
-
-# standard handler for ListRecords verb
-sub ListRecords
-{
- my ($self) = @_;
-
- my ($set, $from, $until, $metadataPrefix);
- my ($resumptionToken, $allrows, $resumptionParameters);
-
- $resumptionToken = $self->{'cgi'}->param ('resumptionToken');
- if ($resumptionToken eq '')
- {
- $set = $self->{'cgi'}->param ('set');
- $from = $self->{'cgi'}->param ('from');
- $until = $self->{'cgi'}->param ('until');
- $metadataPrefix = $self->{'cgi'}->param ('metadataPrefix');
-
- if ($from ne '')
- {
- if (!($self->DateisValid ($from)))
- { return $self->Error ('badArgument', 'illegal from parameter'); }
- if (!($self->GranularityisValid ($from)))
- { return $self->Error ('badArgument', 'illegal granularity for from parameter'); }
- }
- if ($until ne '')
- {
- if (!($self->DateisValid ($until)))
- { return $self->Error ('badArgument', 'illegal until parameter'); }
- if (!($self->GranularityisValid ($until)))
- { return $self->Error ('badArgument', 'illegal granularity for until parameter'); }
- }
- if (($from ne '') && ($until ne '') && (!($self->GranularityisValid ($from, $until))))
- {
- return $self->Error ('badArgument', 'mismatched granularities in from/until');
- }
- }
-
- ($allrows, $resumptionToken, $metadataPrefix, $resumptionParameters) =
- $self->Archive_ListRecords ($set, $from, $until, $metadataPrefix, $resumptionToken);
-
- my $recbuffer;
- foreach my $recref (@$allrows)
- {
- $recbuffer .= $self->Archive_FormatRecord ($recref, $metadataPrefix);
- }
-
- my $buffer = $self->xmlheader;
- if ($#{$self->{'error'}} == -1)
- {
- $buffer .= $recbuffer.$self->createResumptionToken ($resumptionToken, $resumptionParameters);
- }
- $buffer.$self->xmlfooter;
-}
-
-
-# standard handler for ListIdentifiers verb
-sub ListIdentifiers
-{
- my ($self) = @_;
-
- my ($set, $from, $until, $metadataPrefix);
- my ($resumptionToken, $allrows, $resumptionParameters);
-
- $resumptionToken = $self->{'cgi'}->param ('resumptionToken');
- if ($resumptionToken eq '')
- {
- $set = $self->{'cgi'}->param ('set');
- $from = $self->{'cgi'}->param ('from');
- $until = $self->{'cgi'}->param ('until');
- $metadataPrefix = $self->{'cgi'}->param ('metadataPrefix');
-
- if ($from ne '')
- {
- if (!($self->DateisValid ($from)))
- { return $self->Error ('badArgument', 'illegal from parameter'); }
- if (!($self->GranularityisValid ($from)))
- { return $self->Error ('badArgument', 'illegal granularity for from parameter'); }
- }
- if ($until ne '')
- {
- if (!($self->DateisValid ($until)))
- { return $self->Error ('badArgument', 'illegal until parameter'); }
- if (!($self->GranularityisValid ($until)))
- { return $self->Error ('badArgument', 'illegal granularity for until parameter'); }
- }
- if (($from ne '') && ($until ne '') && (!($self->GranularityisValid ($from, $until))))
- {
- return $self->Error ('badArgument', 'mismatched granularities in from/until');
- }
- }
-
- ($allrows, $resumptionToken, $metadataPrefix, $resumptionParameters) =
- $self->Archive_ListIdentifiers ($set, $from, $until, $metadataPrefix, $resumptionToken);
-
- my $recbuffer = '';
- foreach my $recref (@$allrows)
- {
- $recbuffer .= $self->Archive_FormatHeader ($recref, $metadataPrefix);
- }
-
- my $buffer = $self->xmlheader;
- if ($#{$self->{'error'}} == -1)
- {
- $buffer .= $recbuffer.$self->createResumptionToken ($resumptionToken, $resumptionParameters);
- }
- $buffer.$self->xmlfooter;
-}
-
-
-# stub routines to get actual data from archives
-
-
-sub Archive_FormatRecord
-{
- my ($self, $recref, $metadataFormat) = @_;
-
- $self->FormatRecord ('identifier',
- '1000-01-01',
- '',
- '',
- $self->{'utility'}->FormatXML ({}),
- $self->{'utility'}->FormatXML ({})
- );
-}
-
-
-sub Archive_FormatHeader
-{
- my ($self, $recref, $metadataFormat) = @_;
-
- $self->FormatHeader ('identifier',
- '1000-01-01',
- '',
- ''
- );
-}
-
-
-sub Archive_Identify
-{
- my ($self) = @_;
-
- {};
-}
-
-
-sub Archive_ListSets
-{
- my ($self) = @_;
-
- [];
-}
-
-
-sub Archive_ListMetadataFormats
-{
- my ($self, $identifier) = @_;
-
- [];
-}
-
-
-sub Archive_GetRecord
-{
- my ($self, $identifier, $metadataPrefix) = @_;
-
- my %records = ();
-
- undef;
-}
-
-
-sub Archive_ListRecords
-{
- my ($self, $set, $from, $until, $metadataPrefix, $resumptionToken) = @_;
-
- my $results = [];
- my @allrows = ();
- $resumptionToken = '';
-
- ( \@allrows, $resumptionToken, $metadataPrefix, {} );
-}
-
-
-sub Archive_ListIdentifiers
-{
- my ($self, $set, $from, $until, $metadataPrefix, $resumptionToken) = @_;
-
- my $results = [];
- my @allrows = ();
- $resumptionToken = '';
-
- ( \@allrows, $resumptionToken, $metadataPrefix, {} );
-}
-
-
-# main loop to process parameters and call appropriate verb handler
-sub Run
-{
- my ($self) = @_;
-
- if (! exists $self->{'cgi'})
- {
-## PJ 20071021
- ##$self->{'cgi'} = new Pure::EZCGI;
- $self->{'cgi'} = new CGI;
- }
- $self->{'verb'} = $self->{'cgi'}->param ('verb');
-
- # check for illegal verb
- if (($self->{'verb'} ne 'Identify') &&
- ($self->{'verb'} ne 'ListMetadataFormats') &&
- ($self->{'verb'} ne 'ListSets') &&
- ($self->{'verb'} ne 'ListIdentifiers') &&
- ($self->{'verb'} ne 'GetRecord') &&
- ($self->{'verb'} ne 'ListRecords'))
- {
- print $self->Error ('badVerb', 'illegal OAI verb');
- }
- else
- {
- # check for illegal parameters
- my $aiv = $self->ArgumentisValid;
- if ($aiv ne '')
- {
- print $aiv;
- }
- else
- {
- # run appropriate handler procedure
- if ($self->{'verb'} eq 'Identify')
- { print $self->Identify; }
- elsif ($self->{'verb'} eq 'ListMetadataFormats')
- { print $self->ListMetadataFormats; }
- elsif ($self->{'verb'} eq 'GetRecord')
- { print $self->GetRecord; }
- elsif ($self->{'verb'} eq 'ListSets')
- { print $self->ListSets; }
- elsif ($self->{'verb'} eq 'ListRecords')
- { print $self->ListRecords; }
- elsif ($self->{'verb'} eq 'ListIdentifiers')
- { print $self->ListIdentifiers; }
- }
- }
-}
-
-
-1;
-
-
-# HISTORY
-#
-# 2.01
-# fixed ($identifier) error
-# added status to FormatRecord
-# 2.02
-# added metadataPrefix to GetRecord hander
-# 3.0
-# converted to OAI2.0 alpha1
-# 3.01
-# converted to OAI2.0 alpha2
-# 3.02
-# converted to OAI2.0 alpha3
-# 3.03
-# converted to OAI2.0 beta1
-# 3.04
-# converted to OAI2.0 beta2
-# added better argument handling
-# 3.05
-# polished for OAI2.0
diff --git a/C4/OAI/Utility.pm b/C4/OAI/Utility.pm
deleted file mode 100644
index a4c9812..0000000
--- a/C4/OAI/Utility.pm
+++ /dev/null
@@ -1,204 +0,0 @@
-# ---------------------------------------------------------------------
-# Utility routines for cleaning and formatting XML related to OAI
-# v1.1
-# January 2002
-# ------------------+--------------------+-----------------------------
-# Hussein Suleman | hussein at vt.edu | www.husseinsspace.com
-# ------------------+--------------------+-+---------------------------
-# Department of Computer Science | www.cs.vt.edu
-# Digital Library Research Laboratory | www.dlib.vt.edu
-# -----------------------------------------+-------------+-------------
-# Virginia Polytechnic Institute and State University | www.vt.edu
-# -------------------------------------------------------+-------------
-
-
-package C4::OAI::Utility;
-
-
-# constructor [create mapping for latin entities to Unicode]
-sub new
-{
- my $classname = shift;
-
- my $self = { XMLindent => ' ' };
-
- my @upperentities = qw (nbsp iexcl cent pound curren yen brvbar sect
- uml copy ordf laquo not 173 reg macr deg plusmn
- sup2 sup3 acute micro para middot cedil supl
- ordm raquo frac14 half frac34 iquest Agrave
- Aacute Acirc Atilde Auml Aring AElig Ccedil
- Egrave Eacute Ecirc Euml Igrave Iacute Icirc
- Iuml ETH Ntilde Ograve Oacute Ocirc Otilde Ouml
- times Oslash Ugrave Uacute Ucirc Uuml Yacute
- THORN szlig agrave aacute acirc atilde auml
- aring aelig ccedil egrave eacute ecirc euml
- igrave iacute icirc iuml eth ntilde ograve
- oacute ocirc otilde ouml divide oslash ugrave
- uacute ucirc uuml yacute thorn yuml);
- $upperentities[12] = '#173';
-
- $self->{'hashentity'} = {};
- for ( my $i=0; $i<=$#upperentities; $i++ )
- {
- my $key = '&'.$upperentities[$i].';';
- $self->{'hashentity'}->{$key}=$i+160;
- }
-
- $self->{'hashstr'} = (join (';|', @upperentities)).';';
-
- bless $self, $classname;
- return $self;
-}
-
-
-# clean XML version one - for paragraphs
-sub pclean
-{
- my ($self, $t) = @_;
- return undef if (! defined $t);
- # make ISOlat1 entities into Unicode character entities
- $t =~ s/&($self->{'hashstr'})/sprintf ("&#x%04X;", $self->{'hashentity'}->{$&})/geo;
- # escape non-XML-encoded ampersands (including from other characters sets)
- $t =~ s/&(?!((#[0-9]*)|(#x[0-9]*)|(amp)|(lt)|(gt)|(apos)|(quot));)/&/go;
- # convert extended ascii into Unicode character entities
- $t =~ s/[\xa0-\xff]/'&#'.ord ($&).';'/geo;
- # remove extended ascii that doesnt translate into ISO8859/1
- $t =~ s/[\x00-\x08\x0B\x0C\x0E-\x1f\x80-\x9f]//go;
- # make tags delimiters into entities
- $t =~ s/</</go;
- $t =~ s/>/>/go;
- # convert any whitespace containing lf or cr into a single cr
- $t =~ s/(\s*[\r\n]\s+)|(\s+[\r\n]\s*)/\n/go;
- # convert multiples spaces/tabs into a single space
- $t =~ s/[ \t]+/ /go;
- # kill leading and terminating spaces
- $t =~ s/^[ ]+(.+)[ ]+$/$1/;
- return $t;
-}
-
-
-# clean XML version two - for single-line streams
-sub lclean
-{
- my ($self, $t) = @_;
- return undef if (! defined $t );
- # make ISOlat1 entities into Unicode character entities
- $t =~ s/&($self->{'hashstr'})/sprintf ("&#x%04X;", $self->{'hashentity'}->{$&})/geo;
- # escape non-XML-encoded ampersands (including from other characters sets)
- $t =~ s/&(?!((#[0-9]*)|(#x[0-9]*)|(amp)|(lt)|(gt)|(apos)|(quot));)/&/go;
- # convert extended ascii into Unicode character entities
- $t =~ s/[\xa0-\xff]/'&#'.ord ($&).';'/geo;
- # remove extended ascii that doesnt translate into ISO8859/1
- $t =~ s/[\x00-\x08\x0B\x0C\x0E-\x1f\x80-\x9f]//go;
- # make tags delimiters into entities
- $t =~ s/</</go;
- $t =~ s/>/>/go;
- # flatten whitespace
- $t =~ s/[\s\t\r\n]+/ /go;
- # kill leading and terminating spaces
- $t =~ s/^[ ]+(.+)[ ]+$/$1/;
- return $t;
-}
-
-
-# remove newlines and carriage returns
-sub straighten
-{
- my ($self, $t) = @_;
- # eliminate all carriage returns and linefeeds
- $t =~ s/[\t\r\s\n]+/ /go;
- return $t;
-}
-
-
-# convert a data structure in Perl to XML
-# format of $head:
-# {
-# tag1 => [
-# [
-# { attr1 => val1, attr2 => val2, ... },
-# { children }
-# ],
-# [
-# { attr1 => val1, attr2 => val2, ... },
-# "text string"
-# ],
-# { children },
-# "text string"
-# ],
-# tag2 => { children },
-# tag3 => "text string",
-# mdorder => [ "tag1", "tag2", "tag3" ]
-# }
-#
-sub FormatXML
-{
- my ($self, $head, $indent) = @_;
- $indent .= $self->{'XMLindent'};
- my ($key, $i, $j, $buffer, @orderedkeys);
- $buffer = '';
- if (exists ($head->{'mdorder'}))
- { @orderedkeys = @{$head->{'mdorder'}}; }
- else
- { @orderedkeys = keys %$head; }
- foreach $key (@orderedkeys)
- {
- if ((exists ($head->{$key})) && (ref ($head->{$key}) eq 'ARRAY'))
- {
- foreach $i (@{$head->{$key}})
- {
- if (ref ($i) eq 'ARRAY')
- {
- my $atthash = $$i[0];
- my $childhash = $$i[1];
-
- $buffer .= "$indent<$key";
- foreach $j (keys %$atthash)
- {
- $buffer .= " $j=\"$atthash->{$j}\"";
- }
- $buffer .= ">\n";
-
- if (ref ($childhash) eq 'HASH')
- {
- $buffer .= $self->FormatXML ($childhash, $indent);
- }
- else
- {
- $buffer .= "$indent$childhash\n";
- }
-
- $buffer .= "$indent</$key>\n";
- }
- elsif (ref ($i) eq 'HASH')
- {
- my $nestedbuffer = $self->FormatXML ($i, $indent);
- if ($nestedbuffer ne '')
- {
- $buffer .= "$indent<$key>\n$nestedbuffer$indent</$key>\n";
- }
- }
- else
- {
- $buffer .= "$indent<$key>$i</$key>\n";
- }
- }
- }
- elsif ((exists ($head->{$key})) && (ref ($head->{$key}) eq 'HASH'))
- {
- my $nestedbuffer = $self->FormatXML ($head->{$key}, $indent);
- if ($nestedbuffer ne '')
- {
- $buffer .= "$indent<$key>\n$nestedbuffer$indent</$key>\n";
- }
- }
- elsif ((exists ($head->{$key})) && ($head->{$key} ne ''))
- {
- $buffer .= "$indent<$key>$head->{$key}</$key>\n";
- }
- }
- $buffer;
-}
-
-
-1;
diff --git a/opac/oai.pl b/opac/oai.pl
index 532c3b8..37b9f6f 100755
--- a/opac/oai.pl
+++ b/opac/oai.pl
@@ -1,399 +1,471 @@
#!/usr/bin/perl
use strict;
+use warnings;
+use diagnostics;
+use CGI qw/:standard -oldstyle_urls/;
+use vars qw( $GZIP );
use C4::Context;
-use C4::Biblio;
-=head1 OAI-PMH for koha
-This file is an implementation of the OAI-PMH protocol for koha. Its purpose
-is to share metadata in Dublin core format with harvester like PKP-Harverster.
-Presently, all the bibliographic records managed by the runing koha instance
-are publicly shared (as the opac is).
+BEGIN {
+ eval { require PerlIO::gzip };
+ $GZIP = $@ ? 0 : 1;
+}
-=head1 Package MARC::Record::KOHADC
+unless ( C4::Context->preference('OAI-PMH') ) {
+ print
+ header(
+ -type => 'text/plain; charset=utf-8',
+ -charset => 'utf-8',
+ -status => '404 OAI-PMH service is disabled',
+ ),
+ "OAI-PMH service is disabled";
+ exit;
+}
-This package is a sub-class of the MARC::File::USMARC. It add methods and functions
-to map the content of a marc record (of any flavor) to Dublin core.
-As soon as it is possible, mapping between marc fields and there semantic
-are got from ::GetMarcFromKohaField fonction from C4::Biblio (see also the "Koha
-to MARC mapping" preferences).
+my @encodings = http('HTTP_ACCEPT_ENCODING');
+if ( $GZIP && grep { defined($_) && $_ eq 'gzip' } @encodings ) {
+ print header(
+ -type => 'text/xml; charset=utf-8',
+ -charset => 'utf-8',
+ -Content-Encoding => 'gzip',
+ );
+ binmode( STDOUT, ":gzip" );
+}
+else {
+ print header(
+ -type => 'text/xml; charset=utf-8',
+ -charset => 'utf-8',
+ );
+}
-=cut
+binmode( STDOUT, ":utf8" );
+my $repository = C4::OAI::Repository->new();
-package MARC::Record::KOHADC;
-use vars ('@ISA');
- at ISA = qw(MARC::Record);
+# __END__ Main Prog
-use MARC::File::USMARC;
-sub new { # Get a MAR::Record as parameter and bless it as MARC::Record::KOHADC
- shift;
- my $marc = shift;
- bless $marc if( ref( $marc ) );
-}
+#
+# Extends HTTP::OAI::ResumptionToken
+# A token is identified by:
+# - metadataPrefix
+# - from
+# - until
+# - offset
+#
+package C4::OAI::ResumptionToken;
-sub subfield {
- my $self = shift;
- my ($t,$sf) = @_;
+use strict;
+use warnings;
+use diagnostics;
+use HTTP::OAI;
- return $self->SUPER::subfield( @_ ) unless wantarray;
+use base ("HTTP::OAI::ResumptionToken");
- my @field = $self->field($t);
- my @list = ();
- my $f;
- foreach $f ( @field ) {
- push( @list, $f->subfield( $sf ) );
- }
- return @list;
-}
+sub new {
+ my ($class, %args) = @_;
-sub getfields {
-my $marc = shift;
-my @result = ();
+ my $self = $class->SUPER::new(%args);
- foreach my $kohafield ( @_ ) {
- my ( $field, $subfield ) = ::GetMarcFromKohaField( $kohafield, '' );
- next unless defined $field; # $kohafield not defined in framework
- push( @result, $field < 10 ? $marc->field( $field )->as_string() : $marc->subfield( $field, $subfield ) );
+ my ($metadata_prefix, $offset, $from, $until);
+ if ( $args{ resumptionToken } ) {
+ ($metadata_prefix, $offset, $from, $until)
+ = split( ':', $args{resumptionToken} );
+ }
+ else {
+ $metadata_prefix = $args{ metadataPrefix };
+ $from = $args{ from } || '1970-01-01';
+ $until = $args{ until };
+ unless ( $until) {
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime( time );
+ $until = sprintf( "%.4d-%.2d-%.2d", $year+1900, $mon+1,$mday );
}
-# @result>1 ? \@result : $result[0];
- \@result;
-}
-
-sub XMLescape {
-my ($t) = shift;
-
- foreach (@$t ) {
- s/\&/\&/g; s/</</g;
- }
- $t;
-}
-
-sub Status {
- my $self = shift;
- undef;
-}
+ $offset = $args{ offset } || 0;
+ }
-sub Title {
- my $self = shift;
- &XMLescape( $self->getfields('biblio.title') );
-}
+ $self->{ metadata_prefix } = $metadata_prefix;
+ $self->{ offset } = $offset;
+ $self->{ from } = $from;
+ $self->{ until } = $until;
-sub Creator {
- my $self = shift;
- &XMLescape( $self->getfields('biblio.author') );
-}
+ $self->resumptionToken(
+ join( ':', $metadata_prefix, $offset, $from, $until ) );
+ $self->cursor( $offset );
-sub Subject {
- my $self = shift;
- &XMLescape( $self->getfields('bibliosubject.subject') );
+ return $self;
}
-sub DateStamp {
- my $self = shift;
- my ($d,$h) = split( ' ', $self->{'biblio.timestamp'} );
- $d . "T" . $h . "Z";
-}
+# __END__ C4::OAI::ResumptionToken
-sub Date {
- my $self = shift;
- my ($str) = @{$self->getfields('biblioitems.publicationyear')};
- my ($y,$m,$d) = (substr($str,0,4), substr($str,4,2), substr($str,6,2));
- $y=1970 unless($y>0); $m=1 unless($m>0); $d=1 unless($d>0);
- sprintf( "%.4d-%.2d-%.2d", $y,$m,$d);
-}
+package C4::OAI::Identify;
-sub Description {
- my $self = shift;
- undef;
-}
+use strict;
+use warnings;
+use diagnostics;
+use HTTP::OAI;
+use C4::Context;
-sub Identifier {
- my $self = shift;
- my $id = $self->getfields('biblio.biblionumber')->[0];
-
-# get url of this script and assume that OAI server is in the same place as opac-detail script
-# and build a direct link to the record.
- my $uri = $ENV{'SCRIPT_URI'};
- $uri= "http://" . $ENV{'HTTP_HOST'} . $ENV{'REQUEST_URI'} unless( $uri ); # SCRIPT_URI doesn't exist on all httpd server
- $uri =~ s#[^/]+$##;
- [
- C4::Context->preference("OAI-PMH:archiveID") .":" .$id,
- "${uri}opac-detail.pl?bib=$id",
- @{$self->getfields('biblioitems.isbn', 'biblioitems.issn')}
- ];
-}
+use base ("HTTP::OAI::Identify");
-sub Language {
- my $self = shift;
- undef;
-}
+sub new {
+ my ($class, $repository) = @_;
-sub Type {
- my $self = shift;
- &XMLescape( $self->getfields('biblioitems.itemtype') );
-}
+ my ($baseURL) = $repository->self_url() =~ /(.*)\?.*/;
+ my $self = $class->SUPER::new(
+ baseURL => $baseURL,
+ repositoryName => C4::Context->preference("LibraryName"),
+ adminEmail => C4::Context->preference("KohaAdminEmailAddress"),
+ MaxCount => C4::Context->preference("OAI-PMH:MaxCount"),
+ granularity => 'YYYY-MM-DD',
+ earliestDatestamp => '0001-01-01',
+ );
+ $self->description( "Koha OAI Repository" );
+ $self->compression( 'gzip' );
-sub Publisher {
- my $self = shift;
- &XMLescape( $self->getfields('biblioitems.publishercode') );
+ return $self;
}
-sub Set {
-my $set = &OAI::KOHA::Set();
- [ map( $_=$_->[0], @$set) ];
-}
+# __END__ C4::OAI::Identify
-=head1 The OAI::KOHA package
-This package is a subclass of the OAI::DC data provider. It overides needed methods
-and provide the links between the OAI-PMH request and the koha application.
-The data used in answers are from the koha table I<bibio>.
-=cut
+package C4::OAI::ListMetadataFormats;
-package OAI::KOHA;
+use strict;
+use warnings;
+use diagnostics;
+use HTTP::OAI;
-use C4::OAI::DC;
-use vars ('@ISA');
- at ISA = ("C4::OAI::DC");
+use base ("HTTP::OAI::ListMetadataFormats");
-=head2 Set
+sub new {
+ my ($class, $repository) = @_;
-return the Set list to the I<verb=ListSets> query. Data are from the 'OAI-PMH:Set' preference.
+ my $self = $class->SUPER::new();
-=cut
+ $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
+ metadataPrefix => 'oai_dc',
+ schema => 'http://www.openarchives.org/OAI/2.0/oai_dc.xsd',
+ metadataNamespace => 'http://www.openarchives.org/OAI/2.0/oai_dc/'
+ ) );
+ $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
+ metadataPrefix => 'marcxml',
+ schema => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim.xsd',
+ metadataNamespace => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim'
+ ) );
-sub Set {
-# [
-# ['BRISE','Experimental unimarc set for BRISE network'],
-# ['BRISE:EMSE','EMSE set in BRISE network']
-# ];
-#
-# A blinder correctement
- [ map( $_ = [ split(",", $_)], split( "\n",C4::Context->preference("OAI-PMH:Set") ) ) ];
+ return $self;
}
-=head2 new
+# __END__ C4::OAI::ListMetadataFormats
-The new method is the constructor for this class. It doesn't have any parameters and
-get required data from koha preferences. Koha I<LibraryName> is used to identify the
-OAI-PMH repository, I<OAI-PMH:MaxCount> is used to set the maximun number of records
-returned at the same time in answers to I<verb=ListRecords> or I<verb=ListIdentifiers>
-queries.
-The method return a blessed reference.
-=cut
+package C4::OAI::Record;
-# constructor
-sub new
-{
- my $classname = shift;
- my $self = $classname->SUPER::new ();
+use strict;
+use warnings;
+use diagnostics;
+use HTTP::OAI;
+use HTTP::OAI::Metadata::OAI_DC;
- # set configuration
- $self->{'repositoryName'} = C4::Context->preference("LibraryName");
- $self->{'MaxCount'} = C4::Context->preference("OAI-PMH:MaxCount");
- $self->{'adminEmail'} = C4::Context->preference("KohaAdminEmailAddress");
+use base ("HTTP::OAI::Record");
- bless $self, $classname;
- return $self;
-}
+sub new {
+ my ($class, $repository, $marcxml, $timestamp, %args) = @_;
-=head2 dispose
+ my $self = $class->SUPER::new(%args);
-The dispose method is used as a destructor. It call just the SUPER::dispose method.
+ $timestamp =~ s/ /T/, $timestamp .= 'Z';
+ $self->header( new HTTP::OAI::Header(
+ identifier => $args{identifier},
+ datestamp => $timestamp,
+ ) );
-=cut
+ my $parser = XML::LibXML->new();
+ my $record_dom = $parser->parse_string( $marcxml );
+ if ( $args{metadataPrefix} ne 'marcxml' ) {
+ $record_dom = $repository->oai_dc_stylesheet()->transform( $record_dom );
+ }
+ $self->metadata( HTTP::OAI::Metadata->new( dom => $record_dom ) );
-# destructor
-sub dispose
-{
- my ($self) = @_;
- $self->SUPER::dispose ();
+ return $self;
}
-# now date
-sub now {
-my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime( time );
+# __END__ C4::OAI::Record
- sprintf( "%.4d-%.2d-%.2d", $year+1900, $mon+1,$mday );
-}
-# build the resumptionTocken fom ($metadataPrefix,$offset,$from,$until)
-=head2 buildResumptionToken and parseResumptionToken
+package C4::OAI::GetRecord;
-Theses two functions are used to manage resumption tokens. The choosed syntax is simple as
-possible, a token is only the metadata prefix, the offset in the full answer, the from and
-the until date (in the yyyy-mm-dd format) joined by ':' caracter.
+use strict;
+use warnings;
+use diagnostics;
+use HTTP::OAI;
+
+use base ("HTTP::OAI::GetRecord");
+
+
+sub new {
+ my ($class, $repository, %args) = @_;
+
+ my $self = HTTP::OAI::GetRecord->new(%args);
+
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("
+ SELECT marcxml, timestamp
+ FROM biblioitems
+ WHERE biblionumber=? " );
+ my $prefix = $repository->{koha_identifier} . ':';
+ my ($biblionumber) = $args{identifier} =~ /^$prefix(.*)/;
+ $sth->execute( $biblionumber );
+ my ($marcxml, $timestamp);
+ unless ( ($marcxml, $timestamp) = $sth->fetchrow ) {
+ return HTTP::OAI::Response->new(
+ requestURL => $repository->self_url(),
+ errors => [ new HTTP::OAI::Error(
+ code => 'idDoesNotExist',
+ message => "There is no biblio record with this identifier",
+ ) ] ,
+ );
+ }
-I<buildResumptionToken> get the four elements as parameters and return the ':' separated
-string.
+ #$self->header( HTTP::OAI::Header->new( identifier => $args{identifier} ) );
+ $self->record( C4::OAI::Record->new(
+ $repository, $marcxml, $timestamp, %args ) );
-I<parseResumptionToken> is used to set the default values to the from and until date, the
-metadata prefix using the resumption tocken if necessary. This function have four parameters
-(from,until,metadata prefix and resumption tocken) which can be undefined and return every
-time this list of values correctly set. The missing values are set with defaults: offset=0,
-from= 1970-01-01 and until is set to current date.
+ return $self;
+}
-=cut
+# __END__ C4::OAI::GetRecord
-sub buildResumptionToken {
- join( ':', @_ );
-}
-# parse the resumptionTocken
-sub parseResumptionToken {
-my ($from, $until, $metadataPrefix, $resumptionToken) = @_;
-my $offset = 0;
- if( $resumptionToken ) {
- ($metadataPrefix,$offset,$from,$until) = split( ':', $resumptionToken );
- }
+package C4::OAI::ListIdentifiers;
- $from = "1970-01-01" unless( $from );
- $until = &now unless( $until );
- ($metadataPrefix, $offset, $from, $until );
+use strict;
+use warnings;
+use diagnostics;
+use HTTP::OAI;
+
+use base ("HTTP::OAI::ListIdentifiers");
+
+
+sub new {
+ my ($class, $repository, %args) = @_;
+
+ my $self = HTTP::OAI::ListIdentifiers->new(%args);
+
+ my $token = new C4::OAI::ResumptionToken( %args );
+ my $dbh = C4::Context->dbh;
+ my $sql = "SELECT biblionumber, timestamp
+ FROM biblioitems
+ WHERE timestamp >= ? AND timestamp <= ?
+ LIMIT " . $repository->{koha_max_count} . "
+ OFFSET " . $token->{offset};
+ my $sth = $dbh->prepare( $sql );
+ $sth->execute( $token->{from}, $token->{until} );
+
+ my $pos = $token->{offset};
+ while ( my ($biblionumber, $timestamp) = $sth->fetchrow ) {
+ $timestamp =~ s/ /T/, $timestamp .= 'Z';
+ $self->identifier( new HTTP::OAI::Header(
+ identifier => $repository->{ koha_identifier} . ':' . $biblionumber,
+ datestamp => $timestamp,
+ ) );
+ $pos++;
+ }
+ $self->resumptionToken( new C4::OAI::ResumptionToken(
+ metadataPrefix => $token->{metadata_prefix},
+ from => $token->{from},
+ until => $token->{until},
+ offset => $pos ) );
+
+ return $self;
}
-=head2 Archive_ListSets
+# __END__ C4::OAI::ListIdentifiers
-return the full list Set to the I<verb=ListSets> query. Data are from the 'OAI-PMH:Set' preference.
-=cut
-# get full list of sets from the archive
-sub Archive_ListSets
-{
- &Set();
+package C4::OAI::ListRecords;
+
+use strict;
+use warnings;
+use diagnostics;
+use HTTP::OAI;
+
+use base ("HTTP::OAI::ListRecords");
+
+
+sub new {
+ my ($class, $repository, %args) = @_;
+
+ my $self = HTTP::OAI::ListRecords->new(%args);
+
+ my $token = new C4::OAI::ResumptionToken( %args );
+ my $dbh = C4::Context->dbh;
+ my $sql = "SELECT biblionumber, marcxml, timestamp
+ FROM biblioitems
+ WHERE timestamp >= ? AND timestamp <= ?
+ LIMIT " . $repository->{koha_max_count} . "
+ OFFSET " . $token->{offset};
+ my $sth = $dbh->prepare( $sql );
+ $sth->execute( $token->{from}, $token->{until} );
+
+ my $pos = $token->{offset};
+ while ( my ($biblionumber, $marcxml, $timestamp) = $sth->fetchrow ) {
+ $self->record( C4::OAI::Record->new(
+ $repository, $marcxml, $timestamp,
+ identifier => $repository->{ koha_identifier } . ':' . $biblionumber,
+ metadataPrefix => $token->{metadata_prefix}
+ ) );
+ $pos++;
+ }
+ $self->resumptionToken( new C4::OAI::ResumptionToken(
+ metadataPrefix => $token->{metadata_prefix},
+ from => $token->{from},
+ until => $token->{until},
+ offset => $pos ) );
+
+ return $self;
}
-
-=head2 Archive_GetRecord
-This method select the record specified as its first parameter from the koha I<biblio>
-table and return a reference to a MARC::Record::KOHADC object.
+# __END__ C4::OAI::ListRecords
-=cut
-# get a single record from the archive
-sub Archive_GetRecord
-{
- my ($self, $identifier, $metadataFormat) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT biblionumber,timestamp FROM biblio WHERE biblionumber=?");
- my $prefixID = C4::Context->preference("OAI-PMH:archiveID"); $prefixID=qr{$prefixID:};
-
- $identifier =~ s/^$prefixID//;
-
- $sth->execute( $identifier );
-
- if( my $r = $sth->fetchrow_hashref() ) {
- my $marc = new MARC::Record::KOHADC( ::GetMarcBiblio( $identifier ) );
- if( $marc ) {
- $marc->{'biblio.timestamp'} = $r->{'timestamp'};
- return $marc ;
- }
- else {
- warn("Archive_GetRecord : no MARC record for " . C4::Context->preference("OAI-PMH:archiveID") . ":" . $identifier);
- }
- }
-
- $self->AddError ('idDoesNotExist', 'The value of the identifier argument is unknown or illegal in this repository');
- undef;
-}
-=head2 Archive_ListRecords
+package C4::OAI::Repository;
-This method return a list of 'MaxCount' references to MARC::Record::KOHADC object build from the
-koha I<biblio> table according to its parameters : set, from and until date, metadata prefix
-and resumption token.
+use base ("HTTP::OAI::Repository");
-=cut
+use strict;
+use warnings;
+use diagnostics;
-# list metadata records from the archive
-sub Archive_ListRecords
-{
- my ($self, $set, $from, $until, $metadataPrefix, $resumptionToken) = @_;
-
- my @allrows = ();
- my $marc;
- my $offset;
- my $tokenInfo;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT biblionumber,timestamp FROM biblio WHERE DATE(timestamp) >= ? and DATE(timestamp) <= ? LIMIT ? OFFSET ?");
- my $count;
-
- ($metadataPrefix, $offset, $from, $until ) = &parseResumptionToken($from, $until, $metadataPrefix, $resumptionToken);
-
-#warn( "Archive_ListRecords : $set, $from, $until, $metadataPrefix, $resumptionToken\n");
- $sth->execute( $from,$until,$self->{'MaxCount'}?$self->{'MaxCount'}:100000, $offset );
-
- while( my $r = $sth->fetchrow_hashref() ) {
- my $marc = new MARC::Record::KOHADC( ::GetMarcBiblio( $r->{'biblionumber'} ) );
- unless( $marc ) { # somme time there is problems within koha, and we can't get valid marc record
- warn("Archive_ListRecords : no MARC record for " . C4::Context->preference("OAI-PMH:archiveID") .":" . $r->{'biblionumber'} );
- next;
- }
- $marc->{'biblio.timestamp'} = $r->{'timestamp'};
- push( @allrows, $marc );
- }
-
- $sth = $dbh->prepare("SELECT count(*) FROM biblioitems WHERE DATE(timestamp) >= ? and DATE(timestamp) <= ?");
- $sth->execute($from, $until);
- ( $count ) = $sth->fetchrow_array();
-
- unless( @allrows ) {
- $self->AddError ('noRecordsMatch', 'The combination of the values of arguments results in an empty set');
- }
-
- if( $offset + $self->{'MaxCount'} < $count ) { # Not at the end
- $offset = $offset + $self->{'MaxCount'};
- $resumptionToken = &buildResumptionToken($metadataPrefix,$offset,$from,$until);
- $tokenInfo = { 'completeListSize' => $count, 'cursor' => $offset };
- }
- else {
- $resumptionToken = '';
- $tokenInfo = {};
- }
- ( \@allrows, $resumptionToken, $metadataPrefix, $tokenInfo );
-}
+use HTTP::OAI;
+use HTTP::OAI::Repository qw/:validate/;
-package main;
+use XML::SAX::Writer;
+use XML::LibXML;
+use XML::LibXSLT;
+use CGI qw/:standard -oldstyle_urls/;
-=head1 Main package
+use C4::Context;
+use C4::Biblio;
-The I<main> function is the starting point of the service. The first step is
-to verify if the service is enable using the 'OAI-PMH' preference value
-(See Koha systeme preferences).
-If the service is enable, it create a new instance of the OAI::KOHA data
-provider (see before) and run the service.
+=head1 NAME
+
+C4::OAI::Repository - Handles OAI-PMH requests for a Koha database.
+
+=head1 SYNOPSIS
+
+ use C4::OAI::Repository;
+
+ my $repository = C4::OAI::Repository->new();
+
+=head1 DESCRIPTION
+
+This object extend HTTP::OAI::Repository object.
=cut
-sub disable {
- print "Status:404 OAI-PMH service is disabled\n";
- print "Content-type: text/plain\n\n";
- print "OAI-PMH service is disable.\n";
-}
-sub main
-{
- return &disable() unless( C4::Context->preference('OAI-PMH') );
+sub new {
+ my ($class, %args) = @_;
+ my $self = $class->SUPER::new(%args);
+
+ $self->{ koha_identifier } = C4::Context->preference("OAI-PMH:archiveID");
+ $self->{ koha_max_count } = C4::Context->preference("OAI-PMH:MaxCount");
+ $self->{ koha_metadata_format } = ['oai_dc', 'marcxml'];
- my $OAI = new OAI::KOHA();
- $OAI->Run;
- $OAI->dispose;
+ # Check for grammatical errors in the request
+ my @errs = validate_request( CGI::Vars() );
+
+ # Is metadataPrefix supported by the respository?
+ my $mdp = param('metadataPrefix') || '';
+ if ( $mdp && !grep { $_ eq $mdp } @{$self->{ koha_metadata_format }} ) {
+ push @errs, new HTTP::OAI::Error(
+ code => 'cannotDisseminateFormat',
+ message => "Dissemination as '$mdp' is not supported",
+ );
+ }
+
+ my $response;
+ if ( @errs ) {
+ $response = HTTP::OAI::Response->new(
+ requestURL => self_url(),
+ errors => \@errs,
+ );
+ }
+ else {
+ my %attr = CGI::Vars();
+ my $verb = delete( $attr{verb} );
+ if ( grep { $_ eq $verb } qw( ListSets ) ) {
+ $response = HTTP::OAI::Response->new(
+ requestURL => $self->self_url(),
+ errors => [ new HTTP::OAI::Error(
+ code => 'noSetHierarchy',
+ message => "Koha repository doesn't have sets",
+ ) ] ,
+ );
+ }
+ elsif ( $verb eq 'Identify' ) {
+ $response = C4::OAI::Identify->new( $self );
+ }
+ elsif ( $verb eq 'ListMetadataFormats' ) {
+ $response = C4::OAI::ListMetadataFormats->new( $self );
+ }
+ elsif ( $verb eq 'GetRecord' ) {
+ $response = C4::OAI::GetRecord->new( $self, %attr );
+ }
+ elsif ( $verb eq 'ListRecords' ) {
+ $response = C4::OAI::ListRecords->new( $self, %attr );
+ }
+ elsif ( $verb eq 'ListIdentifiers' ) {
+ $response = C4::OAI::ListIdentifiers->new( $self, %attr );
+ }
+ }
+
+ $response->set_handler( XML::SAX::Writer->new( Output => *STDOUT ) );
+ $response->generate;
+
+ bless $self, $class;
+ return $self;
}
-main;
-1;
+#
+# XSLT stylesheet used to transform MARCXML record into OAI Dublin Core.
+# The object is constructed the fist time this method is called.
+#
+# Styleeet file is located in /koha-tmpl/intranet-tmpl/prog/en/xslt/ directory.
+# Its name is constructed with 'marcflavour' syspref:
+# - MARC21slim2OAIDC.xsl
+# - UNIMARCslim2OADIC.xsl
+#
+sub oai_dc_stylesheet {
+ my $self = shift;
+
+ unless ( $self->{ oai_dc_stylesheet } ) {
+ my $xslt_file = C4::Context->config('intranetdir') .
+ "/koha-tmpl/intranet-tmpl/prog/en/xslt/" .
+ C4::Context->preference('marcflavour') .
+ "slim2OAIDC.xsl";
+ my $parser = XML::LibXML->new();
+ my $xslt = XML::LibXSLT->new();
+ my $style_doc = $parser->parse_file( $xslt_file );
+ my $stylesheet = $xslt->parse_stylesheet( $style_doc );
+ $self->{ oai_dc_stylesheet } = $stylesheet;
+ }
+
+ return $self->{ oai_dc_stylesheet };
+}
+
diff --git a/opac/oai2.pl b/opac/oai2.pl
deleted file mode 100755
index 37b9f6f..0000000
--- a/opac/oai2.pl
+++ /dev/null
@@ -1,471 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use diagnostics;
-
-use CGI qw/:standard -oldstyle_urls/;
-use vars qw( $GZIP );
-use C4::Context;
-
-
-BEGIN {
- eval { require PerlIO::gzip };
- $GZIP = $@ ? 0 : 1;
-}
-
-unless ( C4::Context->preference('OAI-PMH') ) {
- print
- header(
- -type => 'text/plain; charset=utf-8',
- -charset => 'utf-8',
- -status => '404 OAI-PMH service is disabled',
- ),
- "OAI-PMH service is disabled";
- exit;
-}
-
-my @encodings = http('HTTP_ACCEPT_ENCODING');
-if ( $GZIP && grep { defined($_) && $_ eq 'gzip' } @encodings ) {
- print header(
- -type => 'text/xml; charset=utf-8',
- -charset => 'utf-8',
- -Content-Encoding => 'gzip',
- );
- binmode( STDOUT, ":gzip" );
-}
-else {
- print header(
- -type => 'text/xml; charset=utf-8',
- -charset => 'utf-8',
- );
-}
-
-binmode( STDOUT, ":utf8" );
-my $repository = C4::OAI::Repository->new();
-
-# __END__ Main Prog
-
-
-#
-# Extends HTTP::OAI::ResumptionToken
-# A token is identified by:
-# - metadataPrefix
-# - from
-# - until
-# - offset
-#
-package C4::OAI::ResumptionToken;
-
-use strict;
-use warnings;
-use diagnostics;
-use HTTP::OAI;
-
-use base ("HTTP::OAI::ResumptionToken");
-
-
-sub new {
- my ($class, %args) = @_;
-
- my $self = $class->SUPER::new(%args);
-
- my ($metadata_prefix, $offset, $from, $until);
- if ( $args{ resumptionToken } ) {
- ($metadata_prefix, $offset, $from, $until)
- = split( ':', $args{resumptionToken} );
- }
- else {
- $metadata_prefix = $args{ metadataPrefix };
- $from = $args{ from } || '1970-01-01';
- $until = $args{ until };
- unless ( $until) {
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime( time );
- $until = sprintf( "%.4d-%.2d-%.2d", $year+1900, $mon+1,$mday );
- }
- $offset = $args{ offset } || 0;
- }
-
- $self->{ metadata_prefix } = $metadata_prefix;
- $self->{ offset } = $offset;
- $self->{ from } = $from;
- $self->{ until } = $until;
-
- $self->resumptionToken(
- join( ':', $metadata_prefix, $offset, $from, $until ) );
- $self->cursor( $offset );
-
- return $self;
-}
-
-# __END__ C4::OAI::ResumptionToken
-
-
-
-package C4::OAI::Identify;
-
-use strict;
-use warnings;
-use diagnostics;
-use HTTP::OAI;
-use C4::Context;
-
-use base ("HTTP::OAI::Identify");
-
-sub new {
- my ($class, $repository) = @_;
-
- my ($baseURL) = $repository->self_url() =~ /(.*)\?.*/;
- my $self = $class->SUPER::new(
- baseURL => $baseURL,
- repositoryName => C4::Context->preference("LibraryName"),
- adminEmail => C4::Context->preference("KohaAdminEmailAddress"),
- MaxCount => C4::Context->preference("OAI-PMH:MaxCount"),
- granularity => 'YYYY-MM-DD',
- earliestDatestamp => '0001-01-01',
- );
- $self->description( "Koha OAI Repository" );
- $self->compression( 'gzip' );
-
- return $self;
-}
-
-# __END__ C4::OAI::Identify
-
-
-
-package C4::OAI::ListMetadataFormats;
-
-use strict;
-use warnings;
-use diagnostics;
-use HTTP::OAI;
-
-use base ("HTTP::OAI::ListMetadataFormats");
-
-sub new {
- my ($class, $repository) = @_;
-
- my $self = $class->SUPER::new();
-
- $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
- metadataPrefix => 'oai_dc',
- schema => 'http://www.openarchives.org/OAI/2.0/oai_dc.xsd',
- metadataNamespace => 'http://www.openarchives.org/OAI/2.0/oai_dc/'
- ) );
- $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
- metadataPrefix => 'marcxml',
- schema => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim.xsd',
- metadataNamespace => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim'
- ) );
-
- return $self;
-}
-
-# __END__ C4::OAI::ListMetadataFormats
-
-
-
-package C4::OAI::Record;
-
-use strict;
-use warnings;
-use diagnostics;
-use HTTP::OAI;
-use HTTP::OAI::Metadata::OAI_DC;
-
-use base ("HTTP::OAI::Record");
-
-sub new {
- my ($class, $repository, $marcxml, $timestamp, %args) = @_;
-
- my $self = $class->SUPER::new(%args);
-
- $timestamp =~ s/ /T/, $timestamp .= 'Z';
- $self->header( new HTTP::OAI::Header(
- identifier => $args{identifier},
- datestamp => $timestamp,
- ) );
-
- my $parser = XML::LibXML->new();
- my $record_dom = $parser->parse_string( $marcxml );
- if ( $args{metadataPrefix} ne 'marcxml' ) {
- $record_dom = $repository->oai_dc_stylesheet()->transform( $record_dom );
- }
- $self->metadata( HTTP::OAI::Metadata->new( dom => $record_dom ) );
-
- return $self;
-}
-
-# __END__ C4::OAI::Record
-
-
-
-package C4::OAI::GetRecord;
-
-use strict;
-use warnings;
-use diagnostics;
-use HTTP::OAI;
-
-use base ("HTTP::OAI::GetRecord");
-
-
-sub new {
- my ($class, $repository, %args) = @_;
-
- my $self = HTTP::OAI::GetRecord->new(%args);
-
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("
- SELECT marcxml, timestamp
- FROM biblioitems
- WHERE biblionumber=? " );
- my $prefix = $repository->{koha_identifier} . ':';
- my ($biblionumber) = $args{identifier} =~ /^$prefix(.*)/;
- $sth->execute( $biblionumber );
- my ($marcxml, $timestamp);
- unless ( ($marcxml, $timestamp) = $sth->fetchrow ) {
- return HTTP::OAI::Response->new(
- requestURL => $repository->self_url(),
- errors => [ new HTTP::OAI::Error(
- code => 'idDoesNotExist',
- message => "There is no biblio record with this identifier",
- ) ] ,
- );
- }
-
- #$self->header( HTTP::OAI::Header->new( identifier => $args{identifier} ) );
- $self->record( C4::OAI::Record->new(
- $repository, $marcxml, $timestamp, %args ) );
-
- return $self;
-}
-
-# __END__ C4::OAI::GetRecord
-
-
-
-package C4::OAI::ListIdentifiers;
-
-use strict;
-use warnings;
-use diagnostics;
-use HTTP::OAI;
-
-use base ("HTTP::OAI::ListIdentifiers");
-
-
-sub new {
- my ($class, $repository, %args) = @_;
-
- my $self = HTTP::OAI::ListIdentifiers->new(%args);
-
- my $token = new C4::OAI::ResumptionToken( %args );
- my $dbh = C4::Context->dbh;
- my $sql = "SELECT biblionumber, timestamp
- FROM biblioitems
- WHERE timestamp >= ? AND timestamp <= ?
- LIMIT " . $repository->{koha_max_count} . "
- OFFSET " . $token->{offset};
- my $sth = $dbh->prepare( $sql );
- $sth->execute( $token->{from}, $token->{until} );
-
- my $pos = $token->{offset};
- while ( my ($biblionumber, $timestamp) = $sth->fetchrow ) {
- $timestamp =~ s/ /T/, $timestamp .= 'Z';
- $self->identifier( new HTTP::OAI::Header(
- identifier => $repository->{ koha_identifier} . ':' . $biblionumber,
- datestamp => $timestamp,
- ) );
- $pos++;
- }
- $self->resumptionToken( new C4::OAI::ResumptionToken(
- metadataPrefix => $token->{metadata_prefix},
- from => $token->{from},
- until => $token->{until},
- offset => $pos ) );
-
- return $self;
-}
-
-# __END__ C4::OAI::ListIdentifiers
-
-
-
-package C4::OAI::ListRecords;
-
-use strict;
-use warnings;
-use diagnostics;
-use HTTP::OAI;
-
-use base ("HTTP::OAI::ListRecords");
-
-
-sub new {
- my ($class, $repository, %args) = @_;
-
- my $self = HTTP::OAI::ListRecords->new(%args);
-
- my $token = new C4::OAI::ResumptionToken( %args );
- my $dbh = C4::Context->dbh;
- my $sql = "SELECT biblionumber, marcxml, timestamp
- FROM biblioitems
- WHERE timestamp >= ? AND timestamp <= ?
- LIMIT " . $repository->{koha_max_count} . "
- OFFSET " . $token->{offset};
- my $sth = $dbh->prepare( $sql );
- $sth->execute( $token->{from}, $token->{until} );
-
- my $pos = $token->{offset};
- while ( my ($biblionumber, $marcxml, $timestamp) = $sth->fetchrow ) {
- $self->record( C4::OAI::Record->new(
- $repository, $marcxml, $timestamp,
- identifier => $repository->{ koha_identifier } . ':' . $biblionumber,
- metadataPrefix => $token->{metadata_prefix}
- ) );
- $pos++;
- }
- $self->resumptionToken( new C4::OAI::ResumptionToken(
- metadataPrefix => $token->{metadata_prefix},
- from => $token->{from},
- until => $token->{until},
- offset => $pos ) );
-
- return $self;
-}
-
-# __END__ C4::OAI::ListRecords
-
-
-
-package C4::OAI::Repository;
-
-use base ("HTTP::OAI::Repository");
-
-use strict;
-use warnings;
-use diagnostics;
-
-use HTTP::OAI;
-use HTTP::OAI::Repository qw/:validate/;
-
-use XML::SAX::Writer;
-use XML::LibXML;
-use XML::LibXSLT;
-use CGI qw/:standard -oldstyle_urls/;
-
-use C4::Context;
-use C4::Biblio;
-
-
-=head1 NAME
-
-C4::OAI::Repository - Handles OAI-PMH requests for a Koha database.
-
-=head1 SYNOPSIS
-
- use C4::OAI::Repository;
-
- my $repository = C4::OAI::Repository->new();
-
-=head1 DESCRIPTION
-
-This object extend HTTP::OAI::Repository object.
-
-=cut
-
-
-
-sub new {
- my ($class, %args) = @_;
- my $self = $class->SUPER::new(%args);
-
- $self->{ koha_identifier } = C4::Context->preference("OAI-PMH:archiveID");
- $self->{ koha_max_count } = C4::Context->preference("OAI-PMH:MaxCount");
- $self->{ koha_metadata_format } = ['oai_dc', 'marcxml'];
-
- # Check for grammatical errors in the request
- my @errs = validate_request( CGI::Vars() );
-
- # Is metadataPrefix supported by the respository?
- my $mdp = param('metadataPrefix') || '';
- if ( $mdp && !grep { $_ eq $mdp } @{$self->{ koha_metadata_format }} ) {
- push @errs, new HTTP::OAI::Error(
- code => 'cannotDisseminateFormat',
- message => "Dissemination as '$mdp' is not supported",
- );
- }
-
- my $response;
- if ( @errs ) {
- $response = HTTP::OAI::Response->new(
- requestURL => self_url(),
- errors => \@errs,
- );
- }
- else {
- my %attr = CGI::Vars();
- my $verb = delete( $attr{verb} );
- if ( grep { $_ eq $verb } qw( ListSets ) ) {
- $response = HTTP::OAI::Response->new(
- requestURL => $self->self_url(),
- errors => [ new HTTP::OAI::Error(
- code => 'noSetHierarchy',
- message => "Koha repository doesn't have sets",
- ) ] ,
- );
- }
- elsif ( $verb eq 'Identify' ) {
- $response = C4::OAI::Identify->new( $self );
- }
- elsif ( $verb eq 'ListMetadataFormats' ) {
- $response = C4::OAI::ListMetadataFormats->new( $self );
- }
- elsif ( $verb eq 'GetRecord' ) {
- $response = C4::OAI::GetRecord->new( $self, %attr );
- }
- elsif ( $verb eq 'ListRecords' ) {
- $response = C4::OAI::ListRecords->new( $self, %attr );
- }
- elsif ( $verb eq 'ListIdentifiers' ) {
- $response = C4::OAI::ListIdentifiers->new( $self, %attr );
- }
- }
-
- $response->set_handler( XML::SAX::Writer->new( Output => *STDOUT ) );
- $response->generate;
-
- bless $self, $class;
- return $self;
-}
-
-
-#
-# XSLT stylesheet used to transform MARCXML record into OAI Dublin Core.
-# The object is constructed the fist time this method is called.
-#
-# Styleeet file is located in /koha-tmpl/intranet-tmpl/prog/en/xslt/ directory.
-# Its name is constructed with 'marcflavour' syspref:
-# - MARC21slim2OAIDC.xsl
-# - UNIMARCslim2OADIC.xsl
-#
-sub oai_dc_stylesheet {
- my $self = shift;
-
- unless ( $self->{ oai_dc_stylesheet } ) {
- my $xslt_file = C4::Context->config('intranetdir') .
- "/koha-tmpl/intranet-tmpl/prog/en/xslt/" .
- C4::Context->preference('marcflavour') .
- "slim2OAIDC.xsl";
- my $parser = XML::LibXML->new();
- my $xslt = XML::LibXSLT->new();
- my $style_doc = $parser->parse_file( $xslt_file );
- my $stylesheet = $xslt->parse_stylesheet( $style_doc );
- $self->{ oai_dc_stylesheet } = $stylesheet;
- }
-
- return $self->{ oai_dc_stylesheet };
-}
-
--
1.5.6.5
More information about the Koha-patches
mailing list