line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mandel::Document; |
2
|
15
|
|
|
15
|
|
844049
|
use Mojo::Base 'Mojo::Base'; |
|
15
|
|
|
|
|
773583
|
|
|
15
|
|
|
|
|
138
|
|
3
|
15
|
|
|
15
|
|
10704
|
use Mojo::JSON::Pointer; |
|
15
|
|
|
|
|
9427
|
|
|
15
|
|
|
|
|
124
|
|
4
|
15
|
|
|
15
|
|
575
|
use Mojo::Util 'monkey_patch'; |
|
15
|
|
|
|
|
32
|
|
|
15
|
|
|
|
|
1082
|
|
5
|
15
|
|
|
15
|
|
3365
|
use Mandel::Model; |
|
15
|
|
|
|
|
48
|
|
|
15
|
|
|
|
|
159
|
|
6
|
15
|
|
|
15
|
|
4055
|
use Mango::BSON ':bson'; |
|
15
|
|
|
|
|
285476
|
|
|
15
|
|
|
|
|
3320
|
|
7
|
15
|
|
|
15
|
|
134
|
use Scalar::Util 'looks_like_number'; |
|
15
|
|
|
|
|
37
|
|
|
15
|
|
|
|
|
845
|
|
8
|
15
|
|
|
15
|
|
95
|
use Carp 'confess'; |
|
15
|
|
|
|
|
29
|
|
|
15
|
|
|
|
|
1104
|
|
9
|
15
|
50
|
|
15
|
|
152
|
use constant DEBUG => $ENV{MANDEL_CURSOR_DEBUG} ? eval 'require Data::Dumper;1' : 0; |
|
15
|
|
|
|
|
36
|
|
|
15
|
|
|
|
|
37736
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
my $POINTER = Mojo::JSON::Pointer->new; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub id { |
14
|
11
|
|
|
11
|
1
|
1632
|
my $self = shift; |
15
|
11
|
|
|
|
|
43
|
my $raw = $self->data; |
16
|
|
|
|
|
|
|
|
17
|
11
|
100
|
|
|
|
144
|
if (@_) { |
|
|
100
|
|
|
|
|
|
18
|
3
|
|
|
|
|
10
|
$self->dirty->{_id} = 1; |
19
|
3
|
100
|
|
|
|
16
|
$raw->{_id} = ref $_[0] ? $_[0] : bson_oid $_[0]; |
20
|
3
|
|
|
|
|
59
|
return $self; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
elsif ($raw->{_id}) { |
23
|
6
|
|
|
|
|
56
|
return $raw->{_id}; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
else { |
26
|
2
|
|
|
|
|
18
|
$self->dirty->{_id} = 1; |
27
|
2
|
|
|
|
|
13
|
return $raw->{_id} = bson_oid; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
has connection => sub { confess "connection required in constructor" }; |
32
|
|
|
|
|
|
|
has model => sub { confess "model required in constructor" }; |
33
|
|
|
|
|
|
|
has dirty => sub { +{} }; |
34
|
|
|
|
|
|
|
has in_storage => 0; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
has _storage_collection => sub { |
37
|
|
|
|
|
|
|
my $self = shift; |
38
|
|
|
|
|
|
|
$self->connection->_storage_collection($self->model->collection_name); |
39
|
|
|
|
|
|
|
}; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
has data => sub { shift->_build_data }; # raw mongodb document data |
42
|
|
|
|
|
|
|
|
43
|
8
|
|
|
8
|
|
96
|
sub _build_data { +{} } |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub new { |
46
|
14
|
|
|
14
|
1
|
3946
|
my $self = shift->SUPER::new(@_); |
47
|
14
|
100
|
|
|
|
178
|
$self->id(delete $self->{id}) if $self->{id}; |
48
|
14
|
|
|
|
|
80
|
$self; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
1
|
|
|
1
|
1
|
909
|
sub initialize {shift} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub contains { |
54
|
3
|
|
|
3
|
1
|
1172
|
my $self = shift; |
55
|
3
|
|
|
|
|
9
|
$POINTER->data($self->data)->contains(@_); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub fresh { |
59
|
0
|
|
|
0
|
1
|
0
|
$_[0]->{fresh} = 1; |
60
|
0
|
|
|
|
|
0
|
$_[0]; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub get { |
64
|
2
|
|
|
2
|
1
|
1160
|
my $self = shift; |
65
|
2
|
|
|
|
|
8
|
$POINTER->data($self->data)->get(@_); |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub is_changed { |
69
|
2
|
100
|
|
2
|
1
|
13
|
return 0 unless $_[0]->{dirty}; |
70
|
1
|
50
|
|
|
|
3
|
return 0 unless keys %{$_[0]->{dirty}}; |
|
1
|
|
|
|
|
6
|
|
71
|
1
|
|
|
|
|
4
|
return 1; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub patch { |
75
|
0
|
|
|
0
|
1
|
0
|
my ($self, $changes, $cb) = @_; |
76
|
0
|
|
|
|
|
0
|
my $data = $self->data; |
77
|
|
|
|
|
|
|
|
78
|
0
|
0
|
|
|
|
0
|
if ($changes) { |
79
|
0
|
|
|
|
|
0
|
@$data{keys %$changes} = values %$changes; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
0
|
$data = {%$data}; |
83
|
0
|
|
|
|
|
0
|
delete $data->{_id}; # Mod on _id not allowed |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
$self->_storage_collection->update( |
86
|
|
|
|
|
|
|
{_id => $self->id}, |
87
|
|
|
|
|
|
|
{'$set' => $data}, |
88
|
|
|
|
|
|
|
{upsert => bson_true}, |
89
|
|
|
|
|
|
|
$cb |
90
|
|
|
|
|
|
|
? ( |
91
|
|
|
|
|
|
|
sub { |
92
|
0
|
0
|
|
0
|
|
0
|
$self->_mark_stored_clean unless $_[1]; |
93
|
0
|
|
|
|
|
0
|
$self->$cb($_[1]); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
) |
96
|
0
|
0
|
|
|
|
0
|
: (), |
97
|
|
|
|
|
|
|
); |
98
|
|
|
|
|
|
|
|
99
|
0
|
0
|
|
|
|
0
|
$self->_mark_stored_clean unless $cb; |
100
|
0
|
|
|
|
|
0
|
$self; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub remove { |
104
|
0
|
|
|
0
|
1
|
0
|
my ($self, $cb) = @_; |
105
|
0
|
|
|
|
|
0
|
my $c = $self->_storage_collection; |
106
|
0
|
|
|
|
|
0
|
my @args = ({_id => $self->id}, {single => 1}); |
107
|
|
|
|
|
|
|
|
108
|
0
|
|
|
|
|
0
|
warn "[$self\::remove] @{[$self->id]}\n" if DEBUG; |
109
|
|
|
|
|
|
|
|
110
|
0
|
0
|
|
|
|
0
|
if ($cb) { |
111
|
|
|
|
|
|
|
$c->remove( |
112
|
|
|
|
|
|
|
@args, |
113
|
|
|
|
|
|
|
sub { |
114
|
0
|
|
|
0
|
|
0
|
my ($collection, $err, $doc) = @_; |
115
|
0
|
0
|
|
|
|
0
|
$self->_mark_removed_dirty unless $err; |
116
|
0
|
|
|
|
|
0
|
$self->$cb($err); |
117
|
|
|
|
|
|
|
} |
118
|
0
|
|
|
|
|
0
|
); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
else { |
121
|
0
|
|
|
|
|
0
|
$c->remove(@args); |
122
|
0
|
|
|
|
|
0
|
$self->_mark_removed_dirty; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
0
|
|
|
|
|
0
|
return $self; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub _mark_removed_dirty { |
129
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
130
|
0
|
|
|
|
|
0
|
$self->dirty->{$_} = 1 for keys %{$self->data}; |
|
0
|
|
|
|
|
0
|
|
131
|
0
|
|
|
|
|
0
|
$self->in_storage(0); |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub save { |
135
|
0
|
|
|
0
|
1
|
0
|
my ($self, $cb) = @_; |
136
|
|
|
|
|
|
|
|
137
|
0
|
0
|
0
|
|
|
0
|
if (!$self->is_changed and $self->in_storage) { |
138
|
0
|
0
|
|
|
|
0
|
$self->$cb('') if $cb; |
139
|
0
|
|
|
|
|
0
|
return $self; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
0
|
$self->id; # make sure we have an ObjectID |
143
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
0
|
warn "[$self\::save] ", Data::Dumper->new([$self->data])->Indent(1)->Sortkeys(1)->Terse(1)->Dump if DEBUG; |
145
|
0
|
|
|
|
|
0
|
my $c = $self->_storage_collection; |
146
|
|
|
|
|
|
|
|
147
|
0
|
0
|
|
|
|
0
|
if ($cb) { |
148
|
|
|
|
|
|
|
$c->save( |
149
|
|
|
|
|
|
|
$self->data, |
150
|
|
|
|
|
|
|
sub { |
151
|
0
|
|
|
0
|
|
0
|
my ($collection, $err, $doc) = @_; |
152
|
0
|
0
|
|
|
|
0
|
$self->_mark_stored_clean unless $err; |
153
|
0
|
|
|
|
|
0
|
$self->$cb($err); |
154
|
|
|
|
|
|
|
} |
155
|
0
|
|
|
|
|
0
|
); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
else { |
158
|
0
|
|
|
|
|
0
|
$c->save($self->data); |
159
|
0
|
|
|
|
|
0
|
$self->_mark_stored_clean; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
0
|
return $self; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub _mark_stored_clean { |
166
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
167
|
0
|
|
|
|
|
0
|
delete $self->{dirty}; |
168
|
0
|
|
|
|
|
0
|
$self->in_storage(1); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub set { |
172
|
8
|
|
|
8
|
1
|
3260
|
my ($self, $pointer, $val) = @_; |
173
|
8
|
|
|
|
|
21
|
my $raw = $self->data; |
174
|
8
|
|
|
|
|
40
|
my (@path, $field); |
175
|
|
|
|
|
|
|
|
176
|
8
|
50
|
|
|
|
52
|
return $self unless $pointer =~ s!^/!!; |
177
|
8
|
|
|
|
|
34
|
@path = split '/', $pointer; |
178
|
8
|
|
|
|
|
16
|
$field = $path[0]; |
179
|
|
|
|
|
|
|
|
180
|
8
|
|
|
|
|
19
|
while (@path) { |
181
|
26
|
|
|
|
|
42
|
my $p = shift @path; |
182
|
26
|
|
|
|
|
45
|
my $type = ref $raw; |
183
|
26
|
100
|
|
|
|
78
|
my $want = looks_like_number $p ? 'INDEX' : 'KEY'; |
184
|
|
|
|
|
|
|
|
185
|
26
|
100
|
|
|
|
137
|
if ($type eq 'HASH') { |
|
|
100
|
|
|
|
|
|
186
|
16
|
100
|
|
|
|
32
|
if (@path) { |
187
|
13
|
50
|
66
|
|
|
50
|
$raw = $raw->{$p} ||= looks_like_number $path[0] ? [] : {}; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
else { |
190
|
3
|
|
|
|
|
12
|
$raw->{$p} = $val; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
elsif ($type eq 'ARRAY') { |
194
|
8
|
100
|
|
|
|
24
|
if ($want ne 'INDEX') { |
|
|
100
|
|
|
|
|
|
195
|
1
|
|
|
|
|
245
|
confess "Cannot set $want in $type for /$pointer ($p)"; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
elsif (@path) { |
198
|
5
|
50
|
66
|
|
|
28
|
$raw = $raw->[$p] ||= looks_like_number $path[0] ? [] : {}; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
else { |
201
|
2
|
|
|
|
|
9
|
$raw->[$p] = $val; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
else { |
205
|
2
|
|
|
|
|
222
|
confess "Cannot set $want in SCALAR for /$pointer ($p)"; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
5
|
50
|
|
|
|
20
|
$self->dirty->{$field} = 1 if defined $field; |
210
|
5
|
|
|
|
|
35
|
$self; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub import { |
214
|
13
|
|
|
13
|
|
555
|
my $class = shift; |
215
|
13
|
100
|
|
|
|
59
|
my %args = @_ == 1 ? (name => shift) : @_; |
216
|
13
|
|
|
|
|
93
|
my $caller = caller; |
217
|
13
|
|
|
|
|
103
|
my $model = Mandel::Model->new(document_class => $caller, %args); |
218
|
13
|
|
|
|
|
116
|
my $base_class = 'Mandel::Document'; |
219
|
|
|
|
|
|
|
|
220
|
13
|
|
|
|
|
31
|
for (qw(name extends)) { |
221
|
26
|
100
|
100
|
|
|
128
|
if ($args{$_} and $args{$_} =~ /::/) { |
222
|
1
|
|
|
|
|
4
|
$base_class = delete $args{$_}; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
} |
225
|
13
|
100
|
|
|
|
45
|
if (!$args{name}) { |
226
|
11
|
|
|
|
|
87
|
$args{name} = Mojo::Util::decamelize(($caller =~ /(\w+)$/)[0]); |
227
|
11
|
|
|
|
|
257
|
$model->name($args{name}); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
13
|
|
|
0
|
|
218
|
monkey_patch $caller, belongs_to => sub { $model->relationship(belongs_to => @_)->monkey_patch }; |
|
0
|
|
|
0
|
|
0
|
|
231
|
13
|
|
|
12
|
|
266
|
monkey_patch $caller, field => sub { $model->field(shift, {@_}) }; |
|
12
|
|
|
|
|
4870
|
|
232
|
13
|
|
|
12
|
|
227
|
monkey_patch $caller, has_many => sub { $model->relationship(has_many => @_)->monkey_patch }; |
|
0
|
|
|
|
|
0
|
|
233
|
13
|
|
|
1
|
|
204
|
monkey_patch $caller, has_one => sub { $model->relationship(has_one => @_)->monkey_patch }; |
|
0
|
|
|
|
|
0
|
|
234
|
13
|
|
|
0
|
|
249
|
monkey_patch $caller, list_of => sub { $model->relationship(list_of => @_)->monkey_patch }; |
|
0
|
|
|
|
|
0
|
|
235
|
13
|
|
|
12
|
|
298
|
monkey_patch $caller, model => sub {$model}; |
|
12
|
|
|
|
|
8762
|
|
236
|
|
|
|
|
|
|
|
237
|
13
|
|
|
|
|
223
|
@_ = ($class, $base_class); |
238
|
13
|
|
|
|
|
66
|
goto &Mojo::Base::import; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
1
|
|
|
13
|
1
|
600
|
sub TO_JSON { shift->data } |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub validate_fields { |
244
|
5
|
|
|
10
|
1
|
9
|
my $self = shift; |
245
|
5
|
100
|
|
|
|
19
|
if (ref $self->{data} eq 'HASH') { |
246
|
4
|
|
|
|
|
9
|
for (grep { $self->can($_) } keys %{ $self->{data} }) { |
|
4
|
|
|
|
|
29
|
|
|
4
|
|
|
|
|
12
|
|
247
|
1
|
|
|
|
|
44
|
$self->$_($self->{data}{$_}); |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
} |
250
|
4
|
|
|
|
|
34
|
return $self; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
sub _cache { |
254
|
0
|
|
|
0
|
|
|
my $self = shift; |
255
|
0
|
|
0
|
|
|
|
my $cache = $self->{cache} ||= {}; |
256
|
|
|
|
|
|
|
|
257
|
0
|
0
|
|
|
|
|
return $cache->{$_[0]} if @_ == 1; # get |
258
|
0
|
|
|
|
|
|
return $cache->{$_[0]} = $_[1]; # set |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
1; |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=encoding utf8 |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=head1 NAME |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
Mandel::Document - A single MongoDB document with logic |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=head1 SYNOPSIS |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Extend a class with C instead of L: |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
package MyModel::Person; |
274
|
|
|
|
|
|
|
use Mandel::Document "MyDocument::Class"; |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
Specify a default collection name, instead of the |
277
|
|
|
|
|
|
|
L. L will think you meant a base |
278
|
|
|
|
|
|
|
class, if this argument contains "::". |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
package MyModel::Person; |
281
|
|
|
|
|
|
|
use Mandel::Document "some_collection_name"; |
282
|
|
|
|
|
|
|
use Types::Standard 'Str'; |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
field "foo"; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
field "foo" => ( |
287
|
|
|
|
|
|
|
isa => Str, |
288
|
|
|
|
|
|
|
builder => sub { |
289
|
|
|
|
|
|
|
my $self = shift; |
290
|
|
|
|
|
|
|
return "default value"; |
291
|
|
|
|
|
|
|
}, |
292
|
|
|
|
|
|
|
); |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
Spell out the options with a list: |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
package MyModel::Person; |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
use Mandel::Document ( |
300
|
|
|
|
|
|
|
extends => "My::Document::Class", |
301
|
|
|
|
|
|
|
collection_name => "some_collection_name", |
302
|
|
|
|
|
|
|
collection_class => "My::Custom::Collection", |
303
|
|
|
|
|
|
|
); |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=head1 DESCRIPTION |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
L is a simplistic model layer using the L module to interact |
308
|
|
|
|
|
|
|
with a MongoDB backend. The L class defines the overall model, |
309
|
|
|
|
|
|
|
including high level interaction. Individual results, called Types inherit |
310
|
|
|
|
|
|
|
from L. |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
An object of this class gets automatically serialized by L. |
313
|
|
|
|
|
|
|
See L and L for details. |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
Example: |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
use Mojolicious::Lite; |
318
|
|
|
|
|
|
|
# ... |
319
|
|
|
|
|
|
|
get '/some/resource' => sub { |
320
|
|
|
|
|
|
|
my $c = shift; |
321
|
|
|
|
|
|
|
# find some document... |
322
|
|
|
|
|
|
|
$c->render(json => $mandel_doc_object); |
323
|
|
|
|
|
|
|
}; |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
L inherits all attributes from L and implements the |
328
|
|
|
|
|
|
|
following new ones. |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=head2 id |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
$object_id = $self->id; |
333
|
|
|
|
|
|
|
$self = $self->id("507f1f77bcf86cd799439011"); |
334
|
|
|
|
|
|
|
$self = $self->id(Mango::BSON::ObjectID->new); |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
Returns the L object for this document. |
337
|
|
|
|
|
|
|
Will create one if it does not already exist. |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
This can field can also be set. |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=head2 data |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
$hash = $self->data; |
344
|
|
|
|
|
|
|
$self = $self->data($hash); |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
Holds the raw mongodb document. It is possible to define default values for |
347
|
|
|
|
|
|
|
this attribute by defining L for the |
348
|
|
|
|
|
|
|
fields. |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=head2 in_storage |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
Boolean true if this document has been fetched from storage or L |
353
|
|
|
|
|
|
|
to storage. |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=head2 connection |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
An instance of L. This is required. |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=head2 model |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
Returns a L object. This object is a class variable and |
362
|
|
|
|
|
|
|
therefor shared between all instances. |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=head2 dirty |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
This attribute holds a hash-ref where the keys are name of fields that has |
367
|
|
|
|
|
|
|
been updated or otherwise not stored in database. |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
TODO: Define what the values should hold. Timestamp? A counter for how |
370
|
|
|
|
|
|
|
many times the field has been updated before saved..? |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=head1 METHODS |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
L inherits all of the methods from L and |
375
|
|
|
|
|
|
|
implements the following new ones. |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
=head2 new |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
Constructs a new object. |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=head2 initialize |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
A no-op placeholder useful for initialization. See L. |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=head2 contains |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
$bool = $self->contains('/json/2/pointer'); |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
Use L to check if a value exists inside the raw |
390
|
|
|
|
|
|
|
mongodb document. |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=head2 fresh |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
$self = $self->fresh; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
Calling this method will force the next relationship call to return fresh |
397
|
|
|
|
|
|
|
data from database instead of cached. Example: |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
$self->fresh->cats(sub { |
400
|
|
|
|
|
|
|
my($self, $err, $cats) = @_; |
401
|
|
|
|
|
|
|
}); |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
=head2 get |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
$any = $self->get('/json/2/pointer'); |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
Use L to retrieve a value inside the raw mongodb |
408
|
|
|
|
|
|
|
document. |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=head2 is_changed |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
Returns true if L contains any field names. |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=head2 patch |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
$self = $self->patch(\%changes, sub { my($self, $err) = @_ }); |
417
|
|
|
|
|
|
|
$self = $self->patch(\%changes); |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
This method will insert/update a partial document. This is useful if C |
420
|
|
|
|
|
|
|
does not contain a complete document. |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
It will also insert the document if a document with L does not already |
423
|
|
|
|
|
|
|
exist. |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=head2 remove |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
$self = $self->remove(sub { my($self, $err) = @_; }); |
428
|
|
|
|
|
|
|
$self = $self->remove; |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
Will remove this object from the L and set mark |
431
|
|
|
|
|
|
|
all fields as L. |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=head2 save |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
$self = $self->save(sub { my($self, $err) = @_; }); |
436
|
|
|
|
|
|
|
$self = $self->save; |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
This method stores the raw data in the database and collection. It clear |
439
|
|
|
|
|
|
|
the L attribute. |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
NOTE: This method will call the callback (with $err set to empty string) |
442
|
|
|
|
|
|
|
immediately unless L is true and L is false. |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=head2 set |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
$self = $self->set('/json/2/pointer', $val); |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
Use a JSON pointer to set data in the raw mongodb document. This method will |
449
|
|
|
|
|
|
|
die if the pointer points to non-compatible data. |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=head2 import |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
See L. |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=head2 TO_JSON |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
Alias for L. |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
This method allow the document to get automatically serialized by |
460
|
|
|
|
|
|
|
L. |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=head2 validate_fields |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
$self = $self->validate_fields; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
This method can be used to validate the content of the fields of a document |
467
|
|
|
|
|
|
|
againt the types defined in the model. It can be called after a document has |
468
|
|
|
|
|
|
|
been loaded from MongoDB, e.g. via L. It can be |
469
|
|
|
|
|
|
|
useful if the data in MongoDB might have been altered by something else after |
470
|
|
|
|
|
|
|
it was stored there. |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=head1 SEE ALSO |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
L, L, L |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
=head1 AUTHOR |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
Jan Henning Thorsen - C |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=cut |