File Coverage

blib/lib/Mandel/Collection.pm
Criterion Covered Total %
statement 38 106 35.8
branch 8 34 23.5
condition 2 15 13.3
subroutine 9 25 36.0
pod 10 10 100.0
total 67 190 35.2


line stmt bran cond sub pod time code
1             package Mandel::Collection;
2 19     19   144408 use Mojo::Base -base;
  19         73  
  19         134  
3 19     19   10593 use Mandel::Iterator;
  19         53  
  19         134  
4 19     19   9591 use Mango::BSON ':bson';
  19         769124  
  19         3952  
5 19     19   191 use Scalar::Util 'blessed';
  19         271  
  19         905  
6 19     19   122 use Carp 'confess';
  19         40  
  19         1358  
7 19 50   19   143 use constant DEBUG => $ENV{MANDEL_CURSOR_DEBUG} ? eval 'require Data::Dumper;1' : 0;
  19         58  
  19         33753  
8              
9             has connection => sub { confess "connection required in constructor" };
10             has model => sub { confess "model required in constructor" };
11              
12             has _storage_collection => sub {
13             my $self = shift;
14             $self->connection->_storage_collection($self->model->collection_name);
15             };
16              
17             sub all {
18 0     0 1 0 my ($self, $cb) = @_;
19              
20 0         0 my $c = $self->_new_cursor;
21 0 0       0 return [map { $self->_new_document($_, 1) } @{$c->all}] unless $cb;
  0         0  
  0         0  
22              
23             $c->all(
24             sub {
25 0     0   0 my ($cursor, $err, $docs) = @_;
26 0         0 return $self->$cb($err, [map { $self->_new_document($_, 1) } @$docs]);
  0         0  
27             }
28 0         0 );
29 0         0 return $self;
30             }
31              
32             sub create {
33 5 50   5 1 3384 my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
34 5         12 my $self = shift;
35              
36 5   100     28 $self->_new_document(shift || undef, 0);
37             }
38              
39             sub count {
40 0     0 1 0 my ($self, $cb) = @_;
41              
42 0         0 my $c = $self->_new_cursor;
43 0 0       0 return $c->count unless $cb;
44              
45 0     0   0 $c->count(sub { shift; $self->$cb(@_) });
  0         0  
  0         0  
46 0         0 return $self;
47             }
48              
49             sub distinct {
50 0     0 1 0 my ($self, $field, $cb) = @_;
51              
52 0         0 my $c = $self->_new_cursor;
53 0 0       0 return $c->distinct($field) unless $cb;
54              
55 0     0   0 $c->distinct(sub { shift; $self->$cb(@_) });
  0         0  
  0         0  
56 0         0 return $self;
57             }
58              
59             sub iterator {
60 0     0 1 0 return Mandel::Iterator->new(cursor => $_[0]->_new_cursor, model => $_[0]->model);
61             }
62              
63             sub patch {
64 0     0 1 0 my ($self, $changes, $cb) = @_;
65 0         0 my $extra = $self->{extra};
66              
67             warn '[Mandel::Collection::patch] ',
68 0         0 Data::Dumper->new([$changes, $self->{query}, $extra])->Indent(1)->Sortkeys(1)->Terse(1)->Dump
69             if DEBUG;
70             $self->_storage_collection->update(
71             $self->{query} || {},
72             {'$set' => $changes},
73             {upsert => $extra->{upsert} // bson_false, multi => $extra->{multi} // bson_true},
74 0 0 0 0   0 $cb ? (sub { $self->$cb($_[1]) }) : (),
  0   0     0  
      0        
75             );
76              
77 0         0 $self;
78             }
79              
80             sub remove {
81 0 0   0 1 0 my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
82 0         0 my $self = shift;
83 0         0 my $c = $self->_storage_collection;
84 0         0 my @args = $self->{query};
85              
86 0         0 warn '[Mandel::Collection::remove] ', Data::Dumper->new([$self->{query}])->Indent(1)->Sortkeys(1)->Terse(1)->Dump
87             if DEBUG;
88 0     0   0 push @args, sub { $self->$cb($_[1]) }
89 0 0       0 if $cb;
90              
91 0         0 $c->remove(@args);
92 0         0 $self;
93             }
94              
95             sub save {
96 0     0 1 0 my ($self, $raw, $cb) = @_;
97 0         0 my $c = $self->_storage_collection;
98              
99 0   0     0 $raw->{_id} ||= bson_oid;
100              
101 0         0 warn '[Mandel::Collection::save] ', Data::Dumper->new([$raw])->Indent(1)->Sortkeys(1)->Terse(1)->Dump if DEBUG;
102              
103 0 0       0 unless ($cb) {
104 0         0 $c->save($raw);
105 0         0 return $self->_new_document($raw, 1);
106             }
107              
108             $c->save(
109             $raw,
110             sub {
111 0     0   0 my ($collection, $err, $doc) = @_;
112 0         0 $self->$cb($err, $self->_new_document($raw, 1));
113             }
114 0         0 );
115              
116 0         0 return $self;
117             }
118              
119             sub search {
120 1     1 1 4 my ($self, $query, $extra) = @_;
121 1         6 my $class = blessed $self;
122 1         6 my $clone = $class->new(%$self);
123              
124 1 50       20 @{$clone->{extra}}{keys %$extra} = values %$extra if $extra;
  0         0  
125 1 50       6 @{$clone->{query}}{keys %$query} = values %$query if $query;
  1         3  
126 1         4 $clone;
127             }
128              
129             sub single {
130 0     0 1 0 my ($self, $cb) = @_;
131              
132 0         0 my $c = $self->_new_cursor->limit(-1);
133 0 0       0 unless ($cb) {
134 0 0       0 my $doc = $c->next or return;
135 0         0 return $self->_new_document($doc, 1);
136             }
137              
138             $c->next(
139             sub {
140 0     0   0 my ($cursor, $err, $doc) = @_;
141 0 0       0 $self->$cb($err, $doc ? $self->_new_document($doc, 1) : undef);
142             }
143 0         0 );
144 0         0 return $self;
145             }
146              
147             sub _new_cursor {
148 0     0   0 my $self = shift;
149 0   0     0 my $extra = $self->{extra} || {};
150 0         0 my $cursor = $self->_storage_collection->find;
151              
152 0 0       0 $cursor->query($self->{query}) if $self->{query};
153 0         0 $cursor->$_($extra->{$_}) for keys %$extra;
154              
155 0         0 if (DEBUG) {
156             local $cursor->{collection}{db} = $cursor->{collection}{db}{name}; # hide big data structure
157             warn '[', +(caller 1)[3], '] ', Data::Dumper->new([$cursor])->Indent(1)->Sortkeys(1)->Terse(1)->Dump;
158             }
159              
160 0         0 $cursor;
161             }
162              
163             sub _new_document {
164 5     5   13 my ($self, $doc, $from_storage) = @_;
165 5         12 my $model = $self->model;
166 4         28 my @extra;
167              
168 4 100       14 if ($doc) {
169 3         8 push @extra, data => $doc;
170 3         32 push @extra, dirty => {map { $_, 1 } keys %$doc};
  3         11  
171             }
172 4 100       15 if (my $connection = $self->{connection}) {
173 2         4 push @extra,
174             connection => $connection,
175             ;
176             }
177              
178 4         13 $model->document_class->new(model => $model, in_storage => $from_storage, @extra);
179             }
180              
181             1;
182              
183             =encoding utf8
184              
185             =head1 NAME
186              
187             Mandel::Collection - A collection of Mandel documents
188              
189             =head1 SYNOPSIS
190              
191             my $connection = MyModel->connect("mongodb://localhost/my_db");
192             my $persons = $connection->collection("person");
193              
194             $persons->count(sub {
195             my($persons, $err, $int) = @_;
196             });
197              
198             # ...
199              
200             =head1 DESCRIPTION
201              
202             This class is used to describe a group of mongodb documents.
203              
204             =head1 ATTRIBUTES
205              
206             =head2 connection
207              
208             An object that inherit from L.
209              
210             =head2 model
211              
212             An object that inherit from L.
213              
214             =head1 METHODS
215              
216             =head2 all
217              
218             $self = $self->all(sub { my($self, $err, $docs) = @_; });
219             $docs = $self->all;
220              
221             Retrieves all documents from the database that match the given L
222             query.
223              
224             =head2 create
225              
226             $document = $self->create;
227             $document = $self->create(\%args);
228              
229             Returns a new object of a given type. This object is NOT inserted into the
230             mongodb collection. You need to call L for that to
231             happen.
232              
233             C<%args> is used to set the fields in the new document, NOT the attributes.
234              
235             =head2 count
236              
237             $self = $self->count(sub { my($self, $err, $int) = @_; });
238             $int = $self->count;
239              
240             Used to count how many documents the current L query match.
241              
242             =head2 distinct
243              
244             $self = $self->distinct("field_name", sub { my($self, $err, $values) = @_; });
245             $values = $self->distinct("field_name");
246              
247             Get all distinct values for key in this collection.
248              
249             =head2 iterator
250              
251             $iterator = $self->iterator;
252              
253             Returns a L object based on the L performed.
254              
255             =head2 patch
256              
257             $self = $self->patch(\%changes, sub { my($self, $err, $doc) = @_ });
258             $self = $self->patch(\%changes);
259              
260             This method can be used to add C<%changes> to multiple documents
261             in the collection. Which documents to update will be decided by the
262             C<%query> given to L.
263              
264             C<%extra> arguments default to:
265              
266             =over 4
267              
268             =item * upsert: false
269              
270             =item * multi: true
271              
272             =back
273              
274             =head2 remove
275              
276             $self = $self->remove(sub { my($self, $err) = @_; });
277             $self = $self->remove;
278              
279             Remove the documents that query given to L.
280              
281             =head2 save
282              
283             $self = $self->save(\%document, sub { my($self, $err, $doc) = @_; );
284             $doc = $self->save(\%document);
285              
286             Used to save a document. The callback receives a L.
287              
288             =head2 search
289              
290             $clone = $self->search(\%query, \%extra);
291              
292             Return a clone of the given collection, but with different C<%search> and
293             C<%extra> parameters. You can chain these calls to make the query more
294             precise.
295              
296             C<%extra> will be used to set extra parameters on the L, where
297             all the keys need to match the L.
298              
299             =head2 single
300              
301             $self = $self->single(sub { my($self, $err, $doc) = @_; });
302             $doc = $self->single;
303              
304             Will return the first object found in the callback, matching the given
305             C<%search> query.
306              
307             =head1 SEE ALSO
308              
309             L, L, L
310              
311             =head1 AUTHOR
312              
313             Jan Henning Thorsen - C
314              
315             =cut