Plack-App-Catmandu-OAI
view release on metacpan or search on metacpan
lib/Plack/App/Catmandu/OAI.pm view on Meta::CPAN
package Plack::App::Catmandu::OAI;
our $VERSION = '0.02';
use Catmandu::Sane;
use Catmandu::Util qw(:is io);
use Catmandu::Error;
use Catmandu;
use Moo;
use Types::Standard qw(Str ArrayRef HashRef Enum Int CodeRef ScalarRef);
use Types::Common::String qw(NonEmptyStr);
use Types::Common::Numeric qw(PositiveInt);
use Catmandu::Exporter::Template;
use Catmandu::Fix;
use Data::MessagePack;
use MIME::Base64 qw(encode_base64url decode_base64url);
use DateTime;
use DateTime::Format::ISO8601;
use DateTime::Format::Strptime;
use Try::Tiny;
use Plack::Request;
use namespace::clean;
use feature qw(signatures);
no warnings qw(experimental::signatures);
has store_name => (
is => 'ro',
isa => Str,
init_arg => 'store',
);
has bag_name => (
is => 'ro',
isa => Str,
init_arg => 'bag',
);
has fix => (
is => 'ro',
coerce => sub {
if (is_string($_[0])) {
$_[0] = Catmandu::Fix->new(fixes => [$_[0]]);
} elsif (is_array_ref($_[0])) {
$_[0] = Catmandu::Fix->new(fixes => $_[0]);
}
$_[0];
},
);
has deleted => (
is => 'ro',
isa => CodeRef,
default => sub { sub {0}; },
);
has set_specs_for => (
is => 'ro',
isa => CodeRef,
default => sub { sub {[];}; },
);
has datestamp_field => (
is => 'ro',
isa => NonEmptyStr,
required => 1,
);
has datestamp_index => (
is => 'lazy',
isa => NonEmptyStr,
);
has repositoryName => (
lib/Plack/App/Catmandu/OAI.pm view on Meta::CPAN
[%- ELSE %]
<resumptionToken completeListSize="[% total %]"/>
[%- END %]
</ListRecords>
$template_footer
TT
$self->_templ_list_records(\$template_list_records);
my $template_list_metadata_formats = <<TT;
$template_header
<ListMetadataFormats>
TT
for my $format (@{$self->metadata_formats}) {
$template_list_metadata_formats .= <<TT;
<metadataFormat>
<metadataPrefix>$format->{metadataPrefix}</metadataPrefix>
<schema>$format->{schema}</schema>
<metadataNamespace>$format->{metadataNamespace}</metadataNamespace>
</metadataFormat>
TT
}
$template_list_metadata_formats .= <<TT;
</ListMetadataFormats>
$template_footer
TT
$self->_templ_list_metadata_formats(\$template_list_metadata_formats);
my $template_list_sets = <<TT;
$template_header
<ListSets>
TT
for my $set (@{$self->sets}) {
$template_list_sets .= <<TT;
<set>
<setSpec>$set->{setSpec}</setSpec>
<setName>$set->{setName}</setName>
TT
my $set_descriptions = $set->{setDescription} // [];
$set_descriptions = [$set_descriptions]
unless is_array_ref($set_descriptions);
$template_list_sets .= "<setDescription>$_</setDescription>"
for @$set_descriptions;
$template_list_sets .= <<TT;
</set>
TT
}
$template_list_sets .= <<TT;
</ListSets>
$template_footer
TT
$self->_templ_list_sets(\$template_list_sets);
}
sub _tt_process ($self, $tmpl, $data) {
my $out = "";
open my $fh, '>:utf8', \$out;
my $exporter = Catmandu::Exporter::Template->new(
template => $tmpl,
fh => $fh,
);
$exporter->add($data);
$exporter->commit;
$out;
}
sub _render ($self, $body) {
[200, ['Content-Type' => 'application/xml; charset=utf-8'], [$body]];
}
sub _render_error ($self, $vars) {
$self->_render($self->_tt_process($self->_templ_error, $vars));
}
my $VERBS = {
GetRecord => {
valid => {metadataPrefix => 1, identifier => 1},
required => [qw(metadataPrefix identifier)],
},
Identify => {valid => {}, required => []},
ListIdentifiers => {
valid => {
metadataPrefix => 1,
from => 1,
until => 1,
set => 1,
resumptionToken => 1
},
required => [qw(metadataPrefix)],
},
ListMetadataFormats =>
{valid => {identifier => 1, resumptionToken => 1}, required => []},
ListRecords => {
valid => {
metadataPrefix => 1,
from => 1,
until => 1,
set => 1,
resumptionToken => 1
},
required => [qw(metadataPrefix)],
},
ListSets => {valid => {resumptionToken => 1}, required => []},
};
sub _new_token ($self, $hits, $params, $from, $until, $old_token = undef) {
my $n = $old_token && $old_token->{_n} ? $old_token->{_n} : 0;
$n += $hits->size;
return unless $n < $hits->total;
my $strategy = $self->search_strategy;
my $token;
if ($strategy eq 'paginate' && $hits->more) {
$token = {start => $hits->start + $hits->limit};
}
lib/Plack/App/Catmandu/OAI.pm view on Meta::CPAN
};
}
}
if (my $setSpec = $params->get('set')) {
if (scalar(@{$self->sets}) == 0) {
push @$errors, [noSetHierarchy => "sets are not supported"];
} else {
for (@{$self->sets}) {
if ($_->{setSpec} eq $setSpec) {
$set = $_;
last;
}
}
unless ($self) {
push @$errors, [badArgument => "set does not exist"];
}
}
}
if (my $metadataPrefix = $params->get('metadataPrefix')) {
for (@{$self->metadata_formats}) {
if ($metadataPrefix eq $_->{metadataPrefix}) {
$format = $_;
last;
}
}
unless ($format) {
push @$errors,
[cannotDisseminateFormat =>
"metadataPrefix $metadataPrefix is not supported"
];
}
}
if (@$errors) {
return $self->_render_error($vars);
}
if ($verb eq 'GetRecord') {
my $id = $params->get('identifier');
$id =~ s/^$ns//;
my $rec = $self->_bag->search(
%{$self->default_search_params},
cql_query => sprintf($self->get_record_cql_pattern, $id),
start => 0,
limit => 1,
)->first;
if (defined $rec) {
if ($self->fix) {
$rec = $self->fix->fix($rec);
}
$vars->{id} = $id;
$vars->{datestamp} = $self->_datestamp_formatter->($rec->{$self->datestamp_field()});
$vars->{deleted} = $self->deleted->($rec);
$vars->{setSpec} = $self->set_specs_for->($rec);
my $metadata = "";
my $exporter = Catmandu::Exporter::Template->new(
%{$self->template_options},
template => $format->{template},
file => \$metadata,
);
if ($format->{fix}) {
$rec = $format->{fix}->fix($rec);
}
$exporter->add($rec);
$exporter->commit;
$vars->{metadata} = $metadata;
unless ($vars->{deleted} && $self->deletedRecord eq 'no') {
return $self->_render($self->_tt_process($self->_templ_get_record, $vars));
}
}
push @$errors,
[idDoesNotExist =>
"identifier $params->{identifier} is unknown or illegal"
];
return $self->_render_error($vars);
} elsif ($verb eq 'Identify') {
$vars->{earliest_datestamp} = $self->earliestDatestamp || do {
my $hits = $self->_bag->search(
%{$self->default_search_params},
cql_query => $self->cql_filter || 'cql.allRecords',
limit => 1,
sru_sortkeys => $self->datestamp_index.",,1",
);
if (my $rec = $hits->first) {
$self->_datestamp_formatter->($rec->{$self->datestamp_field});
} else {
'1970-01-01T00:00:01Z';
}
};
return $self->_render($self->_tt_process($self->_templ_identify, $vars));
} elsif ($verb eq 'ListIdentifiers' || $verb eq 'ListRecords') {
my $from = $params->get('from');
my $until = $params->get('until');
for my $datestamp (($from, $until)) {
$datestamp || next;
if ($datestamp !~ /^\d{4}-\d{2}-\d{2}(?:T\d{2}:\d{2}:\d{2}Z)?$/o) {
push @$errors,
[badArgument =>
"datestamps must have the format YYYY-MM-DD or YYYY-MM-DDThh:mm:ssZ"
];
return $self->_render_error($vars);
}
}
if ($from && $until && length($from) != length($until)) {
push @$errors,
[
badArgument => "datestamps must have the same granularity"
];
return $self->_render_error($vars);
}
lib/Plack/App/Catmandu/OAI.pm view on Meta::CPAN
return $self->_render_error($vars);
}
if (
defined(
my $new_token = $self->_new_token(
$search, $params,
$from, $until, $vars->{token}
)
)
)
{
$vars->{resumption_token} = $self->_serialize_token($new_token);
}
$vars->{total} = $search->total;
if ($verb eq 'ListIdentifiers') {
$vars->{records} = [
map {
my $rec = $_;
my $id = $rec->{$self->_bag->id_key};
if ($self->fix) {
$rec = $self->fix->fix($rec);
}
{
id => $id,
datestamp => $self->_datestamp_formatter->(
$rec->{$self->datestamp_field()}
),
deleted => $self->deleted->($rec),
setSpec => $self->set_specs_for->($rec),
};
} @{$search->hits}
];
return $self->_render($self->_tt_process($self->_templ_list_identifiers, $vars));
} else {
$vars->{records} = [
map {
my $rec = $_;
my $id = $rec->{$self->_bag->id_key};
if ($self->fix) {
$rec = $self->fix->fix($rec);
}
my $deleted = $self->deleted->($rec);
my $rec_vars = {
id => $id,
datestamp => $self->_datestamp_formatter->(
$rec->{$self->datestamp_field()}
),
deleted => $deleted,
setSpec => $self->set_specs_for->($rec),
};
unless ($deleted) {
my $metadata = "";
my $exporter = Catmandu::Exporter::Template->new(
%{$self->template_options},
template => $format->{template},
file => \$metadata,
);
if ($format->{fix}) {
$rec = $format->{fix}->fix($rec);
}
$exporter->add($rec);
$exporter->commit;
$rec_vars->{metadata} = $metadata;
}
$rec_vars;
} @{$search->hits}
];
return $self->_render($self->_tt_process($self->_templ_list_records, $vars));
}
} elsif ($verb eq 'ListMetadataFormats') {
if (my $id = $params->get('identifier')) {
$id =~ s/^$ns//;
unless ($self->_bag->get($id)) {
push @$errors,
[idDoesNotExist =>
"identifier $id is unknown or illegal"
];
return $self->_render_error($vars);
}
}
return $self->_render($self->_tt_process($self->_templ_list_metadata_formats, $vars));
}
elsif ($verb eq 'ListSets') {
return $self->_render($self->_tt_process($self->_templ_list_sets, $vars));
}
};
}
sub not_found ($self) {
[404, ['Content-Type' => 'text/plain'], ['not found']];
}
1;
=head1 NAME
Plack::App::Catmandu::OAI - drop in replacement for Dancer::Plugin::Catmandu::OAI
=head1 SYNOPSIS
use Plack::Builder;
Plack::App::Catmandu::OAI;
builder {
enable 'ReverseProxy';
enable '+Dancer::Middleware::Rebase', base => Catmandu->config->{uri_base}, strip => 1;
mount "/oai" => Plack::App::Catmandu::OAI->new(
repositoryName => 'my repo',
store => 'search',
bag => 'publication',
lib/Plack/App/Catmandu/OAI.pm view on Meta::CPAN
* metadataNamespace: an XML namespace for this format
* template: path to a Template Toolkit file to transform your records into this format
* fix: optionally an array of one or more L<Catmandu::Fix>-es or Fix files
Required: true
=item sets
Type: array reference of hash references
Description: an array of OAI-PMH sets and the CQL query to retrieve records in this set from the Catmandu::Store. Each object must have the following attributes:
* setSpec: a short string for the same of the set
* setName: a longer description of the set
* setDescription: an optional and repeatable container that may hold community-specific XML-encoded data about the set. Should be string or array of strings.
* cql: the CQL command to find records in this set in the L<Catmandu::Store>
Required: false
=item granularity
Type: non empty string
Description: datestamp granularity. Default: YYYY-MM-DDThh:mm:ssZ. This is validated against the returned record timestamps
Required: false
=item collectionIcon
Type: hash reference
Description: object containing attributes for collectionIcon as used in the Identify response:
* url (required)
* link
* title
* width
* height
Required: false
=item get_record_cql_pattern
Type: non empty string
Description: CQL query template to use when fetching a single record. Defaults to C<_id exact "%s">.
Note that the record identifier key as defined by the catmandu bag is taken into account (which is _id by default)
Required: true
=item datestamp_pattern
Type: non empty string
Description: datestamp pattern for OAI parameters C<from> and C<until>. Example: C<%Y-%m-%dT%H:%M:%SZ>
Required: true
=item template_options
An optional hash of configuration options that will be passed to L<Catmandu::Exporter::Template> or L<Template>
=back
As this is meant as a drop in replacement for L<Dancer::Plugin::Catmandu::OAI> all arguments should be the same.
So all arguments can be taken from your previous dancer plugin configuration, if necessary:
use Dancer;
use Catmandu;
use Plack::Builder;
use Plack::App::Catmandu::OAI;
my $dancer_app = sub {
Dancer->dance(Dancer::Request->new(env => $_[0]));
};
builder {
enable 'ReverseProxy';
enable '+Dancer::Middleware::Rebase', base => Catmandu->config->{uri_base}, strip => 1;
mount "/oai" => Plack::App::Catmandu::OAI->new(
%{config->{plugins}->{'Catmandu::OAI'}}
)->to_app;
mount "/" => builder {
# only create session cookies for dancer application
enable "Session";
mount '/' => $dancer_app;
};
};
=head1 METHODS
=over 4
=item to_app
returns Plack application that can be mounted. Path rebasements are taken into account
=back
=head1 AUTHOR
=over 4
=item Nicolas Franck, C<< <nicolas.franck at ugent.be> >>
=back
=head1 IMPORTANT
This module is still a work in progress, and needs further testing before using it in a production system
=head1 LICENSE AND COPYRIGHT
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
( run in 2.161 seconds using v1.01-cache-2.11-cpan-800906f7e73 )