our
$VERSION
=
'v1.5.0'
;
Document
)
;
Bool
Maybe
)
;
has
filter
=> (
is
=>
'ro'
,
required
=> 1,
isa
=> Document,
);
has
update
=> (
is
=>
'ro'
,
required
=> 1,
);
has
is_replace
=> (
is
=>
'ro'
,
required
=> 1,
isa
=> Bool,
);
has
multi
=> (
is
=>
'ro'
,
required
=> 1,
isa
=> Bool,
);
has
upsert
=> (
is
=>
'ro'
,
);
has
collation
=> (
is
=>
'ro'
,
isa
=> Maybe( [Document] ),
);
with
$_
for
qw(
MongoDB::Role::_PrivateConstructor
MongoDB::Role::_CollectionOp
MongoDB::Role::_SingleBatchDocWrite
MongoDB::Role::_UpdatePreEncoder
MongoDB::Role::_BypassValidation
)
;
my
(
$true
,
$false
) = (true, false);
sub
execute {
my
(
$self
,
$link
) =
@_
;
if
(
defined
$self
->collation ) {
MongoDB::UsageError->throw(
"MongoDB host '"
.
$link
->address .
"' doesn't support collation"
)
if
!
$link
->supports_collation;
MongoDB::UsageError->throw(
"Unacknowledged updates that specify a collation are not allowed"
)
if
!
$self
->write_concern->is_acknowledged;
}
my
$orig_op
= {
q =>
(
ref
(
$self
->filter ) eq
'ARRAY'
? { @{
$self
->filter } }
:
$self
->filter
),
u
=>
$self
->update,
multi
=>
$self
->multi ?
$true
:
$false
,
upsert
=>
$self
->upsert ?
$true
:
$false
,
(
defined
$self
->collation ? (
collation
=>
$self
->collation ) : () ),
};
return
!
$self
->write_concern->is_acknowledged
? (
$self
->_send_legacy_op_noreply(
$link
,
MongoDB::_Protocol::write_update(
$self
->full_name,
$self
->bson_codec->encode_one(
$orig_op
->{
q}, { invalid_chars => '' }
),
$self
->_pre_encode_update(
$link
,
$orig_op
->{u},
$self
->is_replace )->{bson},
{
upsert
=>
$orig_op
->{upsert},
multi
=>
$orig_op
->{multi},
},
),
$orig_op
,
"MongoDB::UpdateResult"
)
)
:
$link
->does_write_commands
? (
$self
->_send_write_command(
$self
->_maybe_bypass(
$link
,
[
update
=>
$self
->coll_name,
updates
=> [
{
%$orig_op
,
u
=>
$self
->_pre_encode_update(
$link
,
$orig_op
->{u},
$self
->is_replace ),
}
],
@{
$self
->write_concern->as_args },
],
),
$orig_op
,
"MongoDB::UpdateResult"
)->assert
)
: (
$self
->_send_legacy_op_with_gle(
$link
,
MongoDB::_Protocol::write_update(
$self
->full_name,
$self
->bson_codec->encode_one(
$orig_op
->{
q}, { invalid_chars => '' }
),
$self
->_pre_encode_update(
$link
,
$orig_op
->{u},
$self
->is_replace )->{bson},
{
upsert
=>
$orig_op
->{upsert},
multi
=>
$orig_op
->{multi},
},
),
$orig_op
,
"MongoDB::UpdateResult"
)->assert
);
}
sub
_parse_cmd {
my
(
$self
,
$res
) =
@_
;
return
(
matched_count
=> (
$res
->{n} || 0) - @{
$res
->{upserted} || [] },
modified_count
=>
$res
->{nModified},
upserted_id
=>
$res
->{upserted} ?
$res
->{upserted}[0]{_id} :
undef
,
);
}
sub
_parse_gle {
my
(
$self
,
$res
,
$orig_doc
) =
@_
;
my
$upserted
=
$res
->{upserted};
if
(!
defined
(
$upserted
)
&&
exists
(
$res
->{updatedExisting} )
&& !
$res
->{updatedExisting}
&&
$res
->{n} == 1 )
{
$upserted
= _find_id(
$orig_doc
->{u} );
$upserted
= _find_id(
$orig_doc
->{
q} ) unless defined $upserted;
}
return
(
matched_count
=> (
$upserted
? 0 :
$res
->{n} || 0),
modified_count
=>
undef
,
upserted_id
=>
$upserted
,
);
}
sub
_find_id {
my
(
$doc
) =
@_
;
my
$type
=
ref
(
$doc
);
return
(
$type
eq
'HASH'
?
$doc
->{_id}
:
$type
eq
'ARRAY'
?
do
{
my
$i
;
for
(
$i
= 0;
$i
<
@$doc
;
$i
++ ) {
last
if
$doc
->[
$i
] eq
'_id'
}
$i
<
$#$doc
?
$doc
->[
$i
+ 1 ] :
undef
;
}
:
$type
eq
'Tie::IxHash'
?
$doc
->FETCH(
'_id'
)
:
$doc
->{_id}
);
}
1;