File Coverage

blib/lib/Catmandu/Store/AlephX.pm
Criterion Covered Total %
statement 36 66 54.5
branch 0 8 0.0
condition 0 6 0.0
subroutine 12 19 63.1
pod 0 5 0.0
total 48 104 46.1


line stmt bran cond sub pod time code
1             package Catmandu::Store::AlephX;
2             =head1 NAME
3              
4             Catmandu::Store::AlephX - A Catmandu AlephX service implemented as Catmandu::Store
5              
6             =head1 SYNOPSIS
7              
8             use Catmandu::Store::AlephX;
9              
10             my $store = Catmandu::Store::AlephX->new(url => 'http://aleph.ugent.be/X' , username => 'XXX' , password => 'XXX');
11              
12             $store->bag('usm01')->each(sub {
13             });
14              
15             =cut
16 1     1   88449 use namespace::clean;
  1         14312  
  1         5  
17 1     1   591 use Catmandu::Sane;
  1         148471  
  1         6  
18 1     1   281 use Catmandu::Util qw(:is :check);
  1         2  
  1         391  
19 1     1   529 use Catmandu::AlephX;
  1         4  
  1         26  
20 1     1   6 use Moo;
  1         2  
  1         4  
21              
22             our $VERSION = "1.071";
23              
24             with 'Catmandu::Store';
25              
26             has url => (is => 'ro', required => 1);
27             has username => ( is => 'ro' );
28             has password => ( is => 'ro' );
29             has skip_deleted => ( is => 'ro' , default => sub { 0 } );
30              
31             has alephx => (
32             is => 'ro',
33             init_arg => undef,
34             lazy => 1,
35             builder => '_build_alephx',
36             );
37             around default_bag => sub {
38             'usm01';
39             };
40              
41             sub _build_alephx {
42 0     0     my $self = $_[0];
43 0           my %args = (url => $self->url());
44 0 0 0       if(is_string($self->username) && is_string($self->password)){
45             $args{default_args} = {
46 0           user_name => $self->username,
47             user_password => $self->password
48             };
49             }
50 0           Catmandu::AlephX->new(%args);
51             }
52              
53              
54             package Catmandu::Store::AlephX::Bag;
55 1     1   647 use Catmandu::Sane;
  1         2  
  1         5  
56 1     1   135 use Moo;
  1         3  
  1         4  
57 1     1   290 use Catmandu::AlephX;
  1         2  
  1         32  
58 1     1   4 use Catmandu::Util qw(:check :is);
  1         2  
  1         378  
59 1     1   689 use Catmandu::Hits;
  1         23097  
  1         38  
60 1     1   9 use Clone qw(clone);
  1         2  
  1         56  
61 1     1   5 use Carp qw(confess);
  1         2  
  1         1533  
