File Coverage

blib/lib/Catmandu/Store/MongoDB.pm
Criterion Covered Total %
statement 20 55 36.3
branch 1 8 12.5
condition 6 17 35.2
subroutine 6 9 66.6
pod 1 2 50.0
total 34 91 37.3


line stmt bran cond sub pod time code
1             package Catmandu::Store::MongoDB;
2              
3 3     3   100266 use Catmandu::Sane;
  3         529537  
  3         20  
4              
5             our $VERSION = '0.0806';
6              
7 3     3   956 use Moo;
  3         7  
  3         18  
8 3     3   2496 use Catmandu::Store::MongoDB::Bag;
  3         9  
  3         87  
9 3     3   1526 use MongoDB;
  3         4197086  
  3         120  
10 3     3   28 use namespace::clean;
  3         8  
  3         21  
11              
12             with 'Catmandu::Store';
13             with 'Catmandu::Transactional';
14              
15             has client => (is => 'lazy');
16             has database_name => (is => 'ro', required => 1);
17             has database => (is => 'lazy', handles => [qw(drop)]);
18             has estimate_count => (is => 'ro', default => sub {0});
19             has session =>
20             (is => 'rw', predicate => 1, clearer => 1, writer => 'set_session');
21              
22             with 'Catmandu::Droppable';
23              
24             sub _build_client {
25 0     0   0 my $self = shift;
26 0         0 my $args = delete $self->{_args};
27 0   0     0 my $host = $self->{_args}->{host} // 'mongodb://localhost:27017';
28 0         0 $self->log->debug("Build MongoClient for $host");
29 0         0 my $client = MongoDB::MongoClient->new($args);
30 0         0 return $client;
31             }
32              
33             sub _build_database {
34 0     0   0 my $self = shift;
35 0         0 my $database_name = $self->database_name;
36 0         0 $self->log->debug("Build or get database $database_name");
37 0         0 my $database = $self->client->get_database($database_name);
38 0         0 return $database;
39             }
40              
41             sub BUILD {
42 1     1 0 12 my ($self, $args) = @_;
43              
44 1         3 $self->{_args} = {};
45 1         5 for my $key (keys %$args) {
46             next
47 2 50 66     29 if $key eq 'client'
      66        
      66        
48             || $key eq 'database_name'
49             || $key eq 'database'
50             || $key eq 'estimate_count';
51 1         3 $self->{_args}{$key} = $args->{$key};
52             }
53             }
54              
55             sub transaction {
56 0     0 1   my ($self, $sub) = @_;
57              
58 0 0         if ($self->has_session) {
59 0           return $sub->();
60             }
61              
62 0           my $session = $self->client->start_session;
63 0           my @res;
64              
65             eval {
66 0           $self->set_session($session);
67 0           $session->start_transaction;
68              
69 0           @res = $sub->();
70              
71             COMMIT: {
72 0           eval {
73 0           $session->commit_transaction;
74 0           1;
75 0   0       } // do {
76 0           my $err = $@;
77 0 0         if ($err->has_error_label("UnknownTransactionCommitResult")) {
78 0           redo COMMIT;
79             }
80             else {
81 0           die $err;
82             }
83             };
84             }
85              
86 0           $self->clear_session;
87              
88 0           1;
89 0   0       } // do {
90 0           my $err = $@;
91 0           $session->abort_transaction;
92 0           $self->clear_session;
93 0           die $err;
94             };
95              
96 0 0         wantarray ? @res : $res[0];
97             }
98              
99             1;
100              
101             __END__
102              
103             =pod
104              
105             =head1 NAME
106              
107             Catmandu::Store::MongoDB - A searchable store backed by MongoDB
108              
109             =head1 SYNOPSIS
110              
111             # On the command line
112             $ catmandu import -v JSON --multiline 1 to MongoDB --database_name bibliography --bag books < books.json
113             $ catmandu export MongoDB --database_name bibliography --bag books to YAML
114             $ catmandu count MongoDB --database_name bibliography --bag books --query '{"PublicationYear": "1937"}'
115             $ catmandu count MongoDB --database_name bibliography --bag books --query '{"Author": "Jones"}' --sort '{"PublicationYear":1}'
116              
117             # In perl
118             use Catmandu::Store::MongoDB;
119              
120             my $store = Catmandu::Store::MongoDB->new(database_name => 'test');
121              
122             my $obj1 = $store->bag->add({ name => 'Patrick' });
123              
124             printf "obj1 stored as %s\n" , $obj1->{_id};
125              
126             # Force an id in the store
127             my $obj2 = $store->bag->add({ _id => 'test123' , name => 'Nicolas' });
128              
129             my $obj3 = $store->bag->get('test123');
130              
131             $store->bag->delete('test123');
132              
133             $store->bag->delete_all;
134              
135             # All bags are iterators
136             $store->bag->each(sub { ... });
137             $store->bag->take(10)->each(sub { ... });
138              
139             # Search
140             my $hits = $store->bag->search(query => '{"name":"Patrick"}');
141             my $hits = $store->bag->search(query => '{"name":"Patrick"}' , sort => { age => -1} );
142             my $hits = $store->bag->search(query => {name => "Patrick"} , start => 0 , limit => 100);
143             my $hits = $store->bag->search(query => {name => "Patrick"} , fields => {_id => 0, name => 1});
144              
145             my $next_page = $hits->next_page;
146             my $hits = $store->bag->search(query => '{"name":"Patrick"}' , page => $next_page);
147              
148             my $iterator = $store->bag->searcher(query => {name => "Patrick"});
149             my $iterator = $store->bag->searcher(query => {name => "Patrick"}, fields => {_id => 0, name => 1});
150              
151             # Catmandu::Store::MongoDB supports CQL...
152             my $hits = $store->bag->search(cql_query => 'name any "Patrick"');
153              
154             =head1 DESCRIPTION
155              
156             A Catmandu::Store::MongoDB is a Perl package that can store data into
157             L<MongoDB> databases. The database as a whole is called a 'store'.
158             Databases also have compartments (e.g. tables) called Catmandu::Bag-s.
159              
160             =head1 CONFIGURATION
161              
162             =over
163              
164             =item database_name
165              
166             MongoDB database name.
167              
168             =item estimate_count
169              
170             Use a faster estimated collection document count if true.
171              
172             =back
173              
174             All other options are passed on to the MongoDB client.
175              
176             =head1 METHODS
177              
178             =head2 new(database_name => $name, %connection_opts)
179              
180             =head2 new(database_name => $name , bags => { data => { cql_mapping => $cql_mapping } })
181              
182             Create a new Catmandu::Store::MongoDB store with name $name. Optionally
183             provide connection parameters (see L<MongoDB::MongoClient> for possible
184             options).
185              
186             The store supports CQL searches when a cql_mapping is provided. This hash
187             contains a translation of CQL fields into MongoDB searchable fields.
188              
189             # Example mapping
190             $cql_mapping = {
191             indexes => {
192             title => {
193             op => {
194             'any' => 1 ,
195             'all' => 1 ,
196             '=' => 1 ,
197             '<>' => 1 ,
198             'exact' => {field => [qw(mytitle.exact myalttitle.exact)]}
199             } ,
200             sort => 1,
201             field => 'mytitle',
202             cb => ['Biblio::Search', 'normalize_title']
203             }
204             }
205             }
206              
207             The CQL mapping above will support for the 'title' field the CQL operators:
208             any, all, =, <> and exact.
209              
210             The 'title' field will be mapped into the MongoDB field 'mytitle',
211             except for the 'exact' operator. In case of 'exact' both the
212             'mytitle.exact' and 'myalttitle.exact' fields will be searched.
213              
214             The CQL mapping allows for sorting on the 'title' field. If, for instance, we
215             would like to use a special MongoDB field for sorting we could have written
216             "sort => { field => 'mytitle.sort' }".
217              
218             The CQL has an optional callback field 'cb' which contains a reference to subroutines
219             to rewrite or augment the search query. In this case, in the Biblio::Search package
220             contains a normalize_title subroutine which returns a string or an ARRAY of string
221             with augmented title(s). E.g.
222              
223             package Biblio::Search;
224              
225             sub normalize_title {
226             my ($self,$title) = @_;
227             # delete all bad characters
228             my $new_title =~ s{[^A-Z0-9]+}{}g;
229             $new_title;
230             }
231              
232             1;
233              
234             =head2 bag($name)
235              
236             Create or retieve a bag with name $name. Returns a L<Catmandu::Bag>.
237              
238             =head2 client
239              
240             Return the L<MongoDB::MongoClient> instance.
241              
242             =head2 database
243              
244             Return a L<MongoDB::Database> instance.
245              
246             =head2 drop
247              
248             Delete the store and all it's bags.
249              
250             =head2 transaction(\&sub)
251              
252             Execute C<$sub> within a transaction. See L<Catmandu::Transactional>.
253              
254             Note that only MongoDB databases with feature compatibility >= 4.0 and in a
255             replica set have support for transactions. See
256             L<https://docs.mongodb.com/manual/reference/command/setFeatureCompatibilityVersion/#view-fcv>
257             and
258             L<https://docs.mongodb.com/manual/tutorial/convert-standalone-to-replica-set/>
259             for more info.
260              
261             =head1 Search
262              
263             Search the database: see L<Catmandu::Searchable> and L<Catmandu::CQLSearchable>. This module supports an additional search parameter:
264              
265             - fields => { <field> => <0|1> } : limit fields to return from a query (see L<MongoDB Tutorial|https://docs.mongodb.org/manual/tutorial/project-fields-from-query-results/>)
266              
267             =head1 SEE ALSO
268              
269             L<Catmandu::Bag>, L<Catmandu::CQLSearchable>, L<Catmandu::Droppable>, L<Catmandu::Transactional>, L<MongoDB::MongoClient>
270              
271             =head1 AUTHOR
272              
273             Nicolas Steenlant, C<< <nicolas.steenlant at ugent.be> >>
274              
275             =head1 CONTRIBUTORS
276              
277             Johann Rolschewski, C<< <jorol at cpan.org> >>
278              
279             =head1 LICENSE AND COPYRIGHT
280              
281             This program is free software; you can redistribute it and/or modify it
282             under the terms of either: the GNU General Public License as published
283             by the Free Software Foundation; or the Artistic License.
284              
285             See http://dev.perl.org/licenses/ for more information.
286              
287             =cut