From 2e850a43561e868789034039ab57b8f69de93d05 Mon Sep 17 00:00:00 2001 From: Galen Charlton Date: Fri, 24 Apr 2009 11:25:05 -0500 Subject: [PATCH] changed OAI-PMH implementation MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Replaced older OAI-PMH server implementation with new one by Frédéric Demians. Signed-off-by: Galen Charlton Signed-off-by: Henri-Damien LAURENT --- 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 e19dd5e3e9..0000000000 --- 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: initialization step, - -=item B: clean up step, - -=item B: return list of defined sets, - -=item B: return a record, - -=item B: return a list of records, - -=item B: 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 -and the I keys set. - -=back - -=cut - -package C4::OAI::DC; - -use C4::OAI::DP; -use vars ('@ISA'); -@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 = "\n"; - my $footer = "\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 361c1fdb82..0000000000 --- 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@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@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 .= "[0]\">$error->[1]\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 = '{'cgi'}->param) - { - $request .= " $param=\"".$self->{'cgi'}->param ($param)."\""; - } - } - $request .= '>'.$self->{'cgi'}->{'baseURL'}.''; - - "Content-type: text/xml\n\n". - "\n\n". - "{'xmlnsprefix'}\" ". - "xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" ". - "xsi:schemaLocation=\"$self->{'xmlnsprefix'} ". - "$self->{'xmlnsprefix'}OAI-PMH.xsd\">\n\n". - "$datestring\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 = '{'verb'}.">\n"; - } - - $verbcontainer. - "\n\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."\n"; - } - } - - "\n". - "$identifier\n". - "$datestamp\n". - $setstring. - "\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 = - "\n". - $header; - - if ((defined $metadata) && ($metadata ne '')) - { - $output .= "\n$metadata\n"; - } - if ((defined $about) && ($about ne '')) - { - $output .= "\n$about\n"; - } - - $output."\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@vt.edu', - 'institution' => 'Virginia Tech', - 'mdorder' => [ qw ( name email institution ) ], - }, - { - 'name' => 'Philippe Jaillon', - 'email' => 'jaillon@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 .= "\n". - "$i\n". - "$metadataSchema->{$i}\n". - "$metadataNamespace->{$i}\n". - "\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 .= "\n". - " ".$self->{'utility'}->lclean ($$item[0])."\n". - " ".$self->{'utility'}->lclean ($$item[1])."\n"; - if (defined $$item[2]) - { - $buffer .= ''.$$item[2].''; - } - $buffer .= "\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\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 a4c9812e70..0000000000 --- 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@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; - # 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; - # 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\n"; - } - elsif (ref ($i) eq 'HASH') - { - my $nestedbuffer = $self->FormatXML ($i, $indent); - if ($nestedbuffer ne '') - { - $buffer .= "$indent<$key>\n$nestedbuffer$indent\n"; - } - } - else - { - $buffer .= "$indent<$key>$i\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\n"; - } - } - elsif ((exists ($head->{$key})) && ($head->{$key} ne '')) - { - $buffer .= "$indent<$key>$head->{$key}\n"; - } - } - $buffer; -} - - -1; diff --git a/opac/oai.pl b/opac/oai.pl index 532c3b883b..37b9f6f66e 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'); -@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/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. -=cut +package C4::OAI::ListMetadataFormats; -package OAI::KOHA; +use strict; +use warnings; +use diagnostics; +use HTTP::OAI; -use C4::OAI::DC; -use vars ('@ISA'); -@ISA = ("C4::OAI::DC"); +use base ("HTTP::OAI::ListMetadataFormats"); -=head2 Set +sub new { + my ($class, $repository) = @_; -return the Set list to the I 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 is used to identify the -OAI-PMH repository, I is used to set the maximun number of records -returned at the same time in answers to I or I -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 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 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 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 -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 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
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 37b9f6f66e..0000000000 --- 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 }; -} - -- 2.39.5