File Coverage

blib/lib/Dancer/Plugin/Catmandu/OAI.pm
Criterion Covered Total %
statement 145 304 47.7
branch 32 156 20.5
condition 20 91 21.9
subroutine 16 24 66.6
pod n/a
total 213 575 37.0


line stmt bran cond sub pod time code
1             package Dancer::Plugin::Catmandu::OAI;
2              
3             =head1 NAME
4              
5             Dancer::Plugin::Catmandu::OAI - OAI-PMH provider backed by a searchable Catmandu::Store
6              
7             =cut
8              
9             our $VERSION = '0.0507';
10              
11 2     2   384900 use Catmandu::Sane;
  2         384920  
  2         16  
12 2     2   622 use Catmandu::Util qw(is_string is_array_ref);
  2         6  
  2         105  
13 2     2   1229 use Catmandu;
  2         232905  
  2         11  
14 2     2   439 use Catmandu::Fix;
  2         6  
  2         60  
15 2     2   960 use Catmandu::Exporter::Template;
  2         105228  
  2         76  
16 2     2   1010 use Data::MessagePack;
  2         2324  
  2         72  
17 2     2   1037 use MIME::Base64 qw(encode_base64url decode_base64url);
  2         1342  
  2         137  
18 2     2   1090 use Dancer::Plugin;
  2         43646  
  2         174  
19 2     2   785 use Dancer qw(:syntax);
  2         153828  
  2         16  
20 2     2   2705 use DateTime;
  2         1032596  
  2         127  
21 2     2   1786 use DateTime::Format::ISO8601;
  2         282609  
  2         246  
22 2     2   52 use DateTime::Format::Strptime;
  2         5  
  2         25  
23 2     2   178 use Clone qw(clone);
  2         5  
  2         10225  
