File Coverage

blib/lib/MongoDB/BulkWriteResult.pm
Criterion Covered Total %
statement 30 120 25.0
branch 0 38 0.0
condition 0 11 0.0
subroutine 10 16 62.5
pod 0 1 0.0
total 40 186 21.5


line stmt bran cond sub pod time code
1             # Copyright 2014 - present MongoDB, Inc.
2             #
3             # Licensed under the Apache License, Version 2.0 (the "License");
4             # you may not use this file except in compliance with the License.
5             # You may obtain a copy of the License at
6             #
7             # http://www.apache.org/licenses/LICENSE-2.0
8             #
9             # Unless required by applicable law or agreed to in writing, software
10             # distributed under the License is distributed on an "AS IS" BASIS,
11             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12             # See the License for the specific language governing permissions and
13             # limitations under the License.
14              
15 60     60   908 use strict;
  60         126  
  60         1560  
16 60     60   273 use warnings;
  60         152  
  60         1715  
17             package MongoDB::BulkWriteResult;
18              
19             # ABSTRACT: MongoDB bulk write result document
20              
21 60     60   277 use version;
  60         111  
  60         278  
22             our $VERSION = 'v2.2.2';
23              
24             # empty superclass for backcompatibility; add a variable to the
25             # package namespace so Perl thinks it's a real package
26             $MongoDB::WriteResult::VERSION = $VERSION;
27              
28 60     60   4670 use Moo;
  60         161  
  60         344  
29 60     60   16672 use MongoDB::Error;
  60         129  
  60         5366  
30 60     60   390 use MongoDB::_Constants;
  60         110  
  60         6875  
31 60         469 use MongoDB::_Types qw(
32             ArrayOfHashRef
33             Numish
34 60     60   396 );
  60         135  
35 60         388 use Types::Standard qw(
36             HashRef
37             Undef
38 60     60   65370 );
  60         122  
39 60     60   42079 use namespace::clean;
  60         140  
  60         457  
