Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

improve Dancer SRU plugin: explain, take indexInfo, numberOfRecords, …

…maximumRecords from bag
  • Loading branch information...
commit 00c9d6708acba311b4ca8f5d7a6e03e2157e665d 1 parent 3d19ee1
Nicolas Steenlant nics authored
12 lib/Catmandu/Searchable.pm
View
@@ -10,11 +10,11 @@ requires 'search';
requires 'searcher';
requires 'delete_by_query';
-has default_limit => (is => 'ro', builder => '_build_default_limit');
-has max_limit => (is => 'ro', builder => '_build_max_limit');
+has default_limit => (is => 'ro', builder => 'default_default_limit');
+has maximum_limit => (is => 'ro', builder => 'default_maximum_limit');
-sub _build_default_limit { 10 }
-sub _build_max_limit { 1000 }
+sub default_default_limit { 10 }
+sub default_maximum_limit { 1000 }
sub normalize_query { $_[1] }
@@ -24,8 +24,8 @@ my $AROUND_SEARCH = sub {
$args{start} = 0 unless is_natural($args{start});
$args{start}+=0;
$args{limit}+=0;
- if ($args{limit} > $self->max_limit) {
- $args{limit} = $self->max_limit;
+ if ($args{limit} > $self->maximum_limit) {
+ $args{limit} = $self->maximum_limit;
}
if (is_positive(my $page = delete $args{page})) {
$args{start} = ($page - 1) * $args{limit};
2  lib/Catmandu/Store/ElasticSearch.pm
View
@@ -58,7 +58,7 @@ with 'Catmandu::Bag';
with 'Catmandu::Searchable';
with 'Catmandu::Buffer';
-has cql_mapping => (is => 'ro');
+has cql_mapping => (is => 'ro'); # TODO move to Searchable
sub generator {
my ($self) = @_;
98 lib/Dancer/Plugin/Catmandu/SRU.pm
View
@@ -11,31 +11,63 @@ use Catmandu::Exporter::Template;
use SRU::Request;
use SRU::Response;
-my $setting = plugin_setting;
+sub sru_provider {
+ my ($path) = @_;
+
+ my $setting = plugin_setting;
-my $default_record_schema = $setting->{default_record_schema};
+ my $default_record_schema = $setting->{default_record_schema};
-my $record_schemas = do {
- my $list = $setting->{record_schemas};
- my $hash = {};
- for my $schema (@$list) {
+ my $record_schemas = $setting->{record_schemas};
+
+ my $record_schema_map = {};
+ for my $schema (@$record_schemas) {
$schema = {%$schema};
my $identifier = $schema->{identifier};
- my $short_name = $schema->{short_name};
+ my $name = $schema->{name};
if (my $fix = $schema->{fix}) {
$schema->{fix} = Catmandu::Fix->new(fixes => $fix);
}
- $hash->{$identifier} = $schema;
- $hash->{$short_name} = $schema;
+ $record_schema_map->{$identifier} = $schema;
+ $record_schema_map->{$name} = $schema;
}
- $hash;
-};
-
-sub sru_provider {
- my ($path) = @_;
my $bag = Catmandu::store($setting->{store})->bag($setting->{bag});
+ my $default_limit = $bag->default_limit;
+ my $maximum_limit = $bag->maximum_limit;
+
+ my $database_info = "";
+ if ($setting->{title} || $setting->{description}) {
+ $database_info .= qq(<databaseInfo>\n);
+ for my $key (qw(title description)) {
+ $database_info .= qq(<$key lang="en" primary="true">$setting->{$key}</$key>\n) if $setting->{$key};
+ }
+ $database_info .= qq(</databaseInfo>);
+ }
+
+ my $index_info = "";
+ if ($bag->can('cql_mapping') and my $indexes = $bag->cql_mapping->{indexes}) { # TODO all Searchable should have cql_mapping
+ $index_info .= qq(<indexInfo>\n);
+ for my $key (keys %$indexes) {
+ my $title = $indexes->{$key}{title} || $key;
+ $index_info .= qq(<index><title>$title</title><map><name>$key</name></map></index>\n);
+ }
+ $index_info .= qq(</indexInfo>);
+ }
+
+ my $schema_info = qq(<schemaInfo>\n);
+ for my $schema (@$record_schemas) {
+ my $title = $schema->{title} || $schema->{name};
+ $schema_info .= qq(<schema name="$schema->{name}" identifier="$schema->{identifier}"><title>$title</title></schema>\n);
+ }
+ $schema_info .= qq(</schemaInfo>);
+
+ my $config_info = qq(<configInfo>\n);
+ $config_info .= qq(<default type="numberOfRecords">$default_limit</default>\n);
+ $config_info .= qq(<setting type="maximumRecords">$maximum_limit</setting>\n);
+ $config_info .= qq(</configInfo>);
+
get $path => sub {
content_type 'xml';
@@ -43,28 +75,48 @@ sub sru_provider {
my $response = SRU::Response->newFromRequest($request);
given (param('operation')) {
+ when ('explain') {
+ my $transport = request->scheme;
+ my $database = substr request->path, 1;
+ my $host = request->host; $host =~ s/:.+//;
+ my $port = request->port;
+ $response->record(SRU::Response::Record->new(
+ recordSchema => 'http://explain.z3950.org/dtd/2.1/',
+ recordData => <<XML,
+<explain xmlns="http://explain.z3950.org/dtd/2.1/">
+<serverInfo protocol="SRU" method="GET" transport="$transport">
+<host>$host</host>
+<port>$port</port>
+<database>$database</database>
+</serverInfo>
+$database_info
+$index_info
+$schema_info
+$config_info
+</explain>
+XML
+ ));
+ return $response->asXML;
+ }
when ('searchRetrieve') {
- my $schema = $record_schemas->{$request->recordSchema || $default_record_schema};
+ my $schema = $record_schema_map->{$request->recordSchema || $default_record_schema};
my $identifier = $schema->{identifier};
my $fix = $schema->{fix};
my $template = $schema->{template};
my $layout = $schema->{layout};
my $cql = $request->query;
- if ($setting->{filter}) {
- $cql = "($setting->{filter}) and ($cql)";
+ if ($setting->{cql_filter}) {
+ $cql = "($setting->{cql_filter}) and ($cql)";
}
- my $start = $request->startRecord || 1;
- my $limit = $request->maximumRecords || 20;
- if ($limit > 1000) {
- $limit = 1000;
- }
+ my $first = $request->startRecord || 1;
+ my $limit = $request->maximumRecords || $default_limit;
my $hits = eval {
$bag->search(
cql_query => $cql,
sru_sortkeys => $request->sortKeys,
limit => $limit,
- start => $start - 1,
+ start => $first - 1,
);
} or do {
my $e = $@;
Please sign in to comment.
Something went wrong with that request. Please try again.