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
|
59
|
|
|
59
|
|
1059
|
use strict; |
|
59
|
|
|
|
|
121
|
|
|
59
|
|
|
|
|
1926
|
|
16
|
59
|
|
|
59
|
|
314
|
use warnings; |
|
59
|
|
|
|
|
108
|
|
|
59
|
|
|
|
|
1991
|
|
17
|
|
|
|
|
|
|
package MongoDB::WriteConcern; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# ABSTRACT: Encapsulate and validate a write concern |
20
|
|
|
|
|
|
|
|
21
|
59
|
|
|
59
|
|
688
|
use version; |
|
59
|
|
|
|
|
1886
|
|
|
59
|
|
|
|
|
315
|
|
22
|
|
|
|
|
|
|
our $VERSION = 'v2.2.0'; |
23
|
|
|
|
|
|
|
|
24
|
59
|
|
|
59
|
|
4911
|
use Moo; |
|
59
|
|
|
|
|
10653
|
|
|
59
|
|
|
|
|
291
|
|
25
|
59
|
|
|
59
|
|
18878
|
use MongoDB::Error; |
|
59
|
|
|
|
|
134
|
|
|
59
|
|
|
|
|
6131
|
|
26
|
59
|
|
|
|
|
450
|
use MongoDB::_Types qw( |
27
|
|
|
|
|
|
|
Boolish |
28
|
59
|
|
|
59
|
|
407
|
); |
|
59
|
|
|
|
|
137
|
|
29
|
59
|
|
|
|
|
339
|
use Types::Standard qw( |
30
|
|
|
|
|
|
|
ArrayRef |
31
|
|
|
|
|
|
|
Int |
32
|
|
|
|
|
|
|
Str |
33
|
|
|
|
|
|
|
Maybe |
34
|
59
|
|
|
59
|
|
59778
|
); |
|
59
|
|
|
|
|
129
|
|
35
|
59
|
|
|
59
|
|
61705
|
use Scalar::Util qw/looks_like_number/; |
|
59
|
|
|
|
|
157
|
|
|
59
|
|
|
|
|
2876
|
|
36
|
59
|
|
|
59
|
|
357
|
use boolean; |
|
59
|
|
|
|
|
114
|
|
|
59
|
|
|
|
|
506
|
|
37
|
59
|
|
|
59
|
|
3983
|
use namespace::clean -except => 'meta'; |
|
59
|
|
|
|
|
122
|
|
|
59
|
|
|
|
|
360
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
#pod =attr w |
40
|
|
|
|
|
|
|
#pod |
41
|
|
|
|
|
|
|
#pod Specifies the desired acknowledgement level. If not set, the |
42
|
|
|
|
|
|
|
#pod server default will be used, which is usually "1". |
43
|
|
|
|
|
|
|
#pod |
44
|
|
|
|
|
|
|
#pod =cut |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
has w => ( |
47
|
|
|
|
|
|
|
is => 'ro', |
48
|
|
|
|
|
|
|
isa => Maybe[Str], |
49
|
|
|
|
|
|
|
); |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
#pod =attr wtimeout |
52
|
|
|
|
|
|
|
#pod |
53
|
|
|
|
|
|
|
#pod Specifies how long to wait for the write concern to be satisfied (in |
54
|
|
|
|
|
|
|
#pod milliseconds). Defaults to 1000. If you set this to undef, it could block |
55
|
|
|
|
|
|
|
#pod indefinitely (or until socket timeout is reached). |
56
|
|
|
|
|
|
|
#pod |
57
|
|
|
|
|
|
|
#pod =cut |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
has wtimeout => ( |
60
|
|
|
|
|
|
|
is => 'ro', |
61
|
|
|
|
|
|
|
isa => Maybe[Int], |
62
|
|
|
|
|
|
|
default => 1000, |
63
|
|
|
|
|
|
|
); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
#pod =attr j |
66
|
|
|
|
|
|
|
#pod |
67
|
|
|
|
|
|
|
#pod The j option confirms that the mongod instance has written the data to the |
68
|
|
|
|
|
|
|
#pod on-disk journal. Defaults to false. |
69
|
|
|
|
|
|
|
#pod |
70
|
|
|
|
|
|
|
#pod B: specifying a write concern that set j to a true value may result in an |
71
|
|
|
|
|
|
|
#pod error with a mongod or mongos running with --nojournal option now errors. |
72
|
|
|
|
|
|
|
#pod |
73
|
|
|
|
|
|
|
#pod =cut |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
has j => ( |
76
|
|
|
|
|
|
|
is => 'ro', |
77
|
|
|
|
|
|
|
isa => Boolish, |
78
|
|
|
|
|
|
|
); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
has _is_acknowledged => ( |
81
|
|
|
|
|
|
|
is => 'lazy', |
82
|
|
|
|
|
|
|
isa => Boolish, |
83
|
|
|
|
|
|
|
reader => 'is_acknowledged', |
84
|
|
|
|
|
|
|
builder => '_build_is_acknowledged', |
85
|
|
|
|
|
|
|
); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
has _as_args => ( |
88
|
|
|
|
|
|
|
is => 'lazy', |
89
|
|
|
|
|
|
|
isa => ArrayRef, |
90
|
|
|
|
|
|
|
reader => 'as_args', |
91
|
|
|
|
|
|
|
builder => '_build_as_args', |
92
|
|
|
|
|
|
|
); |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub _build_is_acknowledged { |
95
|
0
|
|
|
0
|
|
0
|
my ($self) = @_; |
96
|
0
|
|
0
|
|
|
0
|
return !!( $self->j || $self->_w_is_acknowledged ); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub _build_as_args { |
100
|
21
|
|
|
21
|
|
1135
|
my ($self) = @_; |
101
|
|
|
|
|
|
|
|
102
|
21
|
100
|
|
|
|
200
|
my $wc = { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
103
|
|
|
|
|
|
|
( defined( $self->w ) ? ( w => $self->w ) : () ), |
104
|
|
|
|
|
|
|
( defined( $self->wtimeout ) ? ( wtimeout => 0+ $self->wtimeout ) : () ), |
105
|
|
|
|
|
|
|
( defined( $self->j ) ? ( j => boolean( $self->j ) ) : () ), |
106
|
|
|
|
|
|
|
}; |
107
|
|
|
|
|
|
|
|
108
|
21
|
100
|
|
|
|
507
|
return ( keys %$wc ? [writeConcern => $wc] : [] ); |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub BUILD { |
112
|
199
|
|
|
199
|
0
|
270205
|
my ($self) = @_; |
113
|
199
|
100
|
|
|
|
859
|
if ( ! $self->_w_is_valid ) { |
114
|
1
|
|
|
|
|
14
|
MongoDB::UsageError->throw("can't use write concern w=" . $self->w ); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
198
|
100
|
100
|
|
|
773
|
if ( ! $self->_w_is_acknowledged && $self->j ) { |
118
|
3
|
|
|
|
|
45
|
MongoDB::UsageError->throw("can't use write concern w=0 with j=" . $self->j ); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# cant use nonnegnum earlier in type as errors explode with wrong class |
122
|
195
|
100
|
100
|
|
|
1464
|
if ( defined($self->wtimeout) && $self->wtimeout < 0 ) { |
123
|
1
|
|
|
|
|
6
|
MongoDB::UsageError->throw("wtimeout must be non negative"); |
124
|
|
|
|
|
|
|
} |
125
|
194
|
|
|
|
|
3979
|
return; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub _w_is_valid { |
129
|
199
|
|
|
199
|
|
535
|
my ($self) = @_; |
130
|
199
|
100
|
|
|
|
1301
|
return 1 if !defined $self->w; |
131
|
20
|
100
|
|
|
|
182
|
return looks_like_number( $self->w ) ? $self->w >= 0 : length $self->w; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub _w_is_acknowledged { |
135
|
198
|
|
|
198
|
|
1200
|
my ($self) = @_; |
136
|
198
|
100
|
|
|
|
1163
|
return 1 if !defined $self->w; |
137
|
19
|
100
|
|
|
|
139
|
return looks_like_number( $self->w ) ? $self->w > 0 : length $self->w; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
1; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
__END__ |