line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Class::ReluctantORM::Relationship::HasLazy; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Class::ReluctantORM::Relationship::HasLazy |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 SYNOPSIS |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# Declare a column to be lazy |
10
|
|
|
|
|
|
|
Pirate->has_lazy('diary'); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# Now you have: |
13
|
|
|
|
|
|
|
$pirate = Pirate->fetch_with_diary($pirate_id); |
14
|
|
|
|
|
|
|
@bipeds = Pirate->fetch_by_leg_count_with_diary(2); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# Get info about the relationship |
17
|
|
|
|
|
|
|
$rel = Pirate->relationships('diary'); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
$str = $rel->type(); # 'has_lazy'; |
20
|
|
|
|
|
|
|
$str = $rel->linked_class(); # undef; |
21
|
|
|
|
|
|
|
$str = $rel->linking_class(); # 'Pirate'; |
22
|
|
|
|
|
|
|
@fields = $rel->local_key_fields(); # field in Pirate that is lazy-loaded |
23
|
|
|
|
|
|
|
# by this relationship, always one |
24
|
|
|
|
|
|
|
@fields = $rel->remote_key_fields(); # empty list |
25
|
|
|
|
|
|
|
$int = $rel->join_depth(); # 0 |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# Class::ReluctantORM::SQL integration |
28
|
|
|
|
|
|
|
@sql_cols = $rel->additional_output_sql_columns(); |
29
|
|
|
|
|
|
|
@cols = $rel->local_key_sql_columns(); |
30
|
|
|
|
|
|
|
@cols = $rel->remote_key_sql_columns(); # empty list |
31
|
|
|
|
|
|
|
@empty = $rel->join_local_key_sql_columns(); # always empty for HasLazy |
32
|
|
|
|
|
|
|
@empty = $rel->join_remote_key_sql_columns(); # always empty for HasLazy |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 DESCRIPTION |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
The HasLazy relationship permits a class to be loaded from the database without loading all of its columns. If a field is declared has_lazy, the column will not be fetched from the database unless it is explicitly mentioned in a fetch_deep 'with' clause. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
Unlike other relationships, HasLazy does not link to another CRO class. Nor does it require a remote table, as it draws its data from the base table. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
HasLazy relationships do not have inverse relationships. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 BUILD_CLASS INTEGRATION |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
HasLazy also provides integration via the build_class method of Class::ReluctantORM. This is merely for convenience; behind the scenes, has_lazy will be called for you. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head2 MyClass->build_class(%other_opts, %lazy_opts); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
By providing either of these two options, you can automatically set up many Lazy columns quickly. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=over |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=item lazy_fields |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
Optional array ref. List of fields that should be made Lazy. Mutually exclusive with non_lazy_fields. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=item non_lazy_fields |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
Optional array ref. If provided, ALL fields are assumed to be lazy, EXCEPT those listed here and primary and foreign keys. Mutually exclusive with non_lazy_fields. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=back |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=cut |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# Integration provided in Class::ReluctantORM |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head2 $class->has_lazy('field_name'); |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
Indicates that the given field should be lazy-loaded, meaning that is not automatically fetched during a regular fetch. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
You can cause the field to be fetched by using fetch_deep or calling $obj->fetch_FIELD(). |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
The field will not appear on the 'essential_fields' list, but it will appear on the 'field_names' list. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Note that the value passed to has_lazy is a field name, not a column name; for some classes, they may be different. This is configured by passing a hashref as the value of the 'fields' option to build_class. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
The accessor/mutator will behave similarly to a HasOne accessor, in that it will die on access if the value has not been fetched. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=cut |
81
|
|
|
|
|
|
|
|
82
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
30
|
|
83
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
21
|
|
84
|
|
|
|
|
|
|
|
85
|
1
|
|
|
1
|
|
4
|
use Data::Dumper; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
60
|
|
86
|
1
|
|
|
1
|
|
6
|
use Class::ReluctantORM::Utilities qw(install_method conditional_load array_shallow_eq check_args); |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
55
|
|
87
|
1
|
|
|
1
|
|
5
|
use Class::ReluctantORM::Exception; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
44
|
|
88
|
|
|
|
|
|
|
our $DEBUG ||= 0; |
89
|
|
|
|
|
|
|
|
90
|
1
|
|
|
1
|
|
4
|
use base 'Class::ReluctantORM::Relationship'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
1591
|
|
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub _initialize { |
93
|
1
|
|
|
1
|
|
2
|
my $class = shift; |
94
|
1
|
|
|
0
|
|
12
|
install_method('Class::ReluctantORM::Relationship', 'is_has_lazy', sub { return 0; }); |
|
0
|
|
|
0
|
|
0
|
|
95
|
1
|
|
|
|
|
6
|
install_method('Class::ReluctantORM', 'has_lazy', \&__setup_has_lazy); |
96
|
1
|
|
|
|
|
5
|
install_method('Class::ReluctantORM', 'is_field_has_lazy', \&is_field_has_lazy); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head2 $str = $rel->type(); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Returns 'has_lazy'. |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=cut |
104
|
|
|
|
|
|
|
|
105
|
0
|
|
|
0
|
1
|
|
sub type { return 'has_lazy'; } |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=head2 $bool = $rel->is_has_lazy(); |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
Returns true. |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=cut |
112
|
|
|
|
|
|
|
|
113
|
0
|
|
|
0
|
1
|
|
sub is_has_lazy { return 1; } |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=head2 $int = $rel->join_depth(); |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
Returns 0. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=cut |
120
|
|
|
|
|
|
|
|
121
|
0
|
|
|
0
|
1
|
|
sub join_depth { return 0; } |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=head2 $str = $rel->join_type(); |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
Returns 'NONE' |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=cut |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=head2 $int = $rel->lower_multiplicity() |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
Returns 0. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=cut |
134
|
|
|
|
|
|
|
|
135
|
0
|
|
|
0
|
1
|
|
sub lower_multiplicity { return 0; } |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head2 $int = $rel->upper_multiplicity() |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
Returns 0 - this is a relationship that doesn't link to another table. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=cut |
142
|
|
|
|
|
|
|
|
143
|
0
|
|
|
0
|
1
|
|
sub upper_multiplicity { return 0; } |
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
0
|
1
|
|
sub join_type { return 'NONE'; } |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=begin devdocs |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
Not sure this is public.... or if that calling pattern is right. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=head2 $bool = $cro_obj->is_field_has_lazy('field'); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Returns true if the given field is a HasLazy field. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=cut |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub is_field_has_lazy { |
158
|
0
|
|
|
0
|
|
|
my $inv = shift; |
159
|
0
|
|
|
|
|
|
my $field = shift; |
160
|
0
|
0
|
|
|
|
|
my $tb_class = ref($inv) ? ref($inv) : $inv; |
161
|
0
|
|
|
|
|
|
my $rel = $tb_class->relationships($field); |
162
|
0
|
0
|
|
|
|
|
return $rel ? $rel->is_has_lazy() : undef; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=head2 @cols = $rel->additional_output_sql_columns(); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
Returns a list of exactly one column, the column to lazy-loaded. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=cut |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub additional_output_sql_columns { |
172
|
0
|
|
|
0
|
1
|
|
my $rel = shift; |
173
|
0
|
|
|
|
|
|
return $rel->local_key_sql_columns(); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=begin devnotes |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
In order to use a Collection, while appearing not to, |
179
|
|
|
|
|
|
|
we will actually use a secondary field to store the |
180
|
|
|
|
|
|
|
collection. |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=cut |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub __setup_has_lazy { |
185
|
0
|
|
|
0
|
|
|
my $cro_base_class = shift; |
186
|
0
|
0
|
|
|
|
|
if (@_ < 1) { |
|
|
0
|
|
|
|
|
|
187
|
0
|
|
|
|
|
|
Class::ReluctantORM::Exception::Param::Missing->croak(param => 'field_name'); |
188
|
|
|
|
|
|
|
} elsif (@_ > 1) { |
189
|
0
|
|
|
|
|
|
Class::ReluctantORM::Exception::Param::Spurious->croak(error => 'has_lazy expects exactly one arg, the field name'); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
|
my $lazy_field = shift; |
193
|
0
|
|
|
|
|
|
my $lazy_column = $cro_base_class->column_name($lazy_field); |
194
|
0
|
0
|
|
|
|
|
unless ($lazy_column) { |
195
|
0
|
|
|
|
|
|
Class::ReluctantORM::Exception::Param::BadValue->croak(param => 'field_name', error => "Could not find a column for field '$lazy_field' in class '$cro_base_class'"); |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
# Immediate registration - no need to wait, as we don't depend on a nother class |
199
|
0
|
|
|
|
|
|
my $rel = Class::ReluctantORM::Relationship::HasLazy->new(); |
200
|
0
|
|
|
|
|
|
$rel->method_name($lazy_field); |
201
|
0
|
|
|
|
|
|
$rel->linked_class(undef); |
202
|
0
|
|
|
|
|
|
$rel->linking_class($cro_base_class); |
203
|
|
|
|
|
|
|
|
204
|
0
|
|
|
|
|
|
$rel->local_key_fields($lazy_field); |
205
|
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
|
install_method($cro_base_class, $rel->method_name, $rel->__make_has_lazy_accessor(), 1); # be sure to clobber here |
207
|
0
|
|
|
|
|
|
install_method($cro_base_class, 'fetch_' . $rel->method_name, $rel->__make_has_lazy_fetch_accessor()); |
208
|
0
|
|
|
|
|
|
$rel->_install_search_by_with_methods(); |
209
|
|
|
|
|
|
|
|
210
|
0
|
|
|
|
|
|
$rel->_original_args_arrayref([$lazy_field]); |
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
|
$cro_base_class->register_relationship($rel); |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# Implements $pirate->diary(); |
217
|
|
|
|
|
|
|
sub __make_has_lazy_accessor { |
218
|
0
|
|
|
0
|
|
|
my $rel = shift; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# Setup accessor |
221
|
|
|
|
|
|
|
my $code = sub { |
222
|
0
|
|
|
0
|
|
|
my $cro_obj = shift; |
223
|
0
|
|
|
|
|
|
my $lazy_field = $rel->method_name(); |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# Fetch the underlying collection |
226
|
0
|
|
|
|
|
|
my $collection_slot = '_' . $rel->method_name . '_coll'; |
227
|
0
|
|
|
|
|
|
my $collection = $cro_obj->get($collection_slot); |
228
|
0
|
0
|
|
|
|
|
unless (defined $collection) { |
229
|
0
|
|
|
|
|
|
$collection = Class::ReluctantORM::Collection::Lazy->_new( |
230
|
|
|
|
|
|
|
relationship => $rel, |
231
|
|
|
|
|
|
|
linking_object => $cro_obj |
232
|
|
|
|
|
|
|
); |
233
|
0
|
|
|
|
|
|
$cro_obj->set($collection_slot, $collection); |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
0
|
0
|
|
|
|
|
if (@_) { |
237
|
|
|
|
|
|
|
# Acting as mutator |
238
|
0
|
|
|
|
|
|
my $raw_value = shift; |
239
|
|
|
|
|
|
|
|
240
|
0
|
0
|
|
|
|
|
if (defined $raw_value) { |
241
|
0
|
|
|
|
|
|
my $cooked_value = $cro_obj->__apply_field_write_filters($lazy_field, $raw_value); |
242
|
0
|
0
|
|
|
|
|
if (ref($cooked_value)) { |
243
|
0
|
|
|
|
|
|
Class::ReluctantORM::Exception::Param::WrongType->croak( |
244
|
|
|
|
|
|
|
param => 'value', |
245
|
|
|
|
|
|
|
expected => 'plain scalar', |
246
|
|
|
|
|
|
|
error => 'Can only store plain scalar values in HasLazy fields', |
247
|
|
|
|
|
|
|
value => $cooked_value, |
248
|
|
|
|
|
|
|
); |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
# Set the collection contents |
251
|
0
|
|
|
|
|
|
$collection->_set_single_value($cooked_value); |
252
|
|
|
|
|
|
|
} else { |
253
|
|
|
|
|
|
|
# Set the collection to be fetched but empty |
254
|
0
|
|
|
|
|
|
$collection->_set_empty_but_populated(); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
0
|
|
|
|
|
|
$cro_obj->_mark_field_dirty($lazy_field); |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
0
|
0
|
|
|
|
|
if ($collection->is_populated) { |
261
|
0
|
|
|
|
|
|
my $raw_value = $collection->first(); |
262
|
0
|
|
|
|
|
|
my $cooked_value = $cro_obj->__apply_field_read_filters($lazy_field, $raw_value); |
263
|
0
|
|
|
|
|
|
return $cooked_value; |
264
|
|
|
|
|
|
|
} else { |
265
|
0
|
|
|
|
|
|
Class::ReluctantORM::Exception::Data::FetchRequired->croak |
266
|
|
|
|
|
|
|
( |
267
|
|
|
|
|
|
|
called => $rel->method_name, |
268
|
|
|
|
|
|
|
call_instead => 'fetch_' . $rel->method_name, |
269
|
|
|
|
|
|
|
fetch_locations => [ $cro_obj->all_origin_traces ], |
270
|
|
|
|
|
|
|
); |
271
|
|
|
|
|
|
|
} |
272
|
0
|
|
|
|
|
|
}; |
273
|
0
|
|
|
|
|
|
return $code; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# Implements $pirate->fetch_diary(); |
278
|
|
|
|
|
|
|
sub __make_has_lazy_fetch_accessor { |
279
|
0
|
|
|
0
|
|
|
my $rel = shift; |
280
|
|
|
|
|
|
|
# Setup accessor |
281
|
|
|
|
|
|
|
my $code = sub { |
282
|
0
|
|
|
0
|
|
|
my $cro_obj = shift; |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# Fetch the underlying collection |
285
|
0
|
|
|
|
|
|
my $collection_slot = '_' . $rel->method_name . '_coll'; |
286
|
0
|
|
|
|
|
|
my $collection = $cro_obj->get($collection_slot); |
287
|
0
|
0
|
|
|
|
|
unless (defined $collection) { |
288
|
0
|
|
|
|
|
|
$collection = Class::ReluctantORM::Collection::Lazy->_new( |
289
|
|
|
|
|
|
|
relationship => $rel, |
290
|
|
|
|
|
|
|
linking_object => $cro_obj |
291
|
|
|
|
|
|
|
); |
292
|
0
|
|
|
|
|
|
$cro_obj->set($collection_slot, $collection); |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
0
|
|
|
|
|
|
$collection->depopulate; |
296
|
0
|
|
|
|
|
|
$collection->fetch_all(); |
297
|
0
|
|
|
|
|
|
return $collection->first; |
298
|
0
|
|
|
|
|
|
}; |
299
|
0
|
|
|
|
|
|
return $code; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub _raw_mutator { |
303
|
0
|
|
|
0
|
|
|
my $rel = shift; |
304
|
0
|
|
|
|
|
|
my $cro_obj = shift; |
305
|
0
|
|
|
|
|
|
my @newval = @_; |
306
|
|
|
|
|
|
|
|
307
|
0
|
|
|
|
|
|
my $lazy_field = $rel->method_name(); |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
# Fetch the underlying collection |
310
|
0
|
|
|
|
|
|
my $collection_slot = '_' . $rel->method_name . '_coll'; |
311
|
0
|
|
|
|
|
|
my $collection = $cro_obj->get($collection_slot); |
312
|
0
|
0
|
|
|
|
|
unless (defined $collection) { |
313
|
0
|
|
|
|
|
|
$collection = Class::ReluctantORM::Collection::Lazy->_new( |
314
|
|
|
|
|
|
|
relationship => $rel, |
315
|
|
|
|
|
|
|
linking_object => $cro_obj |
316
|
|
|
|
|
|
|
); |
317
|
0
|
|
|
|
|
|
$cro_obj->set($collection_slot, $collection); |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
0
|
0
|
|
|
|
|
if (@newval) { |
321
|
|
|
|
|
|
|
# Set the collection contents |
322
|
0
|
|
|
|
|
|
my $newval = $newval[0]; # Only allows one |
323
|
|
|
|
|
|
|
|
324
|
0
|
0
|
|
|
|
|
if (defined ($newval)) { |
325
|
0
|
|
|
|
|
|
$collection->_set_single_value($newval); |
326
|
|
|
|
|
|
|
} else { |
327
|
|
|
|
|
|
|
# Set the collection to be fetched but empty |
328
|
0
|
|
|
|
|
|
$collection->_set_empty_but_populated(); |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
|
331
|
0
|
|
|
|
|
|
$cro_obj->_mark_field_dirty($lazy_field); |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
0
|
0
|
|
|
|
|
if ($collection->is_populated) { |
335
|
0
|
|
|
|
|
|
my $raw_value = $collection->first(); |
336
|
0
|
|
|
|
|
|
return $raw_value; |
337
|
|
|
|
|
|
|
} else { |
338
|
0
|
|
|
|
|
|
Class::ReluctantORM::Exception::Data::FetchRequired->croak |
339
|
|
|
|
|
|
|
( |
340
|
|
|
|
|
|
|
called => $rel->method_name, |
341
|
|
|
|
|
|
|
call_instead => 'fetch_' . $rel->method_name, |
342
|
|
|
|
|
|
|
fetch_locations => [ $cro_obj->all_origin_traces ], |
343
|
|
|
|
|
|
|
); |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
# Called from ReluctantORM::new() |
349
|
|
|
|
|
|
|
sub _handle_implicit_new { |
350
|
0
|
|
|
0
|
|
|
my $rel = shift; |
351
|
0
|
|
|
|
|
|
my $cro_object = shift; |
352
|
0
|
|
|
|
|
|
my $new_args = shift; |
353
|
|
|
|
|
|
|
|
354
|
0
|
|
|
|
|
|
my $lazy_field = $rel->method_name(); |
355
|
|
|
|
|
|
|
|
356
|
0
|
0
|
|
|
|
|
unless (exists $new_args->{$lazy_field}) { |
357
|
0
|
|
|
|
|
|
return; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
0
|
|
|
|
|
|
my $value = $new_args->{$lazy_field}; |
361
|
0
|
0
|
|
|
|
|
if (ref($value) eq 'ARRAY') { |
362
|
|
|
|
|
|
|
# Fetch_deep will build things passing children in array refs - unpack it |
363
|
0
|
|
|
|
|
|
$value = $value->[0]; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# Rely on mutator to set it |
367
|
0
|
|
|
|
|
|
$cro_object->$lazy_field($value); |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
# Do nothing - handle_implicit_new did everything we needed to do |
371
|
0
|
|
|
0
|
|
|
sub _handle_implicit_create { } |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=head2 $bool = $rel->is_populated_in_object($cro_obj); |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
Returns true if the CRO object has had this relationship fetched. |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
=cut |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
sub is_populated_in_object { |
380
|
0
|
|
|
0
|
1
|
|
my $rel = shift; |
381
|
0
|
|
|
|
|
|
my $cro_obj = shift; |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
# Obtain the underlying collection |
384
|
0
|
|
|
|
|
|
my $collection_slot = '_' . $rel->method_name . '_coll'; |
385
|
0
|
|
|
|
|
|
my $collection = $cro_obj->get($collection_slot); |
386
|
0
|
0
|
|
|
|
|
unless ($collection) { |
387
|
0
|
|
|
|
|
|
return 0; |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
0
|
|
|
|
|
|
return $collection->is_populated(); |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
0
|
|
|
0
|
|
|
sub _notify_key_change_on_linking_object { |
394
|
|
|
|
|
|
|
# We don't care, we have no keys |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub _mark_unpopulated_in_object { |
400
|
0
|
|
|
0
|
|
|
my $rel = shift; |
401
|
0
|
|
|
|
|
|
my $cro_obj = shift; |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
# Obtain the underlying collection |
404
|
0
|
|
|
|
|
|
my $collection_slot = '_' . $rel->method_name . '_coll'; |
405
|
0
|
|
|
|
|
|
my $collection = $cro_obj->get($collection_slot); |
406
|
0
|
0
|
|
|
|
|
unless ($collection) { return; } |
|
0
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
|
408
|
0
|
|
|
|
|
|
$collection->depopulate(); |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
# sub merge_children { |
414
|
|
|
|
|
|
|
# my $rel = shift; |
415
|
|
|
|
|
|
|
# my $cro_obj = shift; |
416
|
|
|
|
|
|
|
# my $children_ref = shift; |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
# # Nothing to do if shild ren is undef |
419
|
|
|
|
|
|
|
# return unless (defined $children_ref); |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
# # Has one should only ever get one child, derp |
422
|
|
|
|
|
|
|
# my $new_child = $children_ref->[0]; |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
# my $relname = $rel->name(); |
425
|
|
|
|
|
|
|
# my $existing_child = $cro_obj->$relname; # We know this is populated |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
# if ($new_child->id eq $existing_child->id()) { |
428
|
|
|
|
|
|
|
# # Recurse into fetched relations and merge? |
429
|
|
|
|
|
|
|
# foreach my $child_rel ($existing_child->relationships) { |
430
|
|
|
|
|
|
|
# my $child_rel_name = $child_rel->name(); |
431
|
|
|
|
|
|
|
# if ($existing_child->is_fetched($child_rel_name)) { |
432
|
|
|
|
|
|
|
# if ($new_child->is_fetched($child_rel_name)) { |
433
|
|
|
|
|
|
|
# $child_rel->merge_children($existing_child, [ $new_child->$child_rel_name ]); |
434
|
|
|
|
|
|
|
# } |
435
|
|
|
|
|
|
|
# } elsif ($new_child->is_fetched($child_rel_name)) { |
436
|
|
|
|
|
|
|
# $child_rel->handle_implicit_new($existing_child, [ $new_child->$child_rel_name ]); |
437
|
|
|
|
|
|
|
# } |
438
|
|
|
|
|
|
|
# } |
439
|
|
|
|
|
|
|
# } else { |
440
|
|
|
|
|
|
|
# # new_child is fresh from the DB, while existing_child is in ram |
441
|
|
|
|
|
|
|
# # Which is more correct to keep? |
442
|
|
|
|
|
|
|
# # I'd say keep the existing one, since it may have been messed with |
443
|
|
|
|
|
|
|
# # So, nothing to do? But what if the fetch deep maps were different? |
444
|
|
|
|
|
|
|
# Class::ReluctantORM::Exception::NotImplemented->croak("Cannot merge kids, ids don't match"); |
445
|
|
|
|
|
|
|
# } |
446
|
|
|
|
|
|
|
# } |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
1; |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
#=============================================================================# |
453
|
|
|
|
|
|
|
#=============================================================================# |
454
|
|
|
|
|
|
|
# Collection Subclass |
455
|
|
|
|
|
|
|
#=============================================================================# |
456
|
|
|
|
|
|
|
#=============================================================================# |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
package Class::ReluctantORM::Collection::Lazy; |
459
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
33
|
|
460
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
27
|
|
461
|
|
|
|
|
|
|
|
462
|
1
|
|
|
1
|
|
11
|
use Data::Dumper; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
55
|
|
463
|
1
|
|
|
1
|
|
6
|
use base 'Class::ReluctantORM::Collection'; |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
681
|
|
464
|
1
|
|
|
1
|
|
11
|
use Class::ReluctantORM::SQL::Aliases; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
160
|
|
465
|
1
|
|
|
1
|
|
7
|
use Scalar::Util qw(weaken); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1004
|
|
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
our $DEBUG = 0; |
468
|
|
|
|
|
|
|
|
469
|
0
|
|
|
0
|
|
|
sub rel { return shift->{relationship}; } |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
sub _new { |
472
|
0
|
|
|
0
|
|
|
my ($class, %args) = @_; |
473
|
0
|
|
|
|
|
|
foreach my $f (qw(relationship linking_object)) { |
474
|
0
|
0
|
|
|
|
|
unless (exists $args{$f}) { Class::ReluctantORM::Exception::Param::Missing->croak(param => $f); } |
|
0
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
0
|
|
|
|
|
|
my $self = bless \%args, $class; |
478
|
0
|
|
|
|
|
|
weaken($self->{linking_object}); |
479
|
|
|
|
|
|
|
|
480
|
0
|
0
|
|
|
|
|
if ($args{children}) { |
481
|
0
|
|
|
|
|
|
$self->{_children} = $args{children}; |
482
|
0
|
|
|
|
|
|
$self->{_populated} = 1; |
483
|
|
|
|
|
|
|
} else { |
484
|
0
|
|
|
|
|
|
$self->{_populated} = 0; |
485
|
0
|
|
|
|
|
|
$self->{_children} = []; |
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
|
488
|
0
|
|
|
|
|
|
return $self; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
sub all_items { |
492
|
0
|
|
|
0
|
|
|
my $self = shift; |
493
|
0
|
0
|
|
|
|
|
if ($self->is_populated) { |
494
|
0
|
|
|
|
|
|
return @{$self->{_children}}; |
|
0
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
} else { |
496
|
0
|
|
|
|
|
|
Class::ReluctantORM::Exception::Data::FetchRequired->croak(called => 'all_items', call_instead => 'fetch_all', fetch_locations => [ $self->linking_object->all_origin_traces ]); |
497
|
|
|
|
|
|
|
} |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
|
500
|
0
|
|
|
0
|
|
|
sub all { goto &all_items; } |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
sub _check_correct_child_class { |
503
|
0
|
|
|
0
|
|
|
my ($self, $object) = @_; |
504
|
0
|
0
|
|
|
|
|
if (ref($object)) { |
505
|
0
|
|
|
|
|
|
Class::ReluctantORM::Exception::Param::WrongType->croak( |
506
|
|
|
|
|
|
|
param => 'value', |
507
|
|
|
|
|
|
|
expected => 'plain scalar', |
508
|
|
|
|
|
|
|
error => 'Can only store plain scalar values in HasLazy fields', |
509
|
|
|
|
|
|
|
value => $object, |
510
|
|
|
|
|
|
|
); |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
0
|
|
|
0
|
|
|
sub is_populated { return shift->{_populated}; } |
515
|
|
|
|
|
|
|
sub depopulate { |
516
|
0
|
|
|
0
|
|
|
my $self = shift; |
517
|
0
|
|
|
|
|
|
$self->{_populated} = 0; |
518
|
0
|
|
|
|
|
|
$self->{_children} = []; |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
sub count { |
522
|
0
|
|
|
0
|
|
|
my $self = shift; |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
# No separate count mechanism - if you're populated, it's 1; else, it's an exception |
525
|
0
|
0
|
|
|
|
|
if ($self->is_populated) { |
526
|
0
|
|
|
|
|
|
return 1; |
527
|
|
|
|
|
|
|
} else { |
528
|
0
|
|
|
|
|
|
Class::ReluctantORM::Exception::Data::FetchRequired->croak(called => 'count', call_instead => 'fetch_count', fetch_locations => [ $self->linking_object->all_origin_traces ]); |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
sub fetch_count { |
533
|
0
|
|
|
0
|
|
|
my $self = shift; |
534
|
0
|
|
|
|
|
|
$self->fetch_all(); |
535
|
0
|
|
|
|
|
|
return $self->count(); |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
sub fetch_all { |
539
|
0
|
|
|
0
|
|
|
my $self = shift; |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
# Be as gentle as possible |
542
|
|
|
|
|
|
|
# (Fetching as few columns as possible) |
543
|
0
|
|
|
|
|
|
my $class = $self->rel->linking_class(); |
544
|
0
|
|
|
|
|
|
my $obj = $self->linking_object(); |
545
|
0
|
|
|
|
|
|
my $table = Table->new($class); |
546
|
0
|
|
|
|
|
|
my $lazy_field = $self->rel->name(); |
547
|
|
|
|
|
|
|
|
548
|
0
|
|
|
|
|
|
my $sql = SQL->new('SELECT'); |
549
|
0
|
|
|
|
|
|
$sql->from(From->new($table)); |
550
|
0
|
|
|
|
|
|
$sql->where($self->__make_link_where_sql()); |
551
|
0
|
|
|
|
|
|
my $output = OutputColumn->new(Column->new(table => $table, |
552
|
|
|
|
|
|
|
column => $class->column_name($lazy_field))); |
553
|
0
|
|
|
|
|
|
$sql->add_output($output); |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
# Run query |
556
|
0
|
|
|
|
|
|
$class->driver->run_sql($sql); |
557
|
|
|
|
|
|
|
|
558
|
0
|
|
|
|
|
|
my $value = $output->output_value(); |
559
|
|
|
|
|
|
|
|
560
|
0
|
|
|
|
|
|
$self->linking_object->capture_origin(); |
561
|
0
|
|
|
|
|
|
$self->{_children} = [ $value ]; |
562
|
0
|
|
|
|
|
|
$self->{_populated} = 1; |
563
|
0
|
|
|
|
|
|
my @results = @{$self->{_children}}; |
|
0
|
|
|
|
|
|
|
564
|
0
|
|
|
|
|
|
return @results; |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
sub __make_link_where_sql { |
568
|
0
|
|
|
0
|
|
|
my $coll = shift; |
569
|
0
|
|
|
|
|
|
my $class = $coll->rel->linking_class(); |
570
|
0
|
|
|
|
|
|
my $obj = $coll->linking_object(); |
571
|
0
|
|
|
|
|
|
my $table = Table->new($class); |
572
|
|
|
|
|
|
|
|
573
|
0
|
|
|
|
|
|
my $crit; |
574
|
|
|
|
|
|
|
|
575
|
0
|
|
|
|
|
|
foreach my $col_name ($class->primary_key_columns()) { |
576
|
0
|
|
|
|
|
|
my $field = $class->field_name($col_name); |
577
|
0
|
|
|
|
|
|
my $param = Param->new($obj->raw_field_value($field)); |
578
|
0
|
|
|
|
|
|
my $col = Column->new(table => $table, column => $col_name); |
579
|
|
|
|
|
|
|
|
580
|
0
|
|
|
|
|
|
my $this_crit = Criterion->new('=', $col, $param); |
581
|
0
|
0
|
|
|
|
|
$crit = $crit ? Criterion->new('AND', $crit, $this_crit) : $this_crit; |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
|
584
|
0
|
|
|
|
|
|
return Where->new($crit); |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
sub _set_single_value { |
588
|
0
|
|
|
0
|
|
|
my $self = shift; |
589
|
0
|
|
|
|
|
|
my $val = shift; |
590
|
0
|
|
|
|
|
|
$self->{_children} = [ $val ]; |
591
|
0
|
|
|
|
|
|
$self->{_populated} = 1; |
592
|
0
|
|
|
|
|
|
return; |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
sub _set_empty_but_populated { |
596
|
0
|
|
|
0
|
|
|
my $self = shift; |
597
|
0
|
|
|
|
|
|
$self->{_children} = [ ]; |
598
|
0
|
|
|
|
|
|
$self->{_populated} = 1; |
599
|
0
|
|
|
|
|
|
return; |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
# Note: AUTOLOAD defined in Collection base class |
605
|
|
|
|
|
|
|
# sub __setup_aggregate_autoload { |
606
|
|
|
|
|
|
|
# my ($self1, $AUTOLOAD, $method, $args, $agg_type, $agg_field) = @_; |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
# my $linked_class = $self1->rel->linked_class; |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
# # Generate a coderef |
611
|
|
|
|
|
|
|
# my $code = sub { |
612
|
|
|
|
|
|
|
# my $self = shift; |
613
|
|
|
|
|
|
|
# my %args = @_; |
614
|
|
|
|
|
|
|
# my %where_args = $self->__make_link_where(); |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
# # Append args |
617
|
|
|
|
|
|
|
# $where_args{where} .= $args{where} || '1=1'; |
618
|
|
|
|
|
|
|
# push @{$where_args{execargs}}, @{$args{execargs} || []}; |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
# # Use aggregate method defined by child class |
621
|
|
|
|
|
|
|
# return $linked_class->$method(%where_args); |
622
|
|
|
|
|
|
|
# }; |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
# # Don't install coderef in symbol table |
625
|
|
|
|
|
|
|
# # The name of this will vary based on the classes linked |
626
|
|
|
|
|
|
|
# $code->($self1, @$args); |
627
|
|
|
|
|
|
|
# } |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
1; |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
|