40              
41             # fake empty superclass for backcompat
42             our @ISA;
43             push @ISA, 'MongoDB::WriteResult';
44              
45             with $_ for qw(
46             MongoDB::Role::_PrivateConstructor
47             MongoDB::Role::_WriteResult
48             );
49              
50             has [qw/upserted inserted/] => (
51             is => 'ro',
52             required => 1,
53             isa => ArrayOfHashRef,
54             );
55              
56             has inserted_ids => (
57             is => 'lazy',
58             builder => '_build_inserted_ids',
59             init_arg => undef,
60             isa => HashRef,
61             );
62              
63             sub _build_inserted_ids {
64 0     0     my ($self) = @_;
65 0           return { map { $_->{index}, $_->{_id} } @{ $self->inserted } };
  0            
  0            
66             }
67              
68             has upserted_ids => (
69             is => 'lazy',
70             builder => '_build_upserted_ids',
71             init_arg => undef,
72             isa => HashRef,
73             );
74              
75             sub _build_upserted_ids {
76 0     0     my ($self) = @_;
77 0           return { map { $_->{index}, $_->{_id} } @{ $self->upserted } };
  0            
  0            
78             }
79              
80             for my $attr (qw/inserted_count upserted_count matched_count deleted_count/) {
81             has $attr => (
82             is => 'ro',
83             writer => "_set_$attr",
84             required => 1,
85             isa => Numish,
86             );
87             }
88              
89             # This should always be initialized either as a number or as undef so that
90             # merges accumulate correctly. It should be undef if talking to a server < 2.6
91             # or if talking to a mongos and not getting the field back from an update. The
92             # default is undef, which will be sticky and ensure this field stays undef.
93              
94             has modified_count => (
95             is => 'ro',
96             writer => '_set_modified_count',
97             required => 1,
98             isa => (Numish|Undef),
99             );
100              
101             sub has_modified_count {
102 0     0 0   my ($self) = @_;
103 0           return defined( $self->modified_count );
104             }
105              
106             has op_count => (
107             is => 'ro',
108             writer => '_set_op_count',
109             required => 1,
110             isa => Numish,
111             );
112              
113             has batch_count => (
114             is => 'ro',
115             writer => '_set_batch_count',
116             required => 1,
117             isa => Numish,
118             );
119              
120             #--------------------------------------------------------------------------#
121             # emulate old API
122             #--------------------------------------------------------------------------#
123              
124             my %OLD_API_ALIASING = (
125             nInserted => 'inserted_count',
126             nUpserted => 'upserted_count',
127             nMatched => 'matched_count',
128             nModified => 'modified_count',
129             nRemoved => 'deleted_count',
130             writeErrors => 'write_errors',
131             writeConcernErrors => 'write_concern_errors',
132             count_writeErrors => 'count_write_errors',
133             count_writeConcernErrors => 'count_write_concern_errors',
134             );
135              
136             while ( my ( $old, $new ) = each %OLD_API_ALIASING ) {
137 60     60   66974 no strict 'refs';
  60         134  
  60         62088  
138             *{$old} = \&{$new};
139             }
140              
141             #--------------------------------------------------------------------------#
142             # private functions
143             #--------------------------------------------------------------------------#
144              
145             # defines how an logical operation type gets mapped to a result
146             # field from the actual command result
147             my %op_map = (
148             insert => [ inserted_count => sub { $_[0]->{n} } ],
149             delete => [ deleted_count => sub { $_[0]->{n} } ],
150             update => [ matched_count => sub { $_[0]->{n} } ],
151             upsert => [ matched_count => sub { $_[0]->{n} - @{ $_[0]->{upserted} || [] } } ],
152             );
153              
154             my @op_map_keys = sort keys %op_map;
155              
156             sub _parse_cmd_result {
157 0     0     my $class = shift;
158 0 0         my $args = ref $_[0] eq 'HASH' ? shift : {@_};
159              
160 0 0         unless ( 2 == grep { exists $args->{$_} } qw/op result/ ) {
  0            
161 0           MongoDB::UsageError->throw("parse requires 'op' and 'result' arguments");
162             }
163              
164             my ( $op, $op_count, $batch_count, $result, $cmd_doc, $idx_map ) =
165 0           @{$args}{qw/op op_count batch_count result cmd_doc idx_map/};
  0            
166              
167             $result = $result->output
168 0 0         if eval { $result->isa("MongoDB::CommandResult") };
  0            
169              
170             MongoDB::UsageError->throw("op argument to parse must be one of: @op_map_keys")
171 0 0         unless grep { $op eq $_ } @op_map_keys;
  0            
172 0 0         MongoDB::UsageError->throw("results argument to parse must be a hash reference")
173             unless ref $result eq 'HASH';
174              
175 0 0 0       my %attrs = (
176             batch_count => $batch_count || 1,
177             $op_count ? ( op_count => $op_count ) : (),
178             inserted_count => 0,
179             upserted_count => 0,
180             matched_count => 0,
181             deleted_count => 0,
182             upserted => [],
183             inserted => [],
184             );
185              
186 0 0         $attrs{write_errors} = $result->{writeErrors} ? $result->{writeErrors} : [];
187              
188             # rename writeConcernError -> write_concern_errors; coerce it to arrayref
189              
190             $attrs{write_concern_errors} =
191 0 0         $result->{writeConcernError} ? [ $result->{writeConcernError} ] : [];
192              
193             # if we have upserts, change type to calculate differently
194 0 0         if ( $result->{upserted} ) {
195 0           $op = 'upsert';
196 0           $attrs{upserted} = $result->{upserted};
197 0           $attrs{upserted_count} = @{ $result->{upserted} };
  0            
198             }
199              
200             my %error_idx = (
201 0           map { $_->{index} => 1 } @{ $result->{writeErrors} },
  0            
  0            
202             );
203              
204             # recover _ids from documents
205 0 0 0       if ( exists($result->{n}) && $op eq 'insert' ) {
206 0           my @pairs;
207 0           my $docs = {@$cmd_doc}->{documents};
208 0           for my $i ( 0 .. $result->{n}-1 ) {
209 0 0         next if $error_idx{$i};
210 0           push @pairs, { index => $i, _id => $docs->[$i]{metadata}{_id} };
211             }
212 0           $attrs{inserted} = \@pairs;
213             }
214              
215             # change 'n' into an op-specific count
216 0 0         if ( exists $result->{n} ) {
217 0           my ( $key, $builder ) = @{ $op_map{$op} };
  0            
218 0           $attrs{$key} = $builder->($result);
219             }
220              
221             # for an update/upsert we want the exact response whether numeric or undef
222             # so that new undef responses become sticky; for all other updates, we
223             # consider it 0 and let it get sorted out in the merging
224              
225             $attrs{modified_count} = ( $op eq 'update' || $op eq 'upsert' ) ?
226 0 0 0       $result->{nModified} : 0;
227              
228             # Remap all indices back to original queue index
229             # in unordered batches, these numbers can end up pointing to the wrong index
230 0           for my $attr (qw/write_errors upserted inserted/) {
231 0           map { $_->{index} = $idx_map->[$_->{index}] } @{ $attrs{$attr} };
  0            
  0            
232             }
233              
234 0           return $class->_new(%attrs);
235             }
236              
237             # these are for single results only
238             sub _parse_write_op {
239 0     0     my $class = shift;
240 0           my $op = shift;
241              
242 0           my %attrs = (
243             batch_count => 1,
244             op_count => 1,
245             write_errors => $op->write_errors,
246             write_concern_errors => $op->write_concern_errors,
247             inserted_count => 0,
248             upserted_count => 0,
249             matched_count => 0,
250             modified_count => undef,
251             deleted_count => 0,
252             upserted => [],
253             inserted => [],
254             );
255              
256 0           my $has_write_error = @{ $attrs{write_errors} };
  0            
257              
258             # parse by type
259 0           my $type = ref($op);
260 0 0         if ( $type eq 'MongoDB::InsertOneResult' ) {
    0          
    0          
261 0 0         if ( $has_write_error ) {
262 0           $attrs{inserted_count} = 0;
263 0           $attrs{inserted} = [];
264             }
265             else {
266 0           $attrs{inserted_count} = 1;
267 0           $attrs{inserted} = [ { index => 0, _id => $op->inserted_id } ];
268             }
269             }
270             elsif ( $type eq 'MongoDB::DeleteResult' ) {
271 0           $attrs{deleted_count} = $op->deleted_count;
272             }
273             elsif ( $type eq 'MongoDB::UpdateResult' ) {
274 0 0         if ( defined $op->upserted_id ) {
275 0           my $upsert = { index => 0, _id => $op->upserted_id };
276 0           $attrs{upserted} = [$upsert];
277 0           $attrs{upserted_count} = 1;
278             # modified_count *must* always be defined for 2.6+ servers
279             # matched_count is here for clarity and consistency
280 0           $attrs{matched_count} = 0;
281 0           $attrs{modified_count} = 0;
282             }
283             else {
284 0           $attrs{matched_count} = $op->matched_count;
285 0           $attrs{modified_count} = $op->modified_count;
286             }
287             }
288             else {
289 0           MongoDB::InternalError->throw("can't parse unknown result class $op");
290             }
291              
292 0           return $class->_new(%attrs);
293             }
294              
295             sub _merge_result {
296 0     0     my ( $self, $result ) = @_;
297              
298             # Add simple counters
299 0           for my $attr (qw/inserted_count upserted_count matched_count deleted_count/) {
300 0           my $setter = "_set_$attr";
301 0           $self->$setter( $self->$attr + $result->$attr );
302             }
303              
304             # If modified_count is defined in both results we're merging, then we're
305             # talking to a 2.6+ mongod or we're talking to a 2.6+ mongos and have only
306             # seen responses with modified_count. In any other case, we set
307             # modified_count to undef, which then becomes "sticky"
308              
309 0 0 0       if ( defined $self->modified_count && defined $result->modified_count ) {
310 0           $self->_set_modified_count( $self->modified_count + $result->modified_count );
311             }
312             else {
313 0           $self->_set_modified_count(undef);
314             }
315              
316             # Append error and upsert docs, index is dealt with in _parse_cmd_result
317 0           for my $attr (qw/write_errors upserted inserted/) {
318 0           push @{ $self->$attr }, @{ $result->$attr };
  0            
  0            
319             }
320              
321             # Append write concern errors without modification (they have no index)
322 0           push @{ $self->write_concern_errors }, @{ $result->write_concern_errors };
  0            
  0            
323              
324 0           $self->_set_op_count( $self->op_count + $result->op_count );
325 0           $self->_set_batch_count( $self->batch_count + $result->batch_count );
326              
327 0           return 1;
328             }
329              
330             1;
331              
332             __END__