62              
63             with 'Catmandu::Bag';
64             with 'Catmandu::Searchable';
65              
66             #override automatic id generation from Catmandu::Bag
67             before add => sub {
68             check_catmandu_marc($_[1]);
69             $_[1] = clone($_[1]);
70             if(is_string($_[1]->{_id})){
71             $_[1]->{_id} =~ /^\d{9}$/o or confess("invalid _id ".$_[1]->{_id});
72             }else{
73             $_[1]->{_id} = Catmandu::AlephX->format_doc_num(0);
74             }
75             };
76              
77             sub check_catmandu_marc {
78 0     0 0   my $r = $_[0];
79 0           check_hash_ref($r);
80 0           check_array_ref($r->{record});
81 0           check_array_ref($_) for @{ $r->{record} };
  0            
82             }
83              
84             sub check_deleted {
85 0     0 0   my $r = $_[0];
86 0 0         return 1 unless defined $r;
87 0           for (@{$r->{record}}) {
  0            
88 0 0         return 1 if ($_->[0] eq 'DEL');
89             }
90 0           return 0;
91             }
92              
93             =head1 METHODS
94              
95             =head2 get($id)
96              
97             Retrieves a record from the Aleph database. Requires a record identifier. Returns a Catmandu MARC record
98             when found and undef on failure.
99              
100             =cut
101             sub get {
102             my($self,$id)=@_;
103             my $alephx = $self->store->alephx;
104              
105             my $find_doc = $alephx->find_doc(
106             format => 'marc',
107             doc_num => $id,
108             base => $self->name,
109             #override user_name to disable user check
110             user_name => ""
111             );
112              
113             return undef unless($find_doc->is_success);
114              
115             my $doc = $find_doc->record->metadata->data;
116              
117             return undef if $self->store->skip_deleted && check_deleted($doc);
118              
119             return $doc;
120             }
121              
122              
123             =head2 add($catmandu_marc)
124              
125             Adds or updates a record to the Aleph database. Requires a Catmandu type MARC record and a _id field
126             containing the Aleph record number. This method with throw an error when an add cant be executed.
127              
128             =head3 example
129              
130             #add new record. WARNING: Aleph will ignore the 001 field,
131             my $new_record = eval {
132             $bag->add({
133             record => [
134             [
135             'FMT',
136             '',
137             '',
138             '_',
139             'SE'
140             ],
141             [
142             'LDR',
143             '',
144             '',
145             '_',
146             '00000cas^^2200385^a^4500'
147             ],
148             [
149             '001',
150             '',
151             '',
152             '_',
153             '000000444'
154             ],
155             [
156             '005',
157             '',
158             '',
159             '_',
160             '20140212095615.0'
161             ]
162             ..
163             ]
164             });
165              
166             };
167             if ($@) {
168             die "add failed $@";
169             }
170              
171             say "new record:".$record->{_id};
172              
173             =cut
174             sub add {
175             my($self,$data)=@_;
176              
177             my $alephx = $self->store->alephx;
178              
179             #insert/update
180             my $update_doc = $alephx->update_doc(
181             library => $self->name,
182             doc_action => 'UPDATE',
183             doc_number => $data->{_id},
184             marc => $data
185             );
186              
187             #_id not given: new record explicitely requested
188             if(int($data->{_id}) == 0){
189             if($update_doc->errors()->[-1] =~ /Document: (\d{9}) was updated successfully/i){
190             $data->{_id} = $1;
191             }else{
192             confess($update_doc->errors()->[-1]);
193             }
194             }
195             #_id given: update when exists, insert when not
196             else{
197              
198             #error given, can have several reasons: real error or just warnings + success message
199             unless($update_doc->is_success){
200              
201             #document does not exist (yet)
202             if($update_doc->errors()->[-1] =~ /Doc number given does not exist/i){
203              
204             #'If you want to insert a new document, then the doc_number you supply should be all zeroes'
205             my $new_doc_num = Catmandu::AlephX->format_doc_num(0);
206              
207             #last error should be 'Document: 000050105 was updated successfully.'
208             $update_doc = $alephx->update_doc(
209             library => $self->name,
210             doc_action => 'UPDATE',
211             doc_number => $new_doc_num,
212             marc => $data
213             );
214              
215             if($update_doc->errors()->[-1] =~ /Document: (\d{9}) was updated successfully/i){
216              
217             $data->{_id} = $1;
218              
219             }else{
220              
221             confess $update_doc->errors()->[-1];
222              
223             }
224              
225             }
226             #update ok
227             elsif($update_doc->errors()->[-1] =~ /updated successfully/i){
228              
229             #all ok
230              
231             }
232             #other severe errors (permissions, format..)
233             else{
234              
235             confess $update_doc->errors()->[-1];
236              
237             }
238              
239             }
240             #no errors given: strange
241             else{
242             #when does this happen?
243             confess "how did you end up here?";
244             }
245              
246             }
247             #record is ALWAYS changed by Aleph, so fetch it again
248             $self->get($data->{_id});
249              
250             }
251              
252             =head2 delete($id)
253              
254             Deletes a record from the Aleph database. Requires a record identifier. Returns a true value when the
255             record is deleted.
256              
257             =cut
258             sub delete {
259             my($self,$id)= @_;
260              
261             $id = Catmandu::AlephX->format_doc_num($id);
262              
263             my $xml_full_req = <<EOF;
264             <?xml version="1.0" encoding="UTF-8" ?>
265             <find-doc><record><metadata><oai_marc><fixfield id="001">$id</fixfield></oai_marc></metadata></record></find-doc>
266             EOF
267              
268             #insert/update
269             my $update_doc = $self->store->alephx->update_doc(
270             library => $self->name,
271             doc_action => 'DELETE',
272             doc_number => $id,
273             xml_full_req => $xml_full_req
274             );
275              
276             #last error: 'Document: 000050124 was updated successfully.'
277             (scalar(@{ $update_doc->errors() })) && ($update_doc->errors()->[-1] =~ /Document: $id was updated successfully./);
278             }
279              
280             =head2 each(callback)
281              
282             Loops over all records in the Aleph database executing callback for every record.
283              
284             =cut
285             sub generator {
286 0     0 0   my $self = $_[0];
287              
288             #TODO: in some cases, deleted records are really removed from the database
289             # in these cases, it does not make sense to interpret a failing 'find-doc' as the end of the database.
290             # to compete with these 'holes', the size of the hole need to be defined (how big before thinking this is the end)
291              
292             sub {
293 0     0     state $count = 1;
294 0           state $base = $self->name;
295 0           state $alephx = $self->store->alephx;
296              
297 0           my $doc;
298 0   0       do {
299 0           my $doc_num = Catmandu::AlephX->format_doc_num($count++);
300 0           my $find_doc = $alephx->find_doc(base => $base,doc_num => $doc_num,user_name => "");
301              
302 0 0         return unless $find_doc->is_success;
303              
304             $doc = {
305             record => $find_doc->record->metadata->data->{record},
306 0           _id => $doc_num
307             };
308             } while ($self->store->skip_deleted && check_deleted($doc) == 1);
309              
310 0           return $doc;
311 0           };
312             }
313              
314             =head2 search(query => $query, start => 0 , limit => 20);
315              
316             =cut
317             #warning: no_entries is the maximum number of entries to be retrieved (always lower or equal to no_records)
318             # specifying a set_entry higher than this, has no use, and leads to the error 'There is no entry number: <set_entry> in set number given'
319             sub search {
320             my($self,%args)=@_;
321              
322             my $query = delete $args{query};
323             my $start = delete $args{start};
324             $start = is_natural($start) ? $start : 0;
325             my $limit = delete $args{limit};
326             $limit = is_natural($limit) ? $limit : 20;
327              
328             my $alephx = $self->store->alephx;
329             my $find = $alephx->find(
330             request => $query,
331             base => $self->name,
332             user_name => ""
333             );
334              
335             my @results = ();
336              
337             if ($find->is_success) {
338             my $no_records = int($find->no_records);
339             my $no_entries = int($find->no_entries);
340              
341             my $s = Catmandu::AlephX->format_doc_num($start + 1);
342             my $l = $start + $limit;
343             my $e = Catmandu::AlephX->format_doc_num($l > $no_entries ? $no_entries : $l);
344             my $set_entry = "$s-$e";
345              
346             my $present = $alephx->present(set_number => $find->set_number,set_entry => $set_entry,format => 'marc',user_name => "");
347              
348             @results = map { $_->metadata->data; } @{ $present->records() } if $present->is_success;
349             }
350              
351             my $total = $find->no_records;
352             $total = 0 unless defined $total && $total =~ /\d+/;
353              
354             Catmandu::Hits->new({
355             limit => $limit,
356             start => $start,
357             total => int($total),
358             hits => \@results,
359             });
360             }
361              
362             =head2 searcher()
363              
364             Not implemented
365              
366             =cut
367             sub searcher {
368             die("not implemented");
369             }
370              
371             =head2 delete_all()
372              
373             Not implemented
374              
375             =cut
376             sub delete_all {
377             die("not supported");
378             }
379              
380              
381             =head2 delete_by_query()
382              
383             Not implemented
384              
385             =cut
386             sub delete_by_query {
387             die("not supported");
388             }
389              
390             sub translate_sru_sortkeys {
391 0     0 0   die("not supported");
392             }
393              
394              
395             sub translate_cql_query {
396 0     0 0   die("not supported");
397             }
398              
399             =head1 SEE ALSO
400              
401             L<Catmandu::Store>
402              
403             =cut
404              
405             1;