24              
25             my $DEFAULT_LIMIT = 100;
26              
27             my $VERBS = {
28             GetRecord => {
29             valid => {metadataPrefix => 1, identifier => 1},
30             required => [qw(metadataPrefix identifier)],
31             },
32             Identify => {valid => {}, required => [],},
33             ListIdentifiers => {
34             valid => {
35             metadataPrefix => 1,
36             from => 1,
37             until => 1,
38             set => 1,
39             resumptionToken => 1
40             },
41             required => [qw(metadataPrefix)],
42             },
43             ListMetadataFormats =>
44             {valid => {identifier => 1, resumptionToken => 1}, required => [],},
45             ListRecords => {
46             valid => {
47             metadataPrefix => 1,
48             from => 1,
49             until => 1,
50             set => 1,
51             resumptionToken => 1
52             },
53             required => [qw(metadataPrefix)],
54             },
55             ListSets => {valid => {resumptionToken => 1}, required => [],},
56             };
57              
58             {
59             state $mp = Data::MessagePack->new->utf8;
60              
61             sub _deserialize {
62 0     0   0 $mp->unpack(decode_base64url($_[0]));
63             }
64              
65             sub _serialize {
66 0     0   0 encode_base64url($mp->pack($_[0]));
67             }
68              
69             }
70              
71             sub _new_token {
72 0     0   0 my ($settings, $hits, $params, $from, $until, $old_token) = @_;
73              
74 0 0 0     0 my $n = $old_token && $old_token->{_n} ? $old_token->{_n} : 0;
75 0         0 $n += $hits->size;
76              
77 0 0       0 return unless $n < $hits->total;
78              
79 0         0 my $strategy = $settings->{search_strategy};
80              
81 0         0 my $token;
82              
83 0 0 0     0 if ($strategy eq 'paginate' && $hits->more) {
    0 0        
84 0         0 $token = {start => $hits->start + $hits->limit};
85             }
86             elsif ($strategy eq 'es.scroll' && exists $hits->{scroll_id}) {
87 0         0 $token = {scroll_id => $hits->{scroll_id}};
88             }
89             else {
90 0         0 return;
91             }
92              
93 0         0 $token->{_n} = $n;
94 0 0       0 $token->{_s} = $params->{set} if defined $params->{set};
95             $token->{_m} = $params->{metadataPrefix}
96 0 0       0 if defined $params->{metadataPrefix};
97 0 0       0 $token->{_f} = $from if defined $from;
98 0 0       0 $token->{_u} = $until if defined $until;
99 0         0 $token;
100             }
101              
102             sub _search {
103 0     0   0 my ($settings, $bag, $q, $token) = @_;
104              
105 0         0 my $strategy = $settings->{search_strategy};
106              
107             my %args = (
108 0         0 %{$settings->{default_search_params}},
109 0   0     0 limit => $settings->{limit} // $DEFAULT_LIMIT,
110             cql_query => $q,
111             );
112 0 0       0 if ($token) {
113 0 0 0     0 if ($strategy eq 'paginate' && exists $token->{start}) {
    0 0        
114 0         0 $args{start} = $token->{start};
115             }
116             elsif ($strategy eq 'es.scroll' && exists $token->{scroll_id}) {
117 0         0 $args{scroll_id} = $token->{scroll_id};
118             }
119             }
120              
121 0         0 $bag->search(%args);
122             }
123              
124             sub oai_provider {
125 1     1   47282 my ($path, %opts) = @_;
126              
127 1         10 my $setting = clone(plugin_setting);
128              
129             my $bag = Catmandu->store($opts{store} || $setting->{store})
130 1   33     142 ->bag($opts{bag} || $setting->{bag});
      33        
131              
132 1   50     171832 $setting->{granularity} //= "YYYY-MM-DDThh:mm:ssZ";
133              
134             # TODO this was for backwards compatibility. Remove?
135 1 50       6 if ($setting->{filter}) {
136 0         0 $setting->{cql_filter} = delete $setting->{filter};
137             }
138              
139 1   50     11 $setting->{default_search_params} //= {};
140              
141 1   50     8 $setting->{search_strategy} //= 'paginate';
142              
143             # TODO expire scroll_id if finished
144             # TODO set resumptionToken expirationDate
145 1 50       6 if ($setting->{search_strategy} eq 'es.scroll') {
146 0   0     0 $setting->{default_search_params}{scroll} //= '10m';
147             }
148              
149 1         2 my $datestamp_parser;
150 1 50       4 if ($setting->{datestamp_pattern}) {
151             $datestamp_parser = DateTime::Format::Strptime->new(
152             pattern => $setting->{datestamp_pattern},
153 0         0 on_error => 'undef',
154             );
155             }
156              
157             my $format_datestamp = $datestamp_parser
158             ? sub {
159 0     0   0 $datestamp_parser->parse_datetime($_[0])->iso8601 . 'Z';
160             }
161             : sub {
162 0     0   0 $_[0];
163 1 50       11 };
164              
165 1   33     29 $setting->{get_record_cql_pattern} ||= $bag->id_key . ' exact "%s"';
166              
167 1         90 my $metadata_formats = do {
168 1         4 my $list = $setting->{metadata_formats};
169 1         4 my $hash = {};
170 1         5 for my $format (@$list) {
171 2         9 my $prefix = $format->{metadataPrefix};
172 2         22 $format = {%$format};
173 2 50       29 if (my $fix = $format->{fix}) {
174 2         34 $format->{fix} = Catmandu::Fix->new(fixes => $fix);
175             }
176 2         1859 $hash->{$prefix} = $format;
177             }
178 1         4 $hash;
179             };
180              
181 1         2 my $sets = do {
182 1 50       7 if (my $list = $setting->{sets}) {
183 1         3 my $hash = {};
184 1         5 for my $set (@$list) {
185 3         8 my $key = $set->{setSpec};
186 3         11 $hash->{$key} = $set;
187             }
188 1         3 $hash;
189             }
190             else {
191 0         0 +{};
192             }
193             };
194              
195 1         4 my $ns = "oai:$setting->{repositoryIdentifier}:";
196              
197 1         3 my $branding = "";
198 1 50       5 if (my $icon = $setting->{collectionIcon}) {
199 0 0       0 if (my $url = $icon->{url}) {
200 0         0 $branding .= <<TT;
201             <description>
202             <branding xmlns="http://www.openarchives.org/OAI/2.0/branding/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://www.openarchives.org/OAI/2.0/branding/ http://www.openarchives.org/OAI/2.0/branding.xsd">
203             <collectionIcon>
204             <url>$url</url>
205             TT
206 0         0 for my $tag (qw(link title width height)) {
207 0   0     0 my $val = $icon->{$tag} // next;
208 0         0 $branding .= "<$tag>$val</$tag>\n";
209             }
210              
211 0         0 $branding .= <<TT;
212             </collectionIcon>
213             </branding>
214             </description>
215             TT
216             }
217             }
218              
219 1         3 my $xsl_stylesheet = "";
220 1 50       5 if (my $xsl_path = $setting->{xsl_stylesheet}) {
221 0         0 $xsl_stylesheet
222             = "<?xml-stylesheet type='text/xsl' href='$xsl_path' ?>";
223             }
224              
225 1         4 my $template_header = <<TT;
226             <?xml version="1.0" encoding="UTF-8"?>
227             $xsl_stylesheet
228             <OAI-PMH xmlns="http://www.openarchives.org/OAI/2.0/"
229             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
230             xsi:schemaLocation="http://www.openarchives.org/OAI/2.0/ http://www.openarchives.org/OAI/2.0/OAI-PMH.xsd">
231             <responseDate>[% response_date %]</responseDate>
232             [%- IF params.resumptionToken %]
233             <request verb="[% params.verb %]" resumptionToken="[% params.resumptionToken %]">[% uri_base %]</request>
234             [%- ELSE %]
235             <request[% FOREACH param IN params %] [% param.key %]="[% param.value | xml %]"[% END %]>[% uri_base %]</request>
236             [%- END %]
237             TT
238              
239 1         3 my $template_footer = <<TT;
240             </OAI-PMH>
241             TT
242              
243 1         5 my $template_error = <<TT;
244             $template_header
245             [%- FOREACH error IN errors %]
246             <error code="[% error.0 %]">[% error.1 | xml %]</error>
247             [%- END %]
248             $template_footer
249             TT
250              
251 1         5 my $template_record_header = <<TT;
252             <header[% IF deleted %] status="deleted"[% END %]>
253             <identifier>${ns}[% id %]</identifier>
254             <datestamp>[% datestamp %]</datestamp>
255             [%- FOREACH s IN setSpec %]
256             <setSpec>[% s %]</setSpec>
257             [%- END %]
258             </header>
259             TT
260              
261 1         5 my $template_get_record = <<TT;
262             $template_header
263             <GetRecord>
264             <record>
265             $template_record_header
266             [%- UNLESS deleted %]
267             <metadata>
268             [% metadata %]
269             </metadata>
270             [%- END %]
271             </record>
272             </GetRecord>
273             $template_footer
274             TT
275              
276 1   50     4 my $admin_email = $setting->{adminEmail} // [];
277 1 50       21 $admin_email = [$admin_email] unless is_array_ref($admin_email);
278             $admin_email
279 1         6 = join('', map {"<adminEmail>$_</adminEmail>"} @$admin_email);
  1         7  
280              
281 1         5 my @identify_extra_fields;
282 1         4 for my $i_field (qw(description compression)) {
283 2   50     15 my $i_value = $setting->{$i_field} // [];
284 2 50       10 $i_value = [$i_value] unless is_array_ref($i_value);
285             push @identify_extra_fields,
286 2         9 join('', map {"<$i_field>$_</$i_field>"} @$i_value);
  0         0  
287             }
288              
289 1         28 my $template_identify = <<TT;
290             $template_header
291             <Identify>
292             <repositoryName>$setting->{repositoryName}</repositoryName>
293             <baseURL>[% uri_base %]</baseURL>
294             <protocolVersion>2.0</protocolVersion>
295             $admin_email
296             <earliestDatestamp>[% earliest_datestamp %]</earliestDatestamp>
297             <deletedRecord>$setting->{deletedRecord}</deletedRecord>
298             <granularity>$setting->{granularity}</granularity>
299             <description>
300             <oai-identifier xmlns="http://www.openarchives.org/OAI/2.0/oai-identifier"
301             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
302             xsi:schemaLocation="http://www.openarchives.org/OAI/2.0/oai-identifier http://www.openarchives.org/OAI/2.0/oai-identifier.xsd">
303             <scheme>oai</scheme>
304             <repositoryIdentifier>$setting->{repositoryIdentifier}</repositoryIdentifier>
305             <delimiter>$setting->{delimiter}</delimiter>
306             <sampleIdentifier>$setting->{sampleIdentifier}</sampleIdentifier>
307             </oai-identifier>
308             </description>
309             @identify_extra_fields
310             $branding
311             </Identify>
312             $template_footer
313             TT
314              
315 1         30 my $template_list_identifiers = <<TT;
316             $template_header
317             <ListIdentifiers>
318             [%- FOREACH records %]
319             $template_record_header
320             [%- END %]
321             [%- IF resumption_token %]
322             <resumptionToken completeListSize="[% total %]">[% resumption_token %]</resumptionToken>
323             [%- ELSE %]
324             <resumptionToken completeListSize="[% total %]"/>
325             [%- END %]
326             </ListIdentifiers>
327             $template_footer
328             TT
329              
330 1         7 my $template_list_records = <<TT;
331             $template_header
332             <ListRecords>
333             [%- FOREACH records %]
334             <record>
335             $template_record_header
336             [%- UNLESS deleted %]
337             <metadata>
338             [% metadata %]
339             </metadata>
340             [%- END %]
341             </record>
342             [%- END %]
343             [%- IF resumption_token %]
344             <resumptionToken completeListSize="[% total %]">[% resumption_token %]</resumptionToken>
345             [%- ELSE %]
346             <resumptionToken completeListSize="[% total %]"/>
347             [%- END %]
348             </ListRecords>
349             $template_footer
350             TT
351              
352 1         4 my $template_list_metadata_formats = "";
353 1         11 $template_list_metadata_formats .= <<TT;
354             $template_header
355             <ListMetadataFormats>
356             TT
357 1         6 for my $format (values %$metadata_formats) {
358 2         10 $template_list_metadata_formats .= <<TT;
359             <metadataFormat>
360             <metadataPrefix>$format->{metadataPrefix}</metadataPrefix>
361             <schema>$format->{schema}</schema>
362             <metadataNamespace>$format->{metadataNamespace}</metadataNamespace>
363             </metadataFormat>
364             TT
365             }
366 1         5 $template_list_metadata_formats .= <<TT;
367             </ListMetadataFormats>
368             $template_footer
369             TT
370              
371 1         11 my $template_list_sets = <<TT;
372             $template_header
373             <ListSets>
374             TT
375 1         5 for my $set (values %$sets) {
376 3         11 $template_list_sets .= <<TT;
377             <set>
378             <setSpec>$set->{setSpec}</setSpec>
379             <setName>$set->{setName}</setName>
380             TT
381              
382 3   50     13 my $set_descriptions = $set->{setDescription} // [];
383 3 50       11 $set_descriptions = [$set_descriptions]
384             unless is_array_ref($set_descriptions);
385             $template_list_sets .= "<setDescription>$_</setDescription>"
386 3         7 for @$set_descriptions;
387              
388 3         7 $template_list_sets .= <<TT;
389             </set>
390             TT
391             }
392 1         5 $template_list_sets .= <<TT;
393             </ListSets>
394             $template_footer
395             TT
396              
397 1   33     7 my $fix = $opts{fix} || $setting->{fix};
398 1 50       5 if ($fix) {
399 0         0 $fix = Catmandu::Fix->new(fixes => $fix);
400             }
401 1   50 0   11 my $sub_deleted = $opts{deleted} || sub {0};
  0            
402 1   50 0   8 my $sub_set_specs_for = $opts{set_specs_for} || sub {[]};
  0            
403              
404 1   50     6 my $template_options = $setting->{template_options} || {};
405              
406             my $render = sub {
407 7     7   29 my ($tmpl, $data) = @_;
408 7         45 content_type 'xml';
409 7         1563 my $out = "";
410 7         254 my $exporter = Catmandu::Exporter::Template->new(
411             template => $tmpl,
412             file => \$out
413             );
414 7         5604 $exporter->add($data);
415 7         155836 $exporter->commit;
416 7         385 $out;
417 1         26 };
418              
419             any ['get', 'post'] => $path => sub {
420             my $uri_base = $setting->{uri_base}
421 7   33 7   29329 // request->uri_for(request->path_info);
422 7         88 my $response_date = DateTime->now->iso8601 . 'Z';
423 7 100       3723 my $params = request->is_get ? params('query') : params('body');
424 7         1311 my $errors = [];
425 7         22 my $format;
426             my $set;
427 7         27 my $verb = $params->{verb};
428 7         61 my $vars = {
429             uri_base => $uri_base,
430             request_uri => $uri_base . $path,
431             response_date => $response_date,
432             errors => $errors,
433             };
434              
435 7 100 66     63 if ($verb and my $spec = $VERBS->{$verb}) {
436 3         12 my $valid = $spec->{valid};
437 3         12 my $required = $spec->{required};
438              
439 3 50 66     24 if ($valid->{resumptionToken}
440             and exists $params->{resumptionToken})
441             {
442 0 0       0 if (keys(%$params) > 2) {
443 0         0 push @$errors,
444             [badArgument =>
445             "resumptionToken cannot be combined with other parameters"
446             ];
447             }
448             }
449             else {
450 3         13 for my $key (keys %$params) {
451 3 50       26 next if $key eq 'verb';
452 0 0       0 unless ($valid->{$key}) {
453 0         0 push @$errors,
454             [badArgument => "parameter $key is illegal"];
455             }
456             }
457 3         12 for my $key (@$required) {
458 0 0       0 unless (exists $params->{$key}) {
459 0         0 push @$errors,
460             [badArgument => "parameter $key is missing"];
461             }
462             }
463             }
464             }
465             else {
466 4         21 push @$errors, [badVerb => "illegal OAI verb"];
467             }
468              
469 7 100       30 if (@$errors) {
470 4         21 return $render->(\$template_error, $vars);
471             }
472              
473 3         13 $vars->{params} = $params;
474              
475 3 50       46 if (exists $params->{resumptionToken}) {
476 0 0       0 unless (is_string($params->{resumptionToken})) {
477 0         0 push @$errors,
478             [badResumptionToken =>
479             "resumptionToken is not in the correct format"
480             ];
481             }
482              
483 0 0       0 if ($verb eq 'ListSets') {
484 0         0 push @$errors,
485             [badResumptionToken => "resumptionToken isn't necessary"];
486             }
487             else {
488             try {
489 0         0 my $token = _deserialize($params->{resumptionToken});
490 0 0       0 $params->{set} = $token->{_s} if defined $token->{_s};
491 0 0       0 $params->{metadataPrefix} = $token->{_m} if defined $token->{_m};
492 0 0       0 $params->{from} = $token->{_f} if defined $token->{_f};
493 0 0       0 $params->{until} = $token->{_u} if defined $token->{_u};
494 0         0 $vars->{token} = $token;
495             }
496             catch {
497 0         0 push @$errors,
498             [badResumptionToken =>
499             "resumptionToken is not in the correct format"
500             ];
501 0         0 };
502              
503             }
504             }
505              
506 3 50       12 if (exists $params->{set}) {
507 0 0       0 unless ($sets) {
508 0         0 push @$errors, [noSetHierarchy => "sets are not supported"];
509             }
510 0 0       0 unless ($set = $sets->{$params->{set}}) {
511 0         0 push @$errors, [badArgument => "set does not exist"];
512             }
513             }
514              
515 3 50       13 if (exists $params->{metadataPrefix}) {
516 0 0       0 unless ($format = $metadata_formats->{$params->{metadataPrefix}}) {
517 0         0 push @$errors,
518             [cannotDisseminateFormat =>
519             "metadataPrefix $params->{metadataPrefix} is not supported"
520             ];
521             }
522             }
523              
524 3 50       13 if (@$errors) {
525 0         0 return $render->(\$template_error, $vars);
526             }
527              
528 3 50 33     40 if ($verb eq 'GetRecord') {
    100          
    50          
    100          
    50          
529 0         0 my $id = $params->{identifier};
530 0         0 $id =~ s/^$ns//;
531              
532             my $rec = $bag->search(
533 0         0 %{$setting->{default_search_params}},
534 0         0 cql_query => sprintf($setting->{get_record_cql_pattern}, $id),
535             start => 0,
536             limit => 1,
537             )->first;
538              
539 0 0       0 if (defined $rec) {
540 0 0       0 if ($fix) {
541 0         0 $rec = $fix->fix($rec);
542             }
543              
544 0         0 $vars->{id} = $id;
545             $vars->{datestamp} = $format_datestamp->(
546 0         0 $rec->{$setting->{datestamp_field}});
547 0         0 $vars->{deleted} = $sub_deleted->($rec);
548 0         0 $vars->{setSpec} = $sub_set_specs_for->($rec);
549 0         0 my $metadata = "";
550             my $exporter = Catmandu::Exporter::Template->new(
551             %$template_options,
552             template => $format->{template},
553 0         0 file => \$metadata,
554             );
555 0 0       0 if ($format->{fix}) {
556 0         0 $rec = $format->{fix}->fix($rec);
557             }
558 0         0 $exporter->add($rec);
559 0         0 $exporter->commit;
560 0         0 $vars->{metadata} = $metadata;
561 0 0 0     0 unless ($vars->{deleted}
562             and $setting->{deletedRecord} eq 'no')
563             {
564 0         0 return $render->(\$template_get_record, $vars);
565             }
566             }
567 0         0 push @$errors,
568             [idDoesNotExist =>
569             "identifier $params->{identifier} is unknown or illegal"
570             ];
571 0         0 return $render->(\$template_error, $vars);
572              
573             }
574             elsif ($verb eq 'Identify') {
575             $vars->{earliest_datestamp}
576 1   33     9 = $setting->{earliestDatestamp} || do {
577             my $hits = $bag->search(
578             %{$setting->{default_search_params}},
579             cql_query => $setting->{cql_filter} || 'cql.allRecords',
580             limit => 1,
581             sru_sortkeys => $setting->{datestamp_field},
582             );
583             if (my $rec = $hits->first) {
584             $format_datestamp->($rec->{$setting->{datestamp_field}});
585             }
586             else {
587             '1970-01-01T00:00:01Z';
588             }
589             };
590 1         7 return $render->(\$template_identify, $vars);
591              
592             }
593             elsif ($verb eq 'ListIdentifiers' || $verb eq 'ListRecords') {
594 0         0 my $from = $params->{from};
595 0         0 my $until = $params->{until};
596              
597 0         0 for my $datestamp (($from, $until)) {
598 0 0       0 $datestamp || next;
599 0 0       0 if ($datestamp
600             !~ /^\d{4}-\d{2}-\d{2}(?:T\d{2}:\d{2}:\d{2}Z)?$/)
601             {
602 0         0 push @$errors,
603             [badArgument =>
604             "datestamps must have the format YYYY-MM-DD or YYYY-MM-DDThh:mm:ssZ"
605             ];
606 0         0 return $render->(\$template_error, $vars);
607             }
608             }
609              
610 0 0 0     0 if ($from && $until && length($from) != length($until)) {
      0        
611 0         0 push @$errors,
612             [
613             badArgument => "datestamps must have the same granularity"
614             ];
615 0         0 return $render->(\$template_error, $vars);
616             }
617              
618 0 0 0     0 if ($from && $until && $from gt $until) {
      0        
619 0         0 push @$errors,
620             [badArgument => "from is more recent than until"];
621 0         0 return $render->(\$template_error, $vars);
622             }
623              
624 0 0 0     0 if ($from && length($from) == 10) {
625 0         0 $from = "${from}T00:00:00Z";
626             }
627 0 0 0     0 if ($until && length($until) == 10) {
628 0         0 $until = "${until}T23:59:59Z";
629             }
630              
631 0         0 my @cql;
632 0         0 my $cql_from = $from;
633 0         0 my $cql_until = $until;
634 0 0       0 if (my $pattern = $setting->{datestamp_pattern}) {
635 0 0       0 $cql_from
636             = DateTime::Format::ISO8601->parse_datetime($from)
637             ->strftime($pattern)
638             if $cql_from;
639 0 0       0 $cql_until
640             = DateTime::Format::ISO8601->parse_datetime($until)
641             ->strftime($pattern)
642             if $cql_until;
643             }
644              
645 0 0       0 push @cql, qq|($setting->{cql_filter})| if $setting->{cql_filter};
646 0 0       0 push @cql, qq|($format->{cql})| if $format->{cql};
647 0 0 0     0 push @cql, qq|($set->{cql})| if $set && $set->{cql};
648 0 0       0 push @cql, qq|($setting->{datestamp_field} >= "$cql_from")|
649             if $cql_from;
650 0 0       0 push @cql, qq|($setting->{datestamp_field} <= "$cql_until")|
651             if $cql_until;
652 0 0       0 unless (@cql) {
653 0         0 push @cql, "(cql.allRecords)";
654             }
655              
656             my $search = _search($setting, $bag, join(' and ', @cql),
657 0         0 $vars->{token});
658              
659 0 0       0 unless ($search->total) {
660 0         0 push @$errors, [noRecordsMatch => "no records found"];
661 0         0 return $render->(\$template_error, $vars);
662             }
663              
664 0 0       0 if (
665             defined(
666             my $new_token = _new_token(
667             $setting, $search, $params,
668             $from, $until, $vars->{token}
669             )
670             )
671             )
672             {
673 0         0 $vars->{resumption_token} = _serialize($new_token);
674             }
675              
676 0         0 $vars->{total} = $search->total;
677              
678 0 0       0 if ($verb eq 'ListIdentifiers') {
679             $vars->{records} = [
680             map {
681 0         0 my $rec = $_;
682 0         0 my $id = $rec->{$bag->id_key};
683              
684 0 0       0 if ($fix) {
685 0         0 $rec = $fix->fix($rec);
686             }
687              
688             {
689             id => $id,
690             datestamp => $format_datestamp->(
691             $rec->{$setting->{datestamp_field}}
692 0         0 ),
693             deleted => $sub_deleted->($rec),
694             setSpec => $sub_set_specs_for->($rec),
695             };
696 0         0 } @{$search->hits}
  0         0  
697             ];
698 0         0 return $render->(\$template_list_identifiers, $vars);
699             }
700             else {
701             $vars->{records} = [
702             map {
703 0         0 my $rec = $_;
704 0         0 my $id = $rec->{$bag->id_key};
705              
706 0 0       0 if ($fix) {
707 0         0 $rec = $fix->fix($rec);
708             }
709              
710 0         0 my $deleted = $sub_deleted->($rec);
711              
712             my $rec_vars = {
713             id => $id,
714             datestamp => $format_datestamp->(
715             $rec->{$setting->{datestamp_field}}
716 0         0 ),
717             deleted => $deleted,
718             setSpec => $sub_set_specs_for->($rec),
719             };
720 0 0       0 unless ($deleted) {
721 0         0 my $metadata = "";
722             my $exporter = Catmandu::Exporter::Template->new(
723             %$template_options,
724             template => $format->{template},
725 0         0 file => \$metadata,
726             );
727 0 0       0 if ($format->{fix}) {
728 0         0 $rec = $format->{fix}->fix($rec);
729             }
730 0         0 $exporter->add($rec);
731 0         0 $exporter->commit;
732 0         0 $rec_vars->{metadata} = $metadata;
733             }
734 0         0 $rec_vars;
735 0         0 } @{$search->hits}
  0         0  
736             ];
737 0         0 return $render->(\$template_list_records, $vars);
738             }
739              
740             }
741             elsif ($verb eq 'ListMetadataFormats') {
742 1 50       6 if (my $id = $params->{identifier}) {
743 0         0 $id =~ s/^$ns//;
744 0 0       0 unless ($bag->get($id)) {
745 0         0 push @$errors,
746             [idDoesNotExist =>
747             "identifier $params->{identifier} is unknown or illegal"
748             ];
749 0         0 return $render->(\$template_error, $vars);
750             }
751             }
752 1         9 return $render->(\$template_list_metadata_formats, $vars);
753              
754             }
755             elsif ($verb eq 'ListSets') {
756 1         8 return $render->(\$template_list_sets, $vars);
757             }
758             }
759 1         33 }
760              
761             register oai_provider => \&oai_provider;
762              
763             register_plugin;
764              
765             1;
766              
767             =head1 SYNOPSIS
768              
769             #!/usr/bin/env perl
770              
771             use Dancer;
772             use Catmandu;
773             use Dancer::Plugin::Catmandu::OAI;
774              
775             Catmandu->load;
776             Catmandu->config;
777              
778             my $options = {};
779              
780             oai_provider '/oai' , %$options;
781              
782             dance;
783              
784             =head1 DESCRIPTION
785              
786             L<Dancer::Plugin::Catmandu::OAI> is a Dancer plugin to provide OAI-PMH services for L<Catmandu::Store>-s that support
787             CQL (such as L<Catmandu::Store::ElasticSearch>). Follow the installation steps below to setup your own OAI-PMH server.
788              
789             =head1 REQUIREMENTS
790              
791             In the examples below an ElasticSearch 1.7.2 L<https://www.elastic.co/downloads/past-releases/elasticsearch-1-7-2> server
792             will be used.
793              
794             Follow the instructions below for a demonstration installation:
795              
796             $ cpanm Dancer Catmandu::OAI Catmandu::Store::ElasticSearch
797              
798             $ wget https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch-1.7.2.zip
799             $ unzip elasticsearch-1.7.2.zip
800             $ cd elasticsearch-1.7.2
801             $ bin/elasticsearch
802              
803             =head1 RECORDS
804              
805             Records stored in the Catmandu::Store can be in any format. Preferably the format should be easy to convert into the
806             mandatory OAI-DC format. At a minimum each record contains an identifier '_id' and a field containing a datestamp.
807              
808             $ cat sample.yml
809             ---
810             _id: oai:my.server.org:123456
811             datestamp: 2016-05-17T13:37:18Z
812             creator:
813             - Musterman, Max
814             - Jansen, Jan
815             - Svenson, Sven
816             title:
817             - Test record
818             ...
819              
820             =head1 CATMANDU CONFIGURATION
821              
822             ElasticSearch requires a configuration file to map record fields to CQL terms. Below is a minimal configuration required to query
823             for identifiers and datastamps in the ElasticSearch collection:
824              
825             $ cat catmandu.yml
826             ---
827             store:
828             oai:
829             package: ElasticSearch
830             options:
831             index_name: oai
832             bags:
833             data:
834             cql_mapping:
835             default_index: basic
836             indexes:
837             _id:
838             op:
839             'any': true
840             'all': true
841             '=': true
842             'exact': true
843             field: '_id'
844             datestamp:
845             op:
846             '=': true
847             '<': true
848             '<=': true
849             '>=': true
850             '>': true
851             'exact': true
852             field: 'datestamp'
853             index_mappings:
854             publication:
855             properties:
856             datestamp: {type: date, format: date_time_no_millis}
857              
858             =head1 IMPORT RECORDS
859              
860             With the Catmandu configuration files in place records can be imported with the L<catmandu> command:
861              
862             # Drop the existing ElasticSearch 'oai' collection
863             $ catmandu drop oai
864              
865             # Import the sample record
866             $ catmandu import YAML to oai < sample.yml
867              
868             # Test if the records are available in the 'oai' collection
869             $ catmandu export oai
870              
871             =head1 DANCER CONFIGURATION
872              
873             The Dancer configuration file 'config.yml' contains basic information for the OAI-PMH plugin to work:
874              
875             * store - In which Catmandu::Store are the metadata records stored
876             * bag - In which Catmandu::Bag are the records of this 'store' (use: 'data' as default)
877             * datestamp_field - Which field in the record contains a datestamp ('datestamp' in our example above)
878             * repositoryName - The name of the repository
879             * uri_base - The full base url of the OAI controller. To be used when behind a proxy server. When not set, this module relies on the Dancer request to provide its full url. Use middleware like 'ReverseProxy' or 'Dancer::Middleware::Rebase' in that case.
880             * adminEmail - An administrative email. Can be string or array of strings. This will be included in the Identify response.
881             * compression - a compression encoding supported by the repository. Can be string or array of strings. This will be included in the Identify response.
882             * description - XML container that describes your repository. Can be string or array of strings. This will be included in the Identify response. Note that this module will try to validate the XML data.
883             * earliestDatestamp - The earliest datestamp available in the dataset as YYYY-MM-DDTHH:MM:SSZ. This will be determined dynamically if no static value is given.
884             * deletedRecord - The policy for deleted records. See also: L<https://www.openarchives.org/OAI/openarchivesprotocol.html#DeletedRecords>
885             * repositoryIdentifier - A prefix to use in OAI-PMH identifiers
886             * cql_filter - A CQL query to find all records in the database that should be made available to OAI-PMH
887             * default_search_params - set default arguments that get passed to every call to the bag's search method
888             * search_strategy - default is C<paginate>, set to C<es.scroll> to avoid deep paging (Elasticsearch only)
889             * limit - The maximum number of records to be returned in each OAI-PMH request
890             * delimiter - Delimiters used in prefixing a record identifier with a repositoryIdentifier (use: ':' as default)
891             * sampleIdentifier - A sample identifier
892             * metadata_formats - An array of metadataFormats that are supported
893             * metadataPrefix - A short string for the name of the format
894             * schema - An URL to the XSD schema of this format
895             * metadataNamespace - A XML namespace for this format
896             * template - The path to a Template Toolkit file to transform your records into this format
897             * fix - Optionally an array of one or more L<Catmandu::Fix>-es or Fix files
898             * sets - Optional an array of OAI-PMH sets and the CQL query to retrieve records in this set from the Catmandu::Store
899             * setSpec - A short string for the same of the set
900             * setName - A longer description of the set
901             * setDescription - an optional and repeatable container that may hold community-specific XML-encoded data about the set. Should be string or array of strings.
902             * cql - The CQL command to find records in this set in the L<Catmandu::Store>
903             * xsl_stylesheet - Optional path to an xsl stylesheet
904             * template_options - An optional hash of configuration options that will be passed to L<Catmandu::Exporter::Template> or L<Template>.
905              
906             Below is a sample minimal configuration for the 'sample.yml' demo above:
907              
908             $ cat config.yml
909             charset: "UTF-8"
910             plugins:
911             'Catmandu::OAI':
912             store: oai
913             bag: data
914             datestamp_field: datestamp
915             repositoryName: "My OAI DataProvider"
916             uri_base: "http://oai.service.com/oai"
917             adminEmail: me@example.com
918             earliestDatestamp: "1970-01-01T00:00:01Z"
919             cql_filter: "datestamp>1970-01-01T00:00:01Z"
920             deletedRecord: persistent
921             repositoryIdentifier: oai.service.com
922             limit: 200
923             delimiter: ":"
924             sampleIdentifier: "oai:oai.service.com:1585315"
925             metadata_formats:
926             -
927             metadataPrefix: oai_dc
928             schema: "http://www.openarchives.org/OAI/2.0/oai_dc.xsd"
929             metadataNamespace: "http://www.openarchives.org/OAI/2.0/oai_dc/"
930             template: oai_dc.tt
931              
932             =head1 METADATAPREFIX TEMPLATE
933              
934             For each metadataPrefix a Template Toolkit file needs to exist which translate L<Catmandu::Store> records into XML records. At least
935             one Template Toolkit file should be made available to transform stored records into Dublin Core. The example below contains an example file to
936             transform 'sample.yml' type records into Dublin Core:
937              
938             $ cat oai_dc.tt
939             <oai_dc:dc xmlns="http://www.openarchives.org/OAI/2.0/oai_dc/"
940             xmlns:oai_dc="http://www.openarchives.org/OAI/2.0/oai_dc/"
941             xmlns:dc="http://purl.org/dc/elements/1.1/"
942             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
943             xsi:schemaLocation="http://www.openarchives.org/OAI/2.0/oai_dc/ http://www.openarchives.org/OAI/2.0/oai_dc.xsd">
944             [%- FOREACH var IN ['title' 'creator' 'subject' 'description' 'publisher' 'contributor' 'date' 'type' 'format' 'identifier' 'source' 'language' 'relation' 'coverage' 'rights'] %]
945             [%- FOREACH val IN $var %]
946             <dc:[% var %]>[% val | html %]</dc:[% var %]>
947             [%- END %]
948             [%- END %]
949             </oai_dc:dc>
950              
951             =head1 START DANCER
952              
953             If all the required files are available, then a Dancer application can be started. See the 'demo' directory of this distribution for a complete example:
954              
955             $ ls
956             app.pl catmandu.yml config.yml oai_dc.tt
957             $ cat app.pl
958             #!/usr/bin/env perl
959              
960             use Dancer;
961             use Catmandu;
962             use Dancer::Plugin::Catmandu::OAI;
963              
964             Catmandu->load;
965             Catmandu->config;
966              
967             my $options = {};
968              
969             oai_provider '/oai' , %$options;
970              
971             dance;
972              
973             # Start Dancer
974             $ perl ./app.pl
975              
976             # Test queries:
977              
978             $ curl "http://localhost:3000/oai?verb=Identify"
979             $ curl "http://localhost:3000/oai?verb=ListSets"
980             $ curl "http://localhost:3000/oai?verb=ListMetadataFormats"
981             $ curl "http://localhost:3000/oai?verb=ListIdentifiers&metadataPrefix=oai_dc"
982             $ curl "http://localhost:3000/oai?verb=ListRecords&metadataPrefix=oai_dc"
983              
984             =head1 SEE ALSO
985              
986             L<Dancer>, L<Catmandu>, L<Catmandu::Store>
987              
988             =head1 AUTHOR
989              
990             Nicolas Steenlant, C<< <nicolas.steenlant at ugent.be> >>
991              
992             =head1 CONTRIBUTORS
993              
994             Nicolas Franck, C<< <nicolas.franck at ugent.be> >>
995              
996             Vitali Peil, C<< <vitali.peil at uni-bielefeld.de> >>
997              
998             Patrick Hochstenbach, C<< <patric.hochstenbach at ugent.be> >>
999              
1000             =head1 LICENSE
1001              
1002             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
1003              
1004             =cut