File Coverage

blib/lib/Catmandu/Store/MongoDB/Bag.pm
Criterion Covered Total %
statement 24 95 25.2
branch 0 28 0.0
condition 0 19 0.0
subroutine 8 24 33.3
pod 0 10 0.0
total 32 176 18.1


line stmt bran cond sub pod time code
1             package Catmandu::Store::MongoDB::Bag;
2              
3 3     3   25 use Catmandu::Sane;
  3         7  
  3         20  
4              
5             our $VERSION = '0.0805';
6              
7 3     3   636 use Catmandu::Util qw(:is);
  3         10  
  3         1007  
8 3     3   1457 use Catmandu::Store::MongoDB::Searcher;
  3         15  
  3         149  
9 3     3   2314 use Catmandu::Hits;
  3         34035  
  3         161  
10 3     3   28 use Cpanel::JSON::XS qw(decode_json);
  3         8  
  3         204  
11 3     3   51 use Moo;
  3         8  
  3         16  
12 3     3   3191 use Catmandu::Store::MongoDB::CQL;
  3         12  
  3         110  
13 3     3   23 use namespace::clean;
  3         5  
  3         30  
14              
15             with 'Catmandu::Bag';
16             with 'Catmandu::Droppable';
17             with 'Catmandu::CQLSearchable';
18              
19             has collection => (
20             is => 'ro',
21             init_arg => undef,
22             lazy => 1,
23             builder => '_build_collection',
24             );
25              
26             has cql_mapping => (is => 'ro');
27              
28             sub _build_collection {
29 0     0     my ($self) = @_;
30 0           $self->store->database->get_collection($self->name);
31             }
32              
33             sub _options {
34 0     0     my ($self, $opts) = @_;
35 0   0       $opts //= {};
36 0 0         $opts->{session} = $self->store->session if $self->store->has_session;
37 0           $opts;
38             }
39              
40             sub _cursor {
41 0     0     my ($self, $filter, $opts) = @_;
42 0   0       $self->collection->find($filter // {}, $self->_options($opts));
43             }
44              
45             sub generator {
46 0     0 0   my ($self) = @_;
47             sub {
48 0     0     state $cursor = do {
49 0           my $c = $self->_cursor;
50 0           $c->immortal(1);
51 0           $c;
52             };
53 0           $cursor->next;
54 0           };
55             }
56              
57             sub to_array {
58 0     0 0   my ($self) = @_;
59 0           my @all = $self->_cursor->all;
60 0           \@all;
61             }
62              
63             sub each {
64 0     0 0   my ($self, $sub) = @_;
65 0           my $cursor = $self->_cursor;
66 0           my $n = 0;
67 0           while (my $data = $cursor->next) {
68 0           $sub->($data);
69 0           $n++;
70             }
71 0           $n;
72             }
73              
74             sub count {
75 0     0 0   my ($self) = @_;
76 0 0         if ($self->store->estimate_count) {
77 0           return $self->collection->estimated_document_count();
78             }
79 0           $self->collection->count_documents({}, $self->_options);
80             }
81              
82             # efficiently handle:
83             # $bag->detect('foo' => 'bar')
84             # $bag->detect('foo' => /bar/)
85             # $bag->detect('foo' => ['bar', 'baz'])
86             around detect => sub {
87             my ($orig, $self, $arg1, $arg2) = @_;
88             if (is_string($arg1)) {
89             if (is_value($arg2) || is_regex_ref($arg2)) {
90             return $self->collection->find_one({$arg1 => $arg2},
91             {}, $self->_options);
92             }
93             if (is_array_ref($arg2)) {
94             return $self->collection->find_one({$arg1 => {'$in' => $arg2}},
95             {}, $self->_options);
96             }
97             }
98             $self->$orig($arg1, $arg2);
99             };
100              
101             # efficiently handle:
102             # $bag->select('foo' => 'bar')
103             # $bag->select('foo' => /bar/)
104             # $bag->select('foo' => ['bar', 'baz'])
105             around select => sub {
106             my ($orig, $self, $arg1, $arg2) = @_;
107             if (is_string($arg1)) {
108             if (is_value($arg2) || is_regex_ref($arg2)) {
109             return Catmandu::Iterator->new(
110             sub {
111             sub {
112             state $cursor = $self->_cursor({$arg1 => $arg2});
113             $cursor->next;
114             }
115             }
116             );
117             }
118             if (is_array_ref($arg2)) {
119             return Catmandu::Iterator->new(
120             sub {
121             sub {
122             state $cursor
123             = $self->_cursor({$arg1 => {'$in' => $arg2}});
124             $cursor->next;
125             }
126             }
127             );
128             }
129             }
130             $self->$orig($arg1, $arg2);
131             };
132              
133             # efficiently handle:
134             # $bag->reject('foo' => 'bar')
135             # $bag->reject('foo' => ['bar', 'baz'])
136             around reject => sub {
137             my ($orig, $self, $arg1, $arg2) = @_;
138             if (is_string($arg1)) {
139             if (is_value($arg2)) {
140             return Catmandu::Iterator->new(
141             sub {
142             sub {
143             state $cursor
144             = $self->_cursor({$arg1 => {'$ne' => $arg2}});
145             $cursor->next;
146             }
147             }
148             );
149             }
150             if (is_array_ref($arg2)) {
151             return Catmandu::Iterator->new(
152             sub {
153             sub {
154             state $cursor
155             = $self->_cursor({$arg1 => {'$nin' => $arg2}});
156             $cursor->next;
157             }
158             }
159             );
160             }
161             }
162             $self->$orig($arg1, $arg2);
163             };
164              
165             sub pluck {
166 0     0 0   my ($self, $key) = @_;
167             Catmandu::Iterator->new(
168             sub {
169             sub {
170 0           state $cursor
171             = $self->_cursor({}, {projection => {$key => 1}});
172 0   0       ($cursor->next || return)->{$key};
173             }
174 0     0     }
175 0           );
176             }
177              
178             sub get {
179             my ($self, $id) = @_;
180             $self->collection->find_one({_id => $id}, {}, $self->_options);
181             }
182              
183             sub add {
184             my ($self, $data) = @_;
185             $self->collection->replace_one({_id => $data->{_id}},
186             $data, $self->_options({upsert => 1}));
187             }
188              
189             sub delete {
190             my ($self, $id) = @_;
191             $self->collection->delete_one({_id => $id}, $self->_options);
192             }
193              
194             sub delete_all {
195             my ($self) = @_;
196             $self->collection->delete_many({}, $self->_options);
197             }
198              
199             sub delete_by_query {
200             my ($self, %args) = @_;
201             $self->collection->delete_many($args{query}, $self->_options);
202             }
203              
204             sub search {
205             my ($self, %args) = @_;
206              
207             my $query = $args{query};
208             my $start = $args{start};
209             my $limit = $args{limit};
210             my $bag = $args{reify};
211             my $fields = $args{fields};
212              
213             # limit 0 == all in mongodb
214             my $orig_limit = $limit;
215             if ($orig_limit == 0) {
216             $limit = 1;
217             }
218              
219             my $cursor = $self->_cursor($query)->skip($start)->limit($limit);
220             if ($bag) { # only retrieve _id
221             $cursor->fields({});
222             }
223             elsif ($fields) { # only retrieve specified fields
224             $cursor->fields($fields);
225             }
226              
227             if (my $sort = $args{sort}) {
228             $cursor->sort($sort);
229             }
230              
231             my @hits = $cursor->all;
232              
233             if ($orig_limit == 0) {
234             @hits = ();
235             }
236              
237             if ($bag) {
238             @hits = map {$bag->get($_->{_id})} @hits;
239             }
240              
241             Catmandu::Hits->new(
242             {
243             start => $start,
244             limit => $orig_limit,
245             total =>
246             $self->collection->count_documents($query, $self->_options),
247             hits => \@hits,
248             }
249             );
250             }
251              
252             sub searcher {
253             my ($self, %args) = @_;
254             Catmandu::Store::MongoDB::Searcher->new(%args, bag => $self);
255             }
256              
257             sub translate_sru_sortkeys {
258 0     0 0   my ($self, $sortkeys) = @_;
259             my $keys = [
260 0           grep {defined $_} map {$self->_translate_sru_sortkey($_)} split /\s+/,
  0            
  0            
261             $sortkeys
262             ];
263 0           my $mongo_sort = [];
264              
265             # flatten sortkeys
266 0           for (@$keys) {
267 0           push @$mongo_sort, @$_;
268             }
269 0           $self->log->debugf("translating sortkeys '$sortkeys' to mongo sort: %s",
270             $mongo_sort);
271 0           $mongo_sort;
272             }
273              
274             sub _translate_sru_sortkey {
275 0     0     my ($self, $sortkey) = @_;
276 0           my ($field, $schema, $asc) = split /,/, $sortkey;
277 0 0         $field || return;
278 0 0 0       ($asc && ($asc == 1 || $asc == -1)) || return;
      0        
279 0 0         if (my $map = $self->cql_mapping) {
280 0           $field = lc $field;
281             $field =~ s/(?<=[^_])_(?=[^_])//g
282 0 0         if $map->{strip_separating_underscores};
283 0   0       $map = $map->{indexes} || return;
284 0   0       $map = $map->{$field} || return;
285 0 0         $map->{sort} || return;
286 0 0 0       if (ref $map->{sort} && $map->{sort}{field}) {
    0          
    0          
287 0           $field = $map->{sort}{field};
288             }
289             elsif (ref $map->{field}) {
290 0           $field = $map->{field}->[0];
291             }
292             elsif ($map->{field}) {
293 0           $field = $map->{field};
294             }
295             }
296              
297             # Use a bad trick to force $asc interpreted as an integer
298 0           [$field => $asc + 0];
299             }
300              
301             sub translate_cql_query {
302 0     0 0   my ($self, $query) = @_;
303 0           my $mongo_query
304             = Catmandu::Store::MongoDB::CQL->new(mapping => $self->cql_mapping)
305             ->parse($query);
306 0           $self->log->debugf("translating cql '$query' to mongo query: %s",
307             $mongo_query);
308 0           $mongo_query;
309             }
310              
311             # assume a string query is a JSON encoded MongoDB query
312             sub normalize_query {
313 0     0 0   my ($self, $query) = @_;
314 0 0         return $query if ref $query;
315 0 0         return {} if !$query;
316 0           decode_json($query);
317             }
318              
319             # assume a sort option is a JSON encoded MongoDB sort specification
320             sub normalize_sort {
321 0     0 0   my ($self, $sort) = @_;
322 0 0         return $sort if ref $sort;
323 0 0         return {} if !$sort;
324 0           decode_json($sort);
325             }
326              
327             sub drop {
328 0     0 0   $_[0]->collection->drop;
329             }
330              
331             1;
332              
333             __END__
334              
335             =pod
336              
337             =head1 NAME
338              
339             Catmandu::Store::MongoDB::Bag - Catmandu::Bag implementation for MongoDB
340              
341             =head1 DESCRIPTION
342              
343             This class isn't normally used directly. Instances are constructed using the store's C<bag> method.
344              
345             =head1 SEE ALSO
346              
347             L<Catmandu::Bag>, L<Catmandu::CQLSearchable>, L<Catmandu::Droppable>
348              
349             =cut