Bug 14939: Modularize OAI Server existing classes
authorFrédéric Demians <f.demians@tamil.fr>
Fri, 2 Oct 2015 07:18:18 +0000 (09:18 +0200)
committerKyle M Hall <kyle@bywatersolutions.com>
Thu, 31 Dec 2015 15:15:05 +0000 (15:15 +0000)
Koha OAI server has been done in one unique .pl file because there
wasn't any object model or rules in the Koha project when it has been
coded. This patch modularized existing classes, putting each class in a
separate file in Koha::OAI::Server namespace. UT begining.

Add new dependency: Capture::Tiny

Signed-off-by: Hector Castro <hector.hecaxmmx@gmail.com>
OAI server moduralized succefully. Works for Debian Jessie and
Wheezy. Test pass successfully

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>

15 files changed:
C4/Installer/PerlDependencies.pm
Koha/OAI/Server/DeletedRecord.pm [new file with mode: 0644]
Koha/OAI/Server/Description.pm [new file with mode: 0644]
Koha/OAI/Server/GetRecord.pm [new file with mode: 0644]
Koha/OAI/Server/Identify.pm [new file with mode: 0644]
Koha/OAI/Server/ListIdentifiers.pm [new file with mode: 0644]
Koha/OAI/Server/ListMetadataFormats.pm [new file with mode: 0644]
Koha/OAI/Server/ListRecords.pm [new file with mode: 0644]
Koha/OAI/Server/ListSets.pm [new file with mode: 0644]
Koha/OAI/Server/Record.pm [new file with mode: 0644]
Koha/OAI/Server/Repository.pm [new file with mode: 0644]
Koha/OAI/Server/ResumptionToken.pm [new file with mode: 0644]
debian/control
opac/oai.pl
t/db_dependent/OAI/Server.t [new file with mode: 0644]

index 778e101..99fd9aa 100644 (file)
@@ -787,6 +787,11 @@ our $PERL_DEPS = {
         'required' => '0',
         'min_ver'  => '0.03',
     },
+    'Capture::Tiny' => {
+        'usage'    => 'Core',
+        'required' => '0',
+        'min_ver'  => '0.18',
+    },
 };
 
 1;
diff --git a/Koha/OAI/Server/DeletedRecord.pm b/Koha/OAI/Server/DeletedRecord.pm
new file mode 100644 (file)
index 0000000..7d03f67
--- /dev/null
@@ -0,0 +1,46 @@
+# Copyright Tamil s.a.r.l. 2008-2015
+# Copyright Biblibre 2008-2015
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+package Koha::OAI::Server::DeletedRecord;
+
+use Modern::Perl;
+use HTTP::OAI;
+use HTTP::OAI::Metadata::OAI_DC;
+
+use base ("HTTP::OAI::Record");
+
+sub new {
+    my ($class, $timestamp, $setSpecs, %args) = @_;
+
+    my $self = $class->SUPER::new(%args);
+
+    $timestamp =~ s/ /T/, $timestamp .= 'Z';
+    $self->header( new HTTP::OAI::Header(
+        status      => 'deleted',
+        identifier  => $args{identifier},
+        datestamp   => $timestamp,
+    ) );
+
+    foreach my $setSpec (@$setSpecs) {
+        $self->header->setSpec($setSpec);
+    }
+
+    return $self;
+}
+
+1;
diff --git a/Koha/OAI/Server/Description.pm b/Koha/OAI/Server/Description.pm
new file mode 100644 (file)
index 0000000..a0e9221
--- /dev/null
@@ -0,0 +1,60 @@
+# Copyright Tamil s.a.r.l. 2008-2015
+# Copyright Biblibre 2008-2015
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+package Koha::OAI::Server::Description;
+
+use Modern::Perl;
+use HTTP::OAI;
+use HTTP::OAI::SAXHandler qw/ :SAX /;
+
+
+sub new {
+    my ( $class, %args ) = @_;
+
+    my $self = {};
+
+    if(my $setDescription = $args{setDescription}) {
+        $self->{setDescription} = $setDescription;
+    }
+    if(my $handler = $args{handler}) {
+        $self->{handler} = $handler;
+    }
+
+    bless $self, $class;
+    return $self;
+}
+
+
+sub set_handler {
+    my ( $self, $handler ) = @_;
+
+    $self->{handler} = $handler if $handler;
+
+    return $self;
+}
+
+
+sub generate {
+    my ( $self ) = @_;
+
+    g_data_element($self->{handler}, 'http://www.openarchives.org/OAI/2.0/', 'setDescription', {}, $self->{setDescription});
+
+    return $self;
+}
+
+1;
diff --git a/Koha/OAI/Server/GetRecord.pm b/Koha/OAI/Server/GetRecord.pm
new file mode 100644 (file)
index 0000000..bf0c3ae
--- /dev/null
@@ -0,0 +1,83 @@
+# Copyright Tamil s.a.r.l. 2008-2015
+# Copyright Biblibre 2008-2015
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+package Koha::OAI::Server::GetRecord;
+
+use Modern::Perl;
+use HTTP::OAI;
+use C4::Biblio;
+use C4::OAI::Sets;
+use MARC::File::XML;
+
+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 timestamp
+        FROM   biblioitems
+        WHERE  biblionumber=? " );
+    my $prefix = $repository->{koha_identifier} . ':';
+    my ($biblionumber) = $args{identifier} =~ /^$prefix(.*)/;
+    $sth->execute( $biblionumber );
+    my ($timestamp, $deleted);
+    unless ( ($timestamp) = $sth->fetchrow ) {
+        unless ( ($timestamp) = $dbh->selectrow_array(q/
+            SELECT timestamp
+            FROM deletedbiblio
+            WHERE biblionumber=? /, undef, $biblionumber ))
+        {
+            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",
+                ) ],
+            );
+        }
+        else {
+            $deleted = 1;
+        }
+    }
+
+    # We fetch it using this method, rather than the database directly,
+    # so it'll include the item data
+    my $marcxml;
+    $marcxml = $repository->get_biblio_marcxml($biblionumber, $args{metadataPrefix})
+        unless $deleted;
+    my $oai_sets = GetOAISetsBiblio($biblionumber);
+    my @setSpecs;
+    foreach (@$oai_sets) {
+        push @setSpecs, $_->{spec};
+    }
+
+    #$self->header( HTTP::OAI::Header->new( identifier  => $args{identifier} ) );
+    $self->record(
+        $deleted
+        ? Koha::OAI::Server::DeletedRecord->new($timestamp, \@setSpecs, %args)
+        : Koha::OAI::Server::Record->new($repository, $marcxml, $timestamp, \@setSpecs, %args)
+    );
+    return $self;
+}
+
+1;
diff --git a/Koha/OAI/Server/Identify.pm b/Koha/OAI/Server/Identify.pm
new file mode 100644 (file)
index 0000000..3ab2188
--- /dev/null
@@ -0,0 +1,52 @@
+# Copyright Tamil s.a.r.l. 2008-2015
+# Copyright Biblibre 2008-2015
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+package Koha::OAI::Server::Identify;
+
+use Modern::Perl;
+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',
+        deletedRecord       => C4::Context->preference("OAI-PMH:DeletedRecord") || 'no',
+    );
+
+    # FIXME - alas, the description element is not so simple; to validate
+    # against the OAI-PMH schema, it cannot contain just a string,
+    # but one or more elements that validate against another XML schema.
+    # For now, simply omitting it.
+    # $self->description( "Koha OAI Repository" );
+
+    $self->compression( 'gzip' );
+
+    return $self;
+}
+
+1;
diff --git a/Koha/OAI/Server/ListIdentifiers.pm b/Koha/OAI/Server/ListIdentifiers.pm
new file mode 100644 (file)
index 0000000..8b6e830
--- /dev/null
@@ -0,0 +1,97 @@
+# Copyright Tamil s.a.r.l. 2008-2015
+# Copyright Biblibre 2008-2015
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+package Koha::OAI::Server::ListIdentifiers;
+
+use Modern::Perl;
+use HTTP::OAI;
+use C4::OAI::Sets;
+
+use base ("HTTP::OAI::ListIdentifiers");
+
+
+sub new {
+    my ($class, $repository, %args) = @_;
+
+    my $self = HTTP::OAI::ListIdentifiers->new(%args);
+
+    my $token = new Koha::OAI::Server::ResumptionToken( %args );
+    my $dbh = C4::Context->dbh;
+    my $set;
+    if(defined $token->{'set'}) {
+        $set = GetOAISetBySpec($token->{'set'});
+    }
+    my $max = $repository->{koha_max_count};
+    my $sql = "
+        (SELECT biblioitems.biblionumber, biblioitems.timestamp
+        FROM biblioitems
+    ";
+    $sql .= " JOIN oai_sets_biblios ON biblioitems.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
+    $sql .= " WHERE timestamp >= ? AND timestamp <= ? ";
+    $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
+    $sql .= ") UNION
+        (SELECT deletedbiblio.biblionumber, timestamp FROM deletedbiblio";
+    $sql .= " JOIN oai_sets_biblios ON deletedbiblio.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
+    $sql .= " WHERE DATE(timestamp) >= ? AND DATE(timestamp) <= ? ";
+    $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
+
+    $sql .= ") ORDER BY biblionumber
+        LIMIT " . ($max+1) . "
+        OFFSET $token->{offset}
+    ";
+    my $sth = $dbh->prepare( $sql );
+    my @bind_params = ($token->{'from_arg'}, $token->{'until_arg'});
+    push @bind_params, $set->{'id'} if defined $set;
+    push @bind_params, ($token->{'from'}, $token->{'until'});
+    push @bind_params, $set->{'id'} if defined $set;
+    $sth->execute( @bind_params );
+
+    my $count = 0;
+    while ( my ($biblionumber, $timestamp) = $sth->fetchrow ) {
+        $count++;
+        if ( $count > $max ) {
+            $self->resumptionToken(
+                new Koha::OAI::Server::ResumptionToken(
+                    metadataPrefix  => $token->{metadata_prefix},
+                    from            => $token->{from},
+                    until           => $token->{until},
+                    offset          => $token->{offset} + $max,
+                    set             => $token->{set}
+                )
+            );
+            last;
+        }
+        $timestamp =~ s/ /T/, $timestamp .= 'Z';
+        $self->identifier( new HTTP::OAI::Header(
+            identifier => $repository->{ koha_identifier} . ':' . $biblionumber,
+            datestamp  => $timestamp,
+        ) );
+    }
+
+    # Return error if no results
+    unless ($count) {
+        return HTTP::OAI::Response->new(
+            requestURL => $repository->self_url(),
+            errors     => [ new HTTP::OAI::Error( code => 'noRecordsMatch' ) ],
+        );
+    }
+
+    return $self;
+}
+
+1;
diff --git a/Koha/OAI/Server/ListMetadataFormats.pm b/Koha/OAI/Server/ListMetadataFormats.pm
new file mode 100644 (file)
index 0000000..d78b084
--- /dev/null
@@ -0,0 +1,57 @@
+# Copyright Tamil s.a.r.l. 2008-2015
+# Copyright Biblibre 2008-2015
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+package Koha::OAI::Server::ListMetadataFormats;
+
+use Modern::Perl;
+use HTTP::OAI;
+
+use base ("HTTP::OAI::ListMetadataFormats");
+
+
+sub new {
+    my ($class, $repository) = @_;
+
+    my $self = $class->SUPER::new();
+
+    if ( $repository->{ conf } ) {
+        foreach my $name ( @{ $repository->{ koha_metadata_format } } ) {
+            my $format = $repository->{ conf }->{ format }->{ $name };
+            $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
+                metadataPrefix    => $format->{metadataPrefix},
+                schema            => $format->{schema},
+                metadataNamespace => $format->{metadataNamespace}, ) );
+        }
+    }
+    else {
+        $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;
+}
+
+1;
diff --git a/Koha/OAI/Server/ListRecords.pm b/Koha/OAI/Server/ListRecords.pm
new file mode 100644 (file)
index 0000000..4411d66
--- /dev/null
@@ -0,0 +1,114 @@
+# Copyright Tamil s.a.r.l. 2008-2015
+# Copyright Biblibre 2008-2015
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+package Koha::OAI::Server::ListRecords;
+
+use Modern::Perl;
+use C4::Biblio;
+use HTTP::OAI;
+use Koha::OAI::Server::ResumptionToken;
+use Koha::OAI::Server::Record;
+use Koha::OAI::Server::DeletedRecord;
+use C4::OAI::Sets;
+use MARC::File::XML;
+
+use base ("HTTP::OAI::ListRecords");
+
+
+sub new {
+    my ($class, $repository, %args) = @_;
+
+    my $self = HTTP::OAI::ListRecords->new(%args);
+
+    my $token = new Koha::OAI::Server::ResumptionToken( %args );
+    my $dbh = C4::Context->dbh;
+    my $set;
+    if(defined $token->{'set'}) {
+        $set = GetOAISetBySpec($token->{'set'});
+    }
+    my $max = $repository->{koha_max_count};
+    my $sql = "
+        (SELECT biblioitems.biblionumber, biblioitems.timestamp, marcxml
+        FROM biblioitems
+    ";
+    $sql .= " JOIN oai_sets_biblios ON biblioitems.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
+    $sql .= " WHERE timestamp >= ? AND timestamp <= ? ";
+    $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
+    $sql .= ") UNION
+        (SELECT deletedbiblio.biblionumber, null as marcxml, timestamp FROM deletedbiblio";
+    $sql .= " JOIN oai_sets_biblios ON deletedbiblio.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
+    $sql .= " WHERE DATE(timestamp) >= ? AND DATE(timestamp) <= ? ";
+    $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
+
+    $sql .= ") ORDER BY biblionumber
+        LIMIT " . ($max + 1) . "
+        OFFSET $token->{offset}
+    ";
+    my $sth = $dbh->prepare( $sql );
+    my @bind_params = ($token->{'from_arg'}, $token->{'until_arg'});
+    push @bind_params, $set->{'id'} if defined $set;
+    push @bind_params, ($token->{'from'}, $token->{'until'});
+    push @bind_params, $set->{'id'} if defined $set;
+    $sth->execute( @bind_params );
+
+    my $count = 0;
+    my $format = $args{metadataPrefix} || $token->{metadata_prefix};
+    while ( my ($biblionumber, $timestamp) = $sth->fetchrow ) {
+        $count++;
+        if ( $count > $max ) {
+            $self->resumptionToken(
+                new Koha::OAI::Server::ResumptionToken(
+                    metadataPrefix  => $token->{metadata_prefix},
+                    from            => $token->{from},
+                    until           => $token->{until},
+                    offset          => $token->{offset} + $max,
+                    set             => $token->{set}
+                )
+            );
+            last;
+        }
+        my $marcxml = $repository->get_biblio_marcxml($biblionumber, $format);
+        my $oai_sets = GetOAISetsBiblio($biblionumber);
+        my @setSpecs;
+        foreach (@$oai_sets) {
+            push @setSpecs, $_->{spec};
+        }
+        if ($marcxml) {
+          $self->record( Koha::OAI::Server::Record->new(
+              $repository, $marcxml, $timestamp, \@setSpecs,
+              identifier      => $repository->{ koha_identifier } . ':' . $biblionumber,
+              metadataPrefix  => $token->{metadata_prefix}
+          ) );
+        } else {
+          $self->record( Koha::OAI::Server::DeletedRecord->new(
+          $timestamp, \@setSpecs, identifier => $repository->{ koha_identifier } . ':' . $biblionumber ) );
+        }
+    }
+
+    # Return error if no results
+    unless ($count) {
+        return HTTP::OAI::Response->new(
+            requestURL => $repository->self_url(),
+            errors     => [ new HTTP::OAI::Error( code => 'noRecordsMatch' ) ],
+        );
+    }
+
+    return $self;
+}
+
+1;
diff --git a/Koha/OAI/Server/ListSets.pm b/Koha/OAI/Server/ListSets.pm
new file mode 100644 (file)
index 0000000..281b762
--- /dev/null
@@ -0,0 +1,66 @@
+# Copyright Tamil s.a.r.l. 2008-2015
+# Copyright Biblibre 2008-2015
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+package Koha::OAI::Server::ListSets;
+
+use Modern::Perl;
+use HTTP::OAI;
+use Koha::OAI::Server::ResumptionToken;
+use Koha::OAI::Server::Description;
+use C4::OAI::Sets;
+
+use base ("HTTP::OAI::ListSets");
+
+
+sub new {
+    my ( $class, $repository, %args ) = @_;
+
+    my $self = HTTP::OAI::ListSets->new(%args);
+    my $token = Koha::OAI::Server::ResumptionToken->new(%args);
+    my $sets = GetOAISets;
+    my $pos = 0;
+    foreach my $set (@$sets) {
+        if ($pos < $token->{offset}) {
+            $pos++;
+            next;
+        }
+        my @descriptions = map {
+            Koha::OAI::Server::Description->new( setDescription => $_ );
+        } @{$set->{'descriptions'}};
+        $self->set(
+            HTTP::OAI::Set->new(
+                setSpec => $set->{'spec'},
+                setName => $set->{'name'},
+                setDescription => \@descriptions,
+            )
+        );
+        $pos++;
+        last if ($pos + 1 - $token->{offset}) > $repository->{koha_max_count};
+    }
+
+    $self->resumptionToken(
+        new Koha::OAI::Server::ResumptionToken(
+            metadataPrefix => $token->{metadata_prefix},
+            offset         => $pos
+        )
+    ) if ( $pos > $token->{offset} );
+
+    return $self;
+}
+
+1;
diff --git a/Koha/OAI/Server/Record.pm b/Koha/OAI/Server/Record.pm
new file mode 100644 (file)
index 0000000..542dfc4
--- /dev/null
@@ -0,0 +1,57 @@
+# Copyright Tamil s.a.r.l. 2008-2015
+# Copyright Biblibre 2008-2015
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+package Koha::OAI::Server::Record;
+
+use Modern::Perl;
+use HTTP::OAI;
+use HTTP::OAI::Metadata::OAI_DC;
+
+use base ("HTTP::OAI::Record");
+
+
+sub new {
+    my ($class, $repository, $marcxml, $timestamp, $setSpecs, %args) = @_;
+
+    my $self = $class->SUPER::new(%args);
+
+    $timestamp =~ s/ /T/, $timestamp .= 'Z';
+    $self->header( new HTTP::OAI::Header(
+        identifier  => $args{identifier},
+        datestamp   => $timestamp,
+    ) );
+
+    foreach my $setSpec (@$setSpecs) {
+        $self->header->setSpec($setSpec);
+    }
+
+    my $parser = XML::LibXML->new();
+    my $record_dom = $parser->parse_string( $marcxml );
+    my $format =  $args{metadataPrefix};
+    if ( $format ne 'marcxml' ) {
+        my %args = (
+            OPACBaseURL => "'" . C4::Context->preference('OPACBaseURL') . "'"
+        );
+        $record_dom = $repository->stylesheet($format)->transform($record_dom, %args);
+    }
+    $self->metadata( HTTP::OAI::Metadata->new( dom => $record_dom ) );
+
+    return $self;
+}
+
+1;
diff --git a/Koha/OAI/Server/Repository.pm b/Koha/OAI/Server/Repository.pm
new file mode 100644 (file)
index 0000000..5a6c9c7
--- /dev/null
@@ -0,0 +1,178 @@
+# Copyright Tamil s.a.r.l. 2008-2015
+# Copyright Biblibre 2008-2015
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+package Koha::OAI::Server::Repository;
+
+use Modern::Perl;
+use HTTP::OAI;
+use HTTP::OAI::Repository qw/:validate/;
+
+use base ("HTTP::OAI::Repository");
+
+use Koha::OAI::Server::Identify;
+use Koha::OAI::Server::ListSets;
+use Koha::OAI::Server::ListMetadataFormats;
+use Koha::OAI::Server::GetRecord;
+use Koha::OAI::Server::ListRecords;
+use Koha::OAI::Server::ListIdentifiers;
+use XML::SAX::Writer;
+use XML::LibXML;
+use XML::LibXSLT;
+use YAML::Syck qw( LoadFile );
+use CGI qw/:standard -oldstyle_urls/;
+use C4::Context;
+use C4::Biblio;
+
+
+=head1 NAME
+
+Koha::OAI::Server::Repository - Handles OAI-PMH requests for a Koha database.
+
+=head1 SYNOPSIS
+
+  use Koha::OAI::Server::Repository;
+
+  my $repository = Koha::OAI::Server::Repository->new();
+
+=head1 DESCRIPTION
+
+This object extend HTTP::OAI::Repository object.
+It accepts OAI-PMH HTTP requests and returns result.
+
+This OAI-PMH server can operate in a simple mode and extended one.
+
+In simple mode, repository configuration comes entirely from Koha system
+preferences (OAI-PMH:archiveID and OAI-PMH:MaxCount) and the server returns
+records in marcxml or dublin core format. Dublin core records are created from
+koha marcxml records transformed with XSLT. Used XSL file is located in koha-
+tmpl/intranet-tmpl/prog/en/xslt directory and chosen based on marcflavour,
+respecively MARC21slim2OAIDC.xsl for MARC21 and  MARC21slim2OAIDC.xsl for
+UNIMARC.
+
+In extended mode, it's possible to parameter other format than marcxml or
+Dublin Core. A new syspref OAI-PMH:ConfFile specify a YAML configuration file
+which list available metadata formats and XSL file used to create them from
+marcxml records. If this syspref isn't set, Koha OAI server works in simple
+mode. A configuration file koha-oai.conf can look like that:
+
+  ---
+  format:
+    vs:
+      metadataPrefix: vs
+      metadataNamespace: http://veryspecial.tamil.fr/vs/format-pivot/1.1/vs
+      schema: http://veryspecial.tamil.fr/vs/format-pivot/1.1/vs.xsd
+      xsl_file: /usr/local/koha/xslt/vs.xsl
+    marcxml:
+      metadataPrefix: marxml
+      metadataNamespace: http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim
+      schema: http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd
+      include_items: 1
+    oai_dc:
+      metadataPrefix: oai_dc
+      metadataNamespace: http://www.openarchives.org/OAI/2.0/oai_dc/
+      schema: http://www.openarchives.org/OAI/2.0/oai_dc.xsd
+      xsl_file: /usr/local/koha/koha-tmpl/intranet-tmpl/xslt/UNIMARCslim2OAIDC.xsl
+
+Note de 'include_items' parameter which is the only mean to return item-level info.
+
+=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'];
+    $self->{ koha_stylesheet      } = { }; # Build when needed
+
+    # Load configuration file if defined in OAI-PMH:ConfFile syspref
+    if ( my $file = C4::Context->preference("OAI-PMH:ConfFile") ) {
+        $self->{ conf } = LoadFile( $file );
+        my @formats = keys %{ $self->{conf}->{format} };
+        $self->{ koha_metadata_format } =  \@formats;
+    }
+
+    # 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};
+        my $class = "Koha::OAI::Server::$verb";
+        $response = $class->new($self, %attr);
+    }
+
+    $response->set_handler( XML::SAX::Writer->new( Output => *STDOUT ) );
+    $response->generate;
+
+    bless $self, $class;
+    return $self;
+}
+
+
+sub get_biblio_marcxml {
+    my ($self, $biblionumber, $format) = @_;
+    my $with_items = 0;
+    if ( my $conf = $self->{conf} ) {
+        $with_items = $conf->{format}->{$format}->{include_items};
+    }
+    my $record = GetMarcBiblio($biblionumber, $with_items, 1);
+    $record ? $record->as_xml() : undef;
+}
+
+
+sub stylesheet {
+    my ( $self, $format ) = @_;
+
+    my $stylesheet = $self->{ koha_stylesheet }->{ $format };
+    unless ( $stylesheet ) {
+        my $xsl_file = $self->{ conf }
+                       ? $self->{ conf }->{ format }->{ $format }->{ xsl_file }
+                       : ( C4::Context->config('intrahtdocs') .
+                         '/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( $xsl_file );
+        $stylesheet = $xslt->parse_stylesheet( $style_doc );
+        $self->{ koha_stylesheet }->{ $format } = $stylesheet;
+    }
+
+    return $stylesheet;
+}
+
+1;
diff --git a/Koha/OAI/Server/ResumptionToken.pm b/Koha/OAI/Server/ResumptionToken.pm
new file mode 100644 (file)
index 0000000..9798059
--- /dev/null
@@ -0,0 +1,83 @@
+# Copyright Tamil s.a.r.l. 2008-2015
+# Copyright Biblibre 2008-2015
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+
+package Koha::OAI::Server::ResumptionToken;
+
+use Modern::Perl;
+use HTTP::OAI;
+
+use base ("HTTP::OAI::ResumptionToken");
+
+
+# Extends HTTP::OAI::ResumptionToken
+# A token is identified by:
+# - metadataPrefix
+# - from
+# - until
+# - offset
+
+
+sub new {
+    my ($class, %args) = @_;
+
+    my $self = $class->SUPER::new(%args);
+
+    my ($metadata_prefix, $offset, $from, $until, $set);
+    if ( $args{ resumptionToken } ) {
+        ($metadata_prefix, $offset, $from, $until, $set)
+            = 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 );
+        }
+        #Add times to the arguments, when necessary, so they correctly match against the DB timestamps
+        $from .= 'T00:00:00Z' if length($from) == 10;
+        $until .= 'T23:59:59Z' if length($until) == 10;
+        $offset = $args{ offset } || 0;
+        $set = $args{set} || '';
+    }
+
+    $self->{ metadata_prefix } = $metadata_prefix;
+    $self->{ offset          } = $offset;
+    $self->{ from            } = $from;
+    $self->{ until           } = $until;
+    $self->{ set             } = $set;
+    $self->{ from_arg        } = _strip_UTC_designators($from);
+    $self->{ until_arg       } = _strip_UTC_designators($until);
+
+    $self->resumptionToken(
+        join( '/', $metadata_prefix, $offset, $from, $until, $set ) );
+    $self->cursor( $offset );
+
+    return $self;
+}
+
+sub _strip_UTC_designators {
+    my ( $timestamp ) = @_;
+    $timestamp =~ s/T/ /g;
+    $timestamp =~ s/Z//g;
+    return $timestamp;
+}
+
+1;
index 8a45389..ae1f9ab 100644 (file)
@@ -226,6 +226,7 @@ Depends: libalgorithm-checkdigits-perl,
  libcache-fastmmap-perl,
  libcache-memcached-fast-perl,
  libcache-perl,
+ libcapture-tiny-perl,
  libcgi-pm-perl | perl-modules,
  libcgi-session-driver-memcached-perl,
  libcgi-session-perl,
index 7eb0f6b..f6a7786 100755 (executable)
@@ -1,6 +1,7 @@
 #!/usr/bin/perl
 
-# Copyright Biblibre 2008
+# Copyright Tamil s.a.r.l. 2008-2015
+# Copyright Biblibre 2008-2015
 #
 # This file is part of Koha.
 #
 # along with Koha; if not, see <http://www.gnu.org/licenses>.
 
 
-use strict;
-use warnings;
-
+use Modern::Perl;
 use CGI qw( :standard -oldstyle_urls -utf8 );
 use vars qw( $GZIP );
 use C4::Context;
+use Koha::OAI::Server::Repository;
 
 
 BEGIN {
@@ -59,741 +59,5 @@ else {
 }
 
 binmode STDOUT, ':encoding(UTF-8)';
-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 HTTP::OAI;
-
-use base ("HTTP::OAI::ResumptionToken");
-
-
-sub new {
-    my ($class, %args) = @_;
-
-    my $self = $class->SUPER::new(%args);
-
-    my ($metadata_prefix, $offset, $from, $until, $set);
-    if ( $args{ resumptionToken } ) {
-        ($metadata_prefix, $offset, $from, $until, $set)
-            = 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 );
-        }
-        #Add times to the arguments, when necessary, so they correctly match against the DB timestamps
-        $from .= 'T00:00:00Z' if length($from) == 10;
-        $until .= 'T23:59:59Z' if length($until) == 10;
-        $offset = $args{ offset } || 0;
-        $set = $args{set} || '';
-    }
-
-    $self->{ metadata_prefix } = $metadata_prefix;
-    $self->{ offset          } = $offset;
-    $self->{ from            } = $from;
-    $self->{ until           } = $until;
-    $self->{ set             } = $set;
-    $self->{ from_arg        } = _strip_UTC_designators($from);
-    $self->{ until_arg       } = _strip_UTC_designators($until);
-
-    $self->resumptionToken(
-        join( '/', $metadata_prefix, $offset, $from, $until, $set ) );
-    $self->cursor( $offset );
-
-    return $self;
-}
-
-sub _strip_UTC_designators {
-    my ( $timestamp ) = @_;
-    $timestamp =~ s/T/ /g;
-    $timestamp =~ s/Z//g;
-    return $timestamp;
-}
-
-# __END__ C4::OAI::ResumptionToken
-
-
-
-package C4::OAI::Identify;
-
-use strict;
-use warnings;
-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',
-        deletedRecord       => C4::Context->preference("OAI-PMH:DeletedRecord") || 'no',
-    );
-
-    # FIXME - alas, the description element is not so simple; to validate
-    # against the OAI-PMH schema, it cannot contain just a string,
-    # but one or more elements that validate against another XML schema.
-    # For now, simply omitting it.
-    # $self->description( "Koha OAI Repository" );
-
-    $self->compression( 'gzip' );
-
-    return $self;
-}
-
-# __END__ C4::OAI::Identify
-
-
-
-package C4::OAI::ListMetadataFormats;
-
-use strict;
-use warnings;
-use HTTP::OAI;
-
-use base ("HTTP::OAI::ListMetadataFormats");
-
-sub new {
-    my ($class, $repository) = @_;
-
-    my $self = $class->SUPER::new();
-
-    if ( $repository->{ conf } ) {
-        foreach my $name ( @{ $repository->{ koha_metadata_format } } ) {
-            my $format = $repository->{ conf }->{ format }->{ $name };
-            $self->metadataFormat( HTTP::OAI::MetadataFormat->new(
-                metadataPrefix    => $format->{metadataPrefix},
-                schema            => $format->{schema},
-                metadataNamespace => $format->{metadataNamespace}, ) );
-        }
-    }
-    else {
-        $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 HTTP::OAI;
-use HTTP::OAI::Metadata::OAI_DC;
-
-use base ("HTTP::OAI::Record");
-
-sub new {
-    my ($class, $repository, $marcxml, $timestamp, $setSpecs, %args) = @_;
-
-    my $self = $class->SUPER::new(%args);
-
-    $timestamp =~ s/ /T/, $timestamp .= 'Z';
-    $self->header( new HTTP::OAI::Header(
-        identifier  => $args{identifier},
-        datestamp   => $timestamp,
-    ) );
-
-    foreach my $setSpec (@$setSpecs) {
-        $self->header->setSpec($setSpec);
-    }
-
-    my $parser = XML::LibXML->new();
-    my $record_dom = $parser->parse_string( $marcxml );
-    my $format =  $args{metadataPrefix};
-    if ( $format ne 'marcxml' ) {
-        my %args = (
-            OPACBaseURL => "'" . C4::Context->preference('OPACBaseURL') . "'"
-        );
-        $record_dom = $repository->stylesheet($format)->transform($record_dom, %args);
-    }
-    $self->metadata( HTTP::OAI::Metadata->new( dom => $record_dom ) );
-
-    return $self;
-}
-
-# __END__ C4::OAI::Record
-
-package C4::OAI::DeletedRecord;
-
-use Modern::Perl;
-use HTTP::OAI;
-use HTTP::OAI::Metadata::OAI_DC;
-
-use base ("HTTP::OAI::Record");
-
-sub new {
-    my ($class, $timestamp, $setSpecs, %args) = @_;
-
-    my $self = $class->SUPER::new(%args);
-
-    $timestamp =~ s/ /T/, $timestamp .= 'Z';
-    $self->header( new HTTP::OAI::Header(
-        status      => 'deleted',
-        identifier  => $args{identifier},
-        datestamp   => $timestamp,
-    ) );
-
-    foreach my $setSpec (@$setSpecs) {
-        $self->header->setSpec($setSpec);
-    }
-
-    return $self;
-}
-
-# __END__ C4::OAI::DeletedRecord
-
-
-
-package C4::OAI::GetRecord;
-
-use strict;
-use warnings;
-use HTTP::OAI;
-use C4::Biblio;
-use C4::OAI::Sets;
-use MARC::File::XML;
-
-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 timestamp
-        FROM   biblioitems
-        WHERE  biblionumber=? " );
-    my $prefix = $repository->{koha_identifier} . ':';
-    my ($biblionumber) = $args{identifier} =~ /^$prefix(.*)/;
-    $sth->execute( $biblionumber );
-    my ($timestamp, $deleted);
-    unless ( ($timestamp) = $sth->fetchrow ) {
-        unless ( ($timestamp) = $dbh->selectrow_array(q/
-            SELECT timestamp
-            FROM deletedbiblio
-            WHERE biblionumber=? /, undef, $biblionumber ))
-        {
-            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",
-                ) ],
-            );
-        }
-        else {
-            $deleted = 1;
-        }
-    }
-
-    # We fetch it using this method, rather than the database directly,
-    # so it'll include the item data
-    my $marcxml;
-    $marcxml = $repository->get_biblio_marcxml($biblionumber, $args{metadataPrefix})
-        unless $deleted;
-    my $oai_sets = GetOAISetsBiblio($biblionumber);
-    my @setSpecs;
-    foreach (@$oai_sets) {
-        push @setSpecs, $_->{spec};
-    }
-
-    #$self->header( HTTP::OAI::Header->new( identifier  => $args{identifier} ) );
-    $self->record(
-        $deleted
-        ? C4::OAI::DeletedRecord->new($timestamp, \@setSpecs, %args)
-        : C4::OAI::Record->new($repository, $marcxml, $timestamp, \@setSpecs, %args)
-    );
-    return $self;
-}
-
-# __END__ C4::OAI::GetRecord
-
-
-
-package C4::OAI::ListIdentifiers;
-
-use strict;
-use warnings;
-use HTTP::OAI;
-use C4::OAI::Sets;
-
-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 $set;
-    if(defined $token->{'set'}) {
-        $set = GetOAISetBySpec($token->{'set'});
-    }
-    my $max = $repository->{koha_max_count};
-    my $sql = "
-        (SELECT biblioitems.biblionumber, biblioitems.timestamp
-        FROM biblioitems
-    ";
-    $sql .= " JOIN oai_sets_biblios ON biblioitems.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
-    $sql .= " WHERE timestamp >= ? AND timestamp <= ? ";
-    $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
-    $sql .= ") UNION
-        (SELECT deletedbiblio.biblionumber, timestamp FROM deletedbiblio";
-    $sql .= " JOIN oai_sets_biblios ON deletedbiblio.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
-    $sql .= " WHERE DATE(timestamp) >= ? AND DATE(timestamp) <= ? ";
-    $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
-
-    $sql .= ") ORDER BY biblionumber
-        LIMIT " . ($max+1) . "
-        OFFSET $token->{offset}
-    ";
-    my $sth = $dbh->prepare( $sql );
-    my @bind_params = ($token->{'from_arg'}, $token->{'until_arg'});
-    push @bind_params, $set->{'id'} if defined $set;
-    push @bind_params, ($token->{'from'}, $token->{'until'});
-    push @bind_params, $set->{'id'} if defined $set;
-    $sth->execute( @bind_params );
-
-    my $count = 0;
-    while ( my ($biblionumber, $timestamp) = $sth->fetchrow ) {
-        $count++;
-        if ( $count > $max ) {
-            $self->resumptionToken(
-                new C4::OAI::ResumptionToken(
-                    metadataPrefix  => $token->{metadata_prefix},
-                    from            => $token->{from},
-                    until           => $token->{until},
-                    offset          => $token->{offset} + $max,
-                    set             => $token->{set}
-                )
-            );
-            last;
-        }
-        $timestamp =~ s/ /T/, $timestamp .= 'Z';
-        $self->identifier( new HTTP::OAI::Header(
-            identifier => $repository->{ koha_identifier} . ':' . $biblionumber,
-            datestamp  => $timestamp,
-        ) );
-    }
-
-    # Return error if no results
-    unless ($count) {
-        return HTTP::OAI::Response->new(
-            requestURL => $repository->self_url(),
-            errors     => [ new HTTP::OAI::Error( code => 'noRecordsMatch' ) ],
-        );
-    }
-
-    return $self;
-}
-
-# __END__ C4::OAI::ListIdentifiers
-
-package C4::OAI::Description;
-
-use strict;
-use warnings;
-use HTTP::OAI;
-use HTTP::OAI::SAXHandler qw/ :SAX /;
-
-sub new {
-    my ( $class, %args ) = @_;
-
-    my $self = {};
-
-    if(my $setDescription = $args{setDescription}) {
-        $self->{setDescription} = $setDescription;
-    }
-    if(my $handler = $args{handler}) {
-        $self->{handler} = $handler;
-    }
-
-    bless $self, $class;
-    return $self;
-}
-
-sub set_handler {
-    my ( $self, $handler ) = @_;
-
-    $self->{handler} = $handler if $handler;
-
-    return $self;
-}
-
-sub generate {
-    my ( $self ) = @_;
-
-    g_data_element($self->{handler}, 'http://www.openarchives.org/OAI/2.0/', 'setDescription', {}, $self->{setDescription});
-
-    return $self;
-}
-
-# __END__ C4::OAI::Description
-
-package C4::OAI::ListSets;
-
-use strict;
-use warnings;
-use HTTP::OAI;
-use C4::OAI::Sets;
-
-use base ("HTTP::OAI::ListSets");
-
-sub new {
-    my ( $class, $repository, %args ) = @_;
-
-    my $self = HTTP::OAI::ListSets->new(%args);
-
-    my $token = C4::OAI::ResumptionToken->new(%args);
-    my $sets = GetOAISets;
-    my $pos = 0;
-    foreach my $set (@$sets) {
-        if ($pos < $token->{offset}) {
-            $pos++;
-            next;
-        }
-        my @descriptions;
-        foreach my $desc (@{$set->{'descriptions'}}) {
-            push @descriptions, C4::OAI::Description->new(
-                setDescription => $desc,
-            );
-        }
-        $self->set(
-            HTTP::OAI::Set->new(
-                setSpec => $set->{'spec'},
-                setName => $set->{'name'},
-                setDescription => \@descriptions,
-            )
-        );
-        $pos++;
-        last if ($pos + 1 - $token->{offset}) > $repository->{koha_max_count};
-    }
-
-    $self->resumptionToken(
-        new C4::OAI::ResumptionToken(
-            metadataPrefix => $token->{metadata_prefix},
-            offset         => $pos
-        )
-    ) if ( $pos > $token->{offset} );
-
-    return $self;
-}
-
-# __END__ C4::OAI::ListSets;
-
-package C4::OAI::ListRecords;
-
-use strict;
-use warnings;
-use C4::Biblio;
-use HTTP::OAI;
-use C4::OAI::Sets;
-use MARC::File::XML;
-
-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 $set;
-    if(defined $token->{'set'}) {
-        $set = GetOAISetBySpec($token->{'set'});
-    }
-    my $max = $repository->{koha_max_count};
-    my $sql = "
-        (SELECT biblioitems.biblionumber, biblioitems.timestamp, marcxml
-        FROM biblioitems
-    ";
-    $sql .= " JOIN oai_sets_biblios ON biblioitems.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
-    $sql .= " WHERE timestamp >= ? AND timestamp <= ? ";
-    $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
-    $sql .= ") UNION
-        (SELECT deletedbiblio.biblionumber, null as marcxml, timestamp FROM deletedbiblio";
-    $sql .= " JOIN oai_sets_biblios ON deletedbiblio.biblionumber = oai_sets_biblios.biblionumber " if defined $set;
-    $sql .= " WHERE DATE(timestamp) >= ? AND DATE(timestamp) <= ? ";
-    $sql .= " AND oai_sets_biblios.set_id = ? " if defined $set;
-
-    $sql .= ") ORDER BY biblionumber
-        LIMIT " . ($max + 1) . "
-        OFFSET $token->{offset}
-    ";
-    my $sth = $dbh->prepare( $sql );
-    my @bind_params = ($token->{'from_arg'}, $token->{'until_arg'});
-    push @bind_params, $set->{'id'} if defined $set;
-    push @bind_params, ($token->{'from'}, $token->{'until'});
-    push @bind_params, $set->{'id'} if defined $set;
-    $sth->execute( @bind_params );
-
-    my $count = 0;
-    my $format = $args{metadataPrefix} || $token->{metadata_prefix};
-    while ( my ($biblionumber, $timestamp) = $sth->fetchrow ) {
-        $count++;
-        if ( $count > $max ) {
-            $self->resumptionToken(
-                new C4::OAI::ResumptionToken(
-                    metadataPrefix  => $token->{metadata_prefix},
-                    from            => $token->{from},
-                    until           => $token->{until},
-                    offset          => $token->{offset} + $max,
-                    set             => $token->{set}
-                )
-            );
-            last;
-        }
-        my $marcxml = $repository->get_biblio_marcxml($biblionumber, $format);
-        my $oai_sets = GetOAISetsBiblio($biblionumber);
-        my @setSpecs;
-        foreach (@$oai_sets) {
-            push @setSpecs, $_->{spec};
-        }
-        if ($marcxml) {
-          $self->record( C4::OAI::Record->new(
-              $repository, $marcxml, $timestamp, \@setSpecs,
-              identifier      => $repository->{ koha_identifier } . ':' . $biblionumber,
-              metadataPrefix  => $token->{metadata_prefix}
-          ) );
-        } else {
-          $self->record( C4::OAI::DeletedRecord->new(
-          $timestamp, \@setSpecs, identifier => $repository->{ koha_identifier } . ':' . $biblionumber ) );
-        }
-    }
-
-    # Return error if no results
-    unless ($count) {
-        return HTTP::OAI::Response->new(
-            requestURL => $repository->self_url(),
-            errors     => [ new HTTP::OAI::Error( code => 'noRecordsMatch' ) ],
-        );
-    }
-
-    return $self;
-}
-
-# __END__ C4::OAI::ListRecords
-
-
-
-package C4::OAI::Repository;
-
-use base ("HTTP::OAI::Repository");
-
-use strict;
-use warnings;
-
-use HTTP::OAI;
-use HTTP::OAI::Repository qw/:validate/;
-
-use XML::SAX::Writer;
-use XML::LibXML;
-use XML::LibXSLT;
-use YAML::Syck qw( LoadFile );
-use CGI qw/:standard -oldstyle_urls/;
-
-use C4::Context;
-use C4::Biblio;
-
-
-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'];
-    $self->{ koha_stylesheet      } = { }; # Build when needed
-
-    # Load configuration file if defined in OAI-PMH:ConfFile syspref
-    if ( my $file = C4::Context->preference("OAI-PMH:ConfFile") ) {
-        $self->{ conf } = LoadFile( $file );
-        my @formats = keys %{ $self->{conf}->{format} };
-        $self->{ koha_metadata_format } =  \@formats;
-    }
-
-    # 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 ( $verb eq 'ListSets' ) {
-            $response = C4::OAI::ListSets->new($self, %attr);
-        }
-        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;
-}
-
-
-sub get_biblio_marcxml {
-    my ($self, $biblionumber, $format) = @_;
-    my $with_items = 0;
-    if ( my $conf = $self->{conf} ) {
-        $with_items = $conf->{format}->{$format}->{include_items};
-    }
-    my $record = GetMarcBiblio($biblionumber, $with_items, 1);
-    $record ? $record->as_xml() : undef;
-}
-
-
-sub stylesheet {
-    my ( $self, $format ) = @_;
-
-    my $stylesheet = $self->{ koha_stylesheet }->{ $format };
-    unless ( $stylesheet ) {
-        my $xsl_file = $self->{ conf }
-                       ? $self->{ conf }->{ format }->{ $format }->{ xsl_file }
-                       : ( C4::Context->config('intrahtdocs') .
-                         '/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( $xsl_file );
-        $stylesheet = $xslt->parse_stylesheet( $style_doc );
-        $self->{ koha_stylesheet }->{ $format } = $stylesheet;
-    }
-
-    return $stylesheet;
-}
-
-
-
-=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.
-It accepts OAI-PMH HTTP requests and returns result.
-
-This OAI-PMH server can operate in a simple mode and extended one.
-
-In simple mode, repository configuration comes entirely from Koha system
-preferences (OAI-PMH:archiveID and OAI-PMH:MaxCount) and the server returns
-records in marcxml or dublin core format. Dublin core records are created from
-koha marcxml records tranformed with XSLT. Used XSL file is located in
-koha-tmpl/intranet-tmpl/prog/en/xslt directory and choosed based on marcflavour,
-respecively MARC21slim2OAIDC.xsl for MARC21 and  MARC21slim2OAIDC.xsl for
-UNIMARC.
-
-In extende mode, it's possible to parameter other format than marcxml or Dublin
-Core. A new syspref OAI-PMH:ConfFile specify a YAML configuration file which
-list available metadata formats and XSL file used to create them from marcxml
-records. If this syspref isn't set, Koha OAI server works in simple mode. A
-configuration file koha-oai.conf can look like that:
-
-  ---
-  format:
-    vs:
-      metadataPrefix: vs
-      metadataNamespace: http://veryspecial.tamil.fr/vs/format-pivot/1.1/vs
-      schema: http://veryspecial.tamil.fr/vs/format-pivot/1.1/vs.xsd
-      xsl_file: /usr/local/koha/xslt/vs.xsl
-    marcxml:
-      metadataPrefix: marxml
-      metadataNamespace: http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim
-      schema: http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd
-    oai_dc:
-      metadataPrefix: oai_dc
-      metadataNamespace: http://www.openarchives.org/OAI/2.0/oai_dc/
-      schema: http://www.openarchives.org/OAI/2.0/oai_dc.xsd
-      xsl_file: /usr/local/koha/koha-tmpl/intranet-tmpl/xslt/UNIMARCslim2OAIDC.xsl
-
-=cut
-
-
 
+my $repository = Koha::OAI::Server::Repository->new();
diff --git a/t/db_dependent/OAI/Server.t b/t/db_dependent/OAI/Server.t
new file mode 100644 (file)
index 0000000..2147068
--- /dev/null
@@ -0,0 +1,120 @@
+#!/usr/bin/perl
+
+# Copyright Tamil s.a.r.l. 2015
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+
+use Modern::Perl;
+use C4::Context;
+use C4::Biblio;
+use Test::More tests => 13;
+use Test::MockModule;
+use Test::Warn;
+use DateTime;
+use Capture::Tiny ':all';
+use XML::Simple;
+use t::lib::Mocks;
+
+
+BEGIN {
+    use_ok('Koha::OAI::Server::DeletedRecord');
+    use_ok('Koha::OAI::Server::Description');
+    use_ok('Koha::OAI::Server::GetRecord');
+    use_ok('Koha::OAI::Server::Identify');
+    use_ok('Koha::OAI::Server::ListIdentifiers');
+    use_ok('Koha::OAI::Server::ListMetadataFormats');
+    use_ok('Koha::OAI::Server::ListRecords');
+    use_ok('Koha::OAI::Server::ListSets');
+    use_ok('Koha::OAI::Server::Record');
+    use_ok('Koha::OAI::Server::Repository');
+    use_ok('Koha::OAI::Server::ResumptionToken');
+}
+
+
+# Mocked CGI module in order to be able to send CGI parameters to OAI Server
+my %param;
+my $module = Test::MockModule->new('CGI');
+$module->mock('Vars', sub { %param; });
+
+my $dbh = C4::Context->dbh;
+$dbh->{AutoCommit} = 0;
+$dbh->{RaiseError} = 1;
+$dbh->do('DELETE FROM issues');
+$dbh->do('DELETE FROM biblio');
+$dbh->do('DELETE FROM biblioitems');
+$dbh->do('DELETE FROM items');
+
+# Add 10 biblio records
+my @bibs = map {
+    my $record = MARC::Record->new();
+    $record->append_fields( MARC::Field->new('245', '', '', 'a' => "Title $_" ) );
+    my ($biblionumber) = AddBiblio($record, '');
+    $biblionumber;
+} (1..10);
+
+t::lib::Mocks::mock_preference('LibraryName', 'My Library');
+t::lib::Mocks::mock_preference('OAI::PMH', 1);
+t::lib::Mocks::mock_preference('OAI-PMH:archiveID', 'TEST');
+t::lib::Mocks::mock_preference('OAI-PMH:ConfFile', '' );
+t::lib::Mocks::mock_preference('OAI-PMH:MaxCount', 3);
+t::lib::Mocks::mock_preference('OAI-PMH:DeletedRecord', 'persistent');
+
+%param = ( verb => 'ListMetadataFormats' );
+my ($response) = capture { Koha::OAI::Server::Repository->new(); };
+$response = XMLin($response);
+my $now = DateTime->now . 'Z';
+my $expected = {
+    request => 'http://localhost',
+    responseDate => $now,
+    xmlns => 'http://www.openarchives.org/OAI/2.0/',
+    'xmlns:xsi' => 'http://www.w3.org/2001/XMLSchema-instance',
+    'xsi:schemaLocation' => 'http://www.openarchives.org/OAI/2.0/ http://www.openarchives.org/OAI/2.0/OAI-PMH.xsd',
+    ListMetadataFormats => {
+        metadataFormat => [
+            {
+                metadataNamespace => 'http://www.openarchives.org/OAI/2.0/oai_dc/',
+                metadataPrefix=> 'oai_dc',
+                schema => 'http://www.openarchives.org/OAI/2.0/oai_dc.xsd',
+            },
+            {
+                metadataNamespace => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim',
+                metadataPrefix => 'marcxml',
+                schema => 'http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim.xsd',
+            },
+        ],
+    },
+};
+is_deeply($response, $expected, "ListMetadataFormats");
+
+%param = ( verb => 'ListIdentifiers' );
+($response) = capture { Koha::OAI::Server::Repository->new(); };
+$response = XMLin($response);
+$now = DateTime->now . 'Z';
+$expected = {
+    request => 'http://localhost',
+    responseDate => $now,
+    xmlns => 'http://www.openarchives.org/OAI/2.0/',
+    'xmlns:xsi' => 'http://www.w3.org/2001/XMLSchema-instance',
+    'xsi:schemaLocation' => 'http://www.openarchives.org/OAI/2.0/ http://www.openarchives.org/OAI/2.0/OAI-PMH.xsd',
+    error => {
+        code => 'badArgument',
+        content => "Required argument 'metadataPrefix' was undefined",
+    },
+};
+is_deeply($response, $expected, "ListIdentifiers without metadaPrefix argument");
+
+$dbh->rollback;