File Coverage

blib/lib/Message/MongoDB.pm
Criterion Covered Total %
statement 27 63 42.8
branch 2 18 11.1
condition 0 6 0.0
subroutine 8 11 72.7
pod 4 4 100.0
total 41 102 40.2


line stmt bran cond sub pod time code
1             package Message::MongoDB;
2              
3 2     2   84222 use 5.006;
  2         9  
  2         95  
4 2     2   15 use strict; use warnings FATAL => 'all';
  2     2   5  
  2         114  
  2         11  
  2         9  
  2         89  
5 2     2   1547 use MongoDB;
  2         5309015  
  2         1450  
6              
7             =head1 NAME
8              
9             Message::MongoDB - Message-oriented interface to MongoDB
10              
11             =head1 VERSION
12              
13             Version 0.1
14              
15             =cut
16              
17             our $VERSION = '0.1';
18              
19              
20             =head1 SYNOPSIS
21              
22             use Message::MongoDB;
23              
24             my $mongo = Message::MongoDB->new();
25              
26             $mongo->message({
27             mongo_db => 'my_db',
28             mongo_collection => 'my_collection',
29             mongo_method => 'insert',
30             mongo_write => { a => 'b' },
31             });
32              
33             $mongo->message({
34             mongo_db => 'my_db',
35             mongo_collection => 'my_collection',
36             mongo_method => 'find',
37             mongo_search => { },
38             });
39              
40             #the emit method will be called with an array reference that contains
41             #{a => 'b'}
42              
43              
44             =head1 SUBROUTINES/METHODS
45              
46             =head2 new
47              
48             my $mongo = Message::MongoDB->new();
49              
50             Nothing too interesting at this point.
51              
52             =cut
53              
54             sub new {
55 1     1 1 12 my $class = shift;
56 1 50       6 die "Message::MongoDB::new: even number of argument required\n"
57             if scalar @_ % 2;
58 1         4 my $self = {
59             connection => undef,
60             };
61              
62 1         2 my %args = @_;
63 1         2 bless ($self, $class);
64 1         8 return $self;
65             }
66              
67             sub _connect {
68 1     1   2 my $self = shift;
69 1 50       5 return if $self->{connection};
70 1         6 return $self->{connection} = MongoDB::MongoClient->new($self->auth);
71             }
72              
73             sub _collection {
74 1     1   50 my $self = shift;
75 1         3 my $db_name = shift;
76 1         3 my $collection_name = shift;
77 1         5 $self->_connect();
78 0         0 my $db = $self->{connection}->get_database($db_name);
79 0         0 return $db->get_collection($collection_name);
80             }
81              
82             #this is for testing...probably should put it in Test.pm
83             sub _get_documents {
84 0     0   0 my $self = shift;
85 0         0 my $db_name = shift;
86 0         0 my $collection_name = shift;
87 0         0 my $collection = $self->_collection($db_name,$collection_name);
88 0         0 my $ret = [];
89 0         0 my $cursor = $collection->find;
90 0         0 while(my $doc = $cursor->next) {
91 0         0 push @$ret, $doc;
92             }
93 0         0 return $ret;
94             }
95              
96              
97             =head2 message
98              
99             $mongo->message({
100             mongo_db => 'my_db',
101             mongo_collection => 'my_collection',
102             mongo_method => 'insert',
103             mongo_write => { a => 'b' },
104             });
105              
106             Execute the specified mongo_method on the specified mongo_db and
107             mongo_collection.
108              
109             =over 4
110              
111             =item * message (first positional, required)
112              
113             =over 4
114              
115             =item * mongo_db (required)
116              
117             Scalar referencing the mongo database to operate on.
118              
119             =item * mongo_collection (required)
120              
121             Scalar referencing the mongo collection to operate on.
122              
123             =item * mongo_method (required)
124              
125             Scalar indicating the mongo method to run. One of
126              
127             =over 4
128              
129             =item * find
130              
131             Requires C<mongo_search>
132              
133             =item * insert
134              
135             Requires C<mongo_write>
136              
137             =item * update
138              
139             Requires C<mongo_search> and C<mongo_write>
140              
141             =item * remove
142              
143             Requires C<mongo_search>
144              
145             =back
146              
147             =item * mongo_search
148              
149             MongoDB search criteria.
150              
151             { a => 'b', c => { '$gt' => 99 } }
152              
153             =item * mongo_write
154              
155             MongoDB 'write' criteria, for update and insert.
156              
157             { a => 'b', x => [1,2,3] } #for insert
158              
159             { a => 'b', c => { '$set' => 100 } } #for update
160              
161             =back
162              
163             =back
164             =cut
165             sub message {
166 0 0   0 1 0 my $self = shift or die "Message::MongoDB::message: must be called as a method\n";
167 0         0 my $message = shift;
168 0 0 0     0 die "Message::MongoDB::message: must have at least one argument, a HASH reference\n"
      0        
169             if not $message or
170             not ref $message or
171             ref $message ne 'HASH';
172 0 0       0 die "Message::MongoDB::message: even number of argument required\n"
173             if scalar @_ % 2;
174 0         0 my %args = @_;
175 0         0 my $mongo_db = $message->{mongo_db};
176 0         0 my $mongo_collection = $message->{mongo_collection};
177 0         0 my $mongo_method = $message->{mongo_method};
178 0         0 my $mongo_write = $message->{mongo_write};
179 0         0 my $mongo_search = $message->{mongo_search};
180 0         0 my $coll = $self->_collection($mongo_db, $mongo_collection);
181 0 0       0 if($mongo_method eq 'insert') {
    0          
    0          
    0          
182 0         0 $coll->insert($mongo_write);
183             } elsif($mongo_method eq 'remove') {
184 0         0 $coll->remove($mongo_search);
185             } elsif($mongo_method eq 'update') {
186 0         0 $coll->update($mongo_search, $mongo_write);
187             } elsif($mongo_method eq 'find') {
188 0         0 my $cursor = $coll->find($mongo_search);
189 0         0 my $ret;
190 0         0 while(my $doc = $cursor->next) {
191 0         0 push @$ret, $doc;
192             }
193 0         0 $self->emit(message => $ret);
194             } else {
195 0         0 die "unknown mongo_method passed: '$mongo_method'";
196             }
197             }
198              
199             =head2 auth
200              
201             This returns the authentication bits necessary to talk to the desired
202             MongoDB.
203              
204             Defaults to all defaults; localhost and port 27017. Over-ride as
205             necessary.
206              
207             =cut
208             sub auth {
209 1     1 1 2 my $self = shift;
210 1         47 return ();
211             }
212              
213             =head2 emit
214              
215             $merge->emit(%args)
216              
217             This method is designed to be over-ridden; the default implementation simply
218             adds the outbound message, which is an ARRAY reference of HASHrefs
219             which represents the MongoDB result set, to the package global
220             @Message::MongoDB::return_messages
221              
222             =cut
223             our @return_messages = ();
224             sub emit {
225 0     0 1   my $self = shift;
226 0           my %args = @_;
227 0           push @return_messages, $args{message};
228 0           return \%args;
229             }
230              
231              
232              
233              
234             =head1 AUTHOR
235              
236             Dana M. Diederich, C<< <diederich at gmail.com> >>
237              
238             =head1 BUGS
239              
240             Please report any bugs or feature requests to C<bug-message-mongodb at rt.cpan.org>, or through
241             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Message-MongoDB>. I will be notified, and then you'll
242             automatically be notified of progress on your bug as I make changes.
243              
244              
245              
246              
247             =head1 SUPPORT
248              
249             You can find documentation for this module with the perldoc command.
250              
251             perldoc Message::MongoDB
252              
253              
254             You can also look for information at:
255              
256             =over 4
257              
258             =item * Report bugs and feature requests here
259              
260             L<https://github.com/dana/perl-Message-MongoDB/issues>
261              
262             =item * AnnoCPAN: Annotated CPAN documentation
263              
264             L<http://annocpan.org/dist/Message-MongoDB>
265              
266             =item * CPAN Ratings
267              
268             L<http://cpanratings.perl.org/d/Message-MongoDB>
269              
270             =item * Search CPAN
271              
272             L<https://metacpan.org/module/Message::MongoDB>
273              
274             =back
275              
276              
277             =head1 ACKNOWLEDGEMENTS
278              
279              
280             =head1 LICENSE AND COPYRIGHT
281              
282             Copyright 2013 Dana M. Diederich.
283              
284             This program is free software; you can redistribute it and/or modify it
285             under the terms of the the Artistic License (2.0). You may obtain a
286             copy of the full license at:
287              
288             L<http://www.perlfoundation.org/artistic_license_2_0>
289              
290             Any use, modification, and distribution of the Standard or Modified
291             Versions is governed by this Artistic License. By using, modifying or
292             distributing the Package, you accept this license. Do not use, modify,
293             or distribute the Package, if you do not accept this license.
294              
295             If your Modified Version has been derived from a Modified Version made
296             by someone other than you, you are nevertheless required to ensure that
297             your Modified Version complies with the requirements of this license.
298              
299             This license does not grant you the right to use any trademark, service
300             mark, tradename, or logo of the Copyright Holder.
301              
302             This license includes the non-exclusive, worldwide, free-of-charge
303             patent license to make, have made, use, offer to sell, sell, import and
304             otherwise transfer the Package with respect to any patent claims
305             licensable by the Copyright Holder that are necessarily infringed by the
306             Package. If you institute patent litigation (including a cross-claim or
307             counterclaim) against any party alleging that the Package constitutes
308             direct or contributory patent infringement, then this Artistic License
309             to you shall terminate on the date that such litigation is filed.
310              
311             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
312             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
313             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
314             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
315             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
316             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
317             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
318             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
319              
320              
321             =cut
322              
323             1; # End of Message::MongoDB