Commit | Line | Data |
4e9fc3f3 |
1 | package # hide from the pauses |
2 | DBIx::Class::ResultSource::RowParser; |
76031e14 |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
9f98c4b2 |
7 | use base 'DBIx::Class'; |
8 | |
76031e14 |
9 | use Try::Tiny; |
fcf32d04 |
10 | use List::Util qw(first max); |
76031e14 |
11 | use B 'perlstring'; |
12 | |
9f98c4b2 |
13 | use DBIx::Class::ResultSource::RowParser::Util qw( |
14 | assemble_simple_parser |
15 | assemble_collapsing_parser |
16 | ); |
76031e14 |
17 | |
9f98c4b2 |
18 | use namespace::clean; |
76031e14 |
19 | |
20 | # Accepts one or more relationships for the current source and returns an |
21 | # array of column names for each of those relationships. Column names are |
22 | # prefixed relative to the current source, in accordance with where they appear |
23 | # in the supplied relationships. |
24 | sub _resolve_prefetch { |
25 | my ($self, $pre, $alias, $alias_map, $order, $pref_path) = @_; |
26 | $pref_path ||= []; |
27 | |
28 | if (not defined $pre or not length $pre) { |
29 | return (); |
30 | } |
31 | elsif( ref $pre eq 'ARRAY' ) { |
32 | return |
33 | map { $self->_resolve_prefetch( $_, $alias, $alias_map, $order, [ @$pref_path ] ) } |
34 | @$pre; |
35 | } |
36 | elsif( ref $pre eq 'HASH' ) { |
37 | my @ret = |
38 | map { |
39 | $self->_resolve_prefetch($_, $alias, $alias_map, $order, [ @$pref_path ] ), |
40 | $self->related_source($_)->_resolve_prefetch( |
4e9fc3f3 |
41 | $pre->{$_}, "${alias}.$_", $alias_map, $order, [ @$pref_path, $_] ) |
76031e14 |
42 | } keys %$pre; |
43 | return @ret; |
44 | } |
45 | elsif( ref $pre ) { |
46 | $self->throw_exception( |
47 | "don't know how to resolve prefetch reftype ".ref($pre)); |
48 | } |
49 | else { |
50 | my $p = $alias_map; |
51 | $p = $p->{$_} for (@$pref_path, $pre); |
52 | |
53 | $self->throw_exception ( |
54 | "Unable to resolve prefetch '$pre' - join alias map does not contain an entry for path: " |
55 | . join (' -> ', @$pref_path, $pre) |
56 | ) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} ); |
57 | |
58 | my $as = shift @{$p->{-join_aliases}}; |
59 | |
60 | my $rel_info = $self->relationship_info( $pre ); |
61 | $self->throw_exception( $self->source_name . " has no such relationship '$pre'" ) |
62 | unless $rel_info; |
63 | |
64 | my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : ''); |
76031e14 |
65 | |
66 | return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] } |
4e9fc3f3 |
67 | $self->related_source($pre)->columns; |
76031e14 |
68 | } |
69 | } |
70 | |
9f98c4b2 |
71 | # Takes an arrayref of {as} dbic column aliases and the collapse and select |
72 | # attributes from the same $rs (the selector requirement is a temporary |
73 | # workaround... I hope), and returns a coderef capable of: |
74 | # my $me_pref_clps = $coderef->([$rs->cursor->next/all]) |
75 | # Where the $me_pref_clps arrayref is the future argument to inflate_result() |
76 | # |
77 | # For an example of this coderef in action (and to see its guts) look at |
78 | # t/resultset/rowparser_internals.t |
79 | # |
80 | # This is a huge performance win, as we call the same code for every row |
81 | # returned from the db, thus avoiding repeated method lookups when traversing |
82 | # relationships |
83 | # |
84 | # Also since the coderef is completely stateless (the returned structure is |
85 | # always fresh on every new invocation) this is a very good opportunity for |
86 | # memoization if further speed improvements are needed |
87 | # |
88 | # The way we construct this coderef is somewhat fugly, although the result is |
89 | # really worth it. The final coderef does not perform any kind of recursion - |
90 | # the entire nested structure constructor is rolled out into a single scope. |
91 | # |
92 | # In any case - the output of this thing is meticulously micro-tested, so |
93 | # any sort of adjustment/rewrite should be relatively easy (fsvo relatively) |
94 | # |
95 | sub _mk_row_parser { |
96 | my ($self, $args) = @_; |
97 | |
98 | my $val_index = { map |
99 | { $args->{inflate_map}[$_] => $_ } |
100 | ( 0 .. $#{$args->{inflate_map}} ) |
101 | }; |
102 | |
103 | if (! $args->{collapse} ) { |
104 | return assemble_simple_parser({ |
105 | val_index => $val_index, |
106 | }); |
107 | } |
108 | else { |
109 | my $collapse_map = $self->_resolve_collapse ({ |
110 | premultiplied => $args->{premultiplied}, |
111 | # FIXME |
112 | # only consider real columns (not functions) during collapse resolution |
113 | # this check shouldn't really be here, as fucktards are not supposed to |
114 | # alias random crap to existing column names anyway, but still - just in |
115 | # case |
116 | # FIXME !!!! - this does not yet deal with unbalanced selectors correctly |
117 | # (it is now trivial as the attrs specify where things go out of sync |
118 | # needs MOAR tests) |
119 | as => { map |
120 | { ref $args->{selection}[$val_index->{$_}] ? () : ( $_ => $val_index->{$_} ) } |
121 | keys %$val_index |
122 | } |
123 | }); |
124 | |
125 | return assemble_collapsing_parser({ |
126 | val_index => $val_index, |
127 | collapse_map => $collapse_map, |
128 | }); |
129 | } |
130 | } |
131 | |
132 | |
2d0b795a |
133 | # Takes an arrayref selection list and generates a collapse-map representing |
76031e14 |
134 | # row-object fold-points. Every relationship is assigned a set of unique, |
135 | # non-nullable columns (which may *not even be* from the same resultset) |
136 | # and the collapser will use this information to correctly distinguish |
2d0b795a |
137 | # data of individual to-be-row-objects. See t/resultset/rowparser_internals.t |
138 | # for extensive RV examples |
76031e14 |
139 | sub _resolve_collapse { |
82f0e0aa |
140 | my ($self, $args, $common_args) = @_; |
76031e14 |
141 | |
142 | # for comprehensible error messages put ourselves at the head of the relationship chain |
82f0e0aa |
143 | $args->{_rel_chain} ||= [ $self->source_name ]; |
76031e14 |
144 | |
9f98c4b2 |
145 | # record top-level fully-qualified column index, signify toplevelness |
146 | unless ($common_args->{_as_fq_idx}) { |
147 | $common_args->{_as_fq_idx} = { %{$args->{as}} }; |
148 | $args->{_is_top_level} = 1; |
82f0e0aa |
149 | }; |
76031e14 |
150 | |
151 | my ($my_cols, $rel_cols); |
82f0e0aa |
152 | for (keys %{$args->{as}}) { |
76031e14 |
153 | if ($_ =~ /^ ([^\.]+) \. (.+) /x) { |
154 | $rel_cols->{$1}{$2} = 1; |
155 | } |
156 | else { |
fcf32d04 |
157 | $my_cols->{$_} = {}; # important for ||='s below |
76031e14 |
158 | } |
159 | } |
160 | |
161 | my $relinfo; |
fcf32d04 |
162 | # run through relationships, collect metadata |
76031e14 |
163 | for my $rel (keys %$rel_cols) { |
76031e14 |
164 | my $inf = $self->relationship_info ($rel); |
165 | |
95e41036 |
166 | $relinfo->{$rel} = { |
167 | is_single => ( $inf->{attrs}{accessor} && $inf->{attrs}{accessor} ne 'multi' ), |
168 | is_inner => ( ( $inf->{attrs}{join_type} || '' ) !~ /^left/i), |
169 | rsrc => $self->related_source($rel), |
170 | }; |
76031e14 |
171 | |
fcf32d04 |
172 | # FIME - need to use _resolve_cond here instead |
76031e14 |
173 | my $cond = $inf->{cond}; |
174 | |
175 | if ( |
176 | ref $cond eq 'HASH' |
177 | and |
178 | keys %$cond |
179 | and |
fcf32d04 |
180 | ! defined first { $_ !~ /^foreign\./ } (keys %$cond) |
76031e14 |
181 | and |
fcf32d04 |
182 | ! defined first { $_ !~ /^self\./ } (values %$cond) |
76031e14 |
183 | ) { |
184 | for my $f (keys %$cond) { |
185 | my $s = $cond->{$f}; |
186 | $_ =~ s/^ (?: foreign | self ) \.//x for ($f, $s); |
187 | $relinfo->{$rel}{fk_map}{$s} = $f; |
76031e14 |
188 | } |
189 | } |
190 | } |
191 | |
fcf32d04 |
192 | # inject non-left fk-bridges from *INNER-JOINED* children (if any) |
193 | for my $rel (grep { $relinfo->{$_}{is_inner} } keys %$relinfo) { |
194 | my $ri = $relinfo->{$rel}; |
195 | for (keys %{$ri->{fk_map}} ) { |
196 | # need to know source from *our* pov, hence $rel.col |
197 | $my_cols->{$_} ||= { via_fk => "$rel.$ri->{fk_map}{$_}" } |
198 | if defined $rel_cols->{$rel}{$ri->{fk_map}{$_}} # in fact selected |
199 | } |
200 | } |
201 | |
a0726a33 |
202 | # if the parent is already defined *AND* we have an inner reverse relationship |
203 | # (i.e. do not exist without it) , assume all of its related FKs are selected |
76031e14 |
204 | # (even if they in fact are NOT in the select list). Keep a record of what we |
205 | # assumed, and if any such phantom-column becomes part of our own collapser, |
206 | # throw everything assumed-from-parent away and replace with the collapser of |
207 | # the parent (whatever it may be) |
208 | my $assumed_from_parent; |
a0726a33 |
209 | if ( ! $args->{_parent_info}{underdefined} and ! $args->{_parent_info}{rev_rel_is_optional} ) { |
fcf32d04 |
210 | for my $col ( values %{$args->{_parent_info}{rel_condition} || {}} ) { |
211 | next if exists $my_cols->{$col}; |
212 | $my_cols->{$col} = { via_collapse => $args->{_parent_info}{collapse_on_idcols} }; |
213 | $assumed_from_parent->{columns}{$col}++; |
214 | } |
76031e14 |
215 | } |
216 | |
217 | # get colinfo for everything |
218 | if ($my_cols) { |
219 | my $ci = $self->columns_info; |
220 | $my_cols->{$_}{colinfo} = $ci->{$_} for keys %$my_cols; |
221 | } |
222 | |
223 | my $collapse_map; |
224 | |
3faac878 |
225 | # first try to reuse the parent's collapser (i.e. reuse collapser over 1:1) |
226 | # (makes for a leaner coderef later) |
9f98c4b2 |
227 | unless ($collapse_map->{-identifying_columns}) { |
228 | $collapse_map->{-identifying_columns} = $args->{_parent_info}{collapse_on_idcols} |
3faac878 |
229 | if $args->{_parent_info}{collapser_reusable}; |
230 | } |
231 | |
3faac878 |
232 | # Still dont know how to collapse - try to resolve based on our columns (plus already inserted FK bridges) |
76031e14 |
233 | if ( |
9f98c4b2 |
234 | ! $collapse_map->{-identifying_columns} |
3faac878 |
235 | and |
76031e14 |
236 | $my_cols |
237 | and |
4e9fc3f3 |
238 | my $idset = $self->_identifying_column_set ({map { $_ => $my_cols->{$_}{colinfo} } keys %$my_cols}) |
76031e14 |
239 | ) { |
240 | # see if the resulting collapser relies on any implied columns, |
241 | # and fix stuff up if this is the case |
4e9fc3f3 |
242 | my @reduced_set = grep { ! $assumed_from_parent->{columns}{$_} } @$idset; |
76031e14 |
243 | |
9f98c4b2 |
244 | $collapse_map->{-identifying_columns} = [ __unique_numlist( |
3faac878 |
245 | @{ $args->{_parent_info}{collapse_on_idcols}||[] }, |
246 | |
76031e14 |
247 | (map |
248 | { |
249 | my $fqc = join ('.', |
82f0e0aa |
250 | @{$args->{_rel_chain}}[1 .. $#{$args->{_rel_chain}}], |
76031e14 |
251 | ( $my_cols->{$_}{via_fk} || $_ ), |
252 | ); |
253 | |
82f0e0aa |
254 | $common_args->{_as_fq_idx}->{$fqc}; |
76031e14 |
255 | } |
4e9fc3f3 |
256 | @reduced_set |
76031e14 |
257 | ), |
3faac878 |
258 | )]; |
76031e14 |
259 | } |
260 | |
261 | # Stil don't know how to collapse - keep descending down 1:1 chains - if |
262 | # a related non-LEFT 1:1 is resolvable - its condition will collapse us |
263 | # too |
9f98c4b2 |
264 | unless ($collapse_map->{-identifying_columns}) { |
76031e14 |
265 | my @candidates; |
266 | |
267 | for my $rel (keys %$relinfo) { |
268 | next unless ($relinfo->{$rel}{is_single} && $relinfo->{$rel}{is_inner}); |
269 | |
82f0e0aa |
270 | if ( my $rel_collapse = $relinfo->{$rel}{rsrc}->_resolve_collapse ({ |
271 | as => $rel_cols->{$rel}, |
272 | _rel_chain => [ @{$args->{_rel_chain}}, $rel ], |
273 | _parent_info => { underdefined => 1 }, |
274 | }, $common_args)) { |
9f98c4b2 |
275 | push @candidates, $rel_collapse->{-identifying_columns}; |
76031e14 |
276 | } |
277 | } |
278 | |
279 | # get the set with least amount of columns |
280 | # FIXME - maybe need to implement a data type order as well (i.e. prefer several ints |
281 | # to a single varchar) |
282 | if (@candidates) { |
9f98c4b2 |
283 | ($collapse_map->{-identifying_columns}) = sort { scalar @$a <=> scalar @$b } (@candidates); |
76031e14 |
284 | } |
285 | } |
286 | |
fcf32d04 |
287 | # Stil don't know how to collapse, and we are the root node. Last ditch |
288 | # effort in case we are *NOT* premultiplied. |
289 | # Run through *each multi* all the way down, left or not, and all |
290 | # *left* singles (a single may become a multi underneath) . When everything |
291 | # gets back see if all the rels link to us definitively. If this is the |
292 | # case we are good - either one of them will define us, or if all are NULLs |
293 | # we know we are "unique" due to the "non-premultiplied" check |
294 | if ( |
9f98c4b2 |
295 | ! $collapse_map->{-identifying_columns} |
fcf32d04 |
296 | and |
297 | ! $args->{premultiplied} |
298 | and |
9f98c4b2 |
299 | $args->{_is_top_level} |
fcf32d04 |
300 | ) { |
301 | my (@collapse_sets, $uncollapsible_chain); |
302 | |
303 | for my $rel (keys %$relinfo) { |
304 | |
305 | # we already looked at these higher up |
306 | next if ($relinfo->{$rel}{is_single} && $relinfo->{$rel}{is_inner}); |
307 | |
308 | if (my $clps = $relinfo->{$rel}{rsrc}->_resolve_collapse ({ |
309 | as => $rel_cols->{$rel}, |
310 | _rel_chain => [ @{$args->{_rel_chain}}, $rel ], |
311 | _parent_info => { underdefined => 1 }, |
312 | }, $common_args) ) { |
313 | |
314 | # for singles use the idcols wholesale (either there or not) |
315 | if ($relinfo->{$rel}{is_single}) { |
9f98c4b2 |
316 | push @collapse_sets, $clps->{-identifying_columns}; |
fcf32d04 |
317 | } |
318 | elsif (! $relinfo->{$rel}{fk_map}) { |
319 | $uncollapsible_chain = 1; |
320 | last; |
321 | } |
322 | else { |
323 | my $defined_cols_parent_side; |
324 | |
325 | for my $fq_col ( grep { /^$rel\.[^\.]+$/ } keys %{$args->{as}} ) { |
326 | my ($col) = $fq_col =~ /([^\.]+)$/; |
327 | |
328 | $defined_cols_parent_side->{$_} = $args->{as}{$fq_col} for grep |
329 | { $relinfo->{$rel}{fk_map}{$_} eq $col } |
330 | keys %{$relinfo->{$rel}{fk_map}} |
331 | ; |
332 | } |
333 | |
334 | if (my $set = $self->_identifying_column_set([ keys %$defined_cols_parent_side ]) ) { |
335 | push @collapse_sets, [ sort map { $defined_cols_parent_side->{$_} } @$set ]; |
336 | } |
337 | else { |
338 | $uncollapsible_chain = 1; |
339 | last; |
340 | } |
341 | } |
342 | } |
343 | else { |
344 | $uncollapsible_chain = 1; |
345 | last; |
346 | } |
347 | } |
348 | |
349 | unless ($uncollapsible_chain) { |
350 | # if we got here - we are good to go, but the construction is tricky |
351 | # since our children will want to include our collapse criteria - we |
352 | # don't give them anything (safe, since they are all collapsible on their own) |
353 | # in addition we record the individual collapse posibilities |
354 | # of all left children node collapsers, and merge them in the rowparser |
355 | # coderef later |
9f98c4b2 |
356 | $collapse_map->{-identifying_columns} = []; |
357 | $collapse_map->{-identifying_columns_variants} = [ sort { |
fcf32d04 |
358 | (scalar @$a) <=> (scalar @$b) or max(@$a) <=> max(@$b) |
359 | } @collapse_sets ]; |
360 | } |
361 | } |
362 | |
76031e14 |
363 | # stop descending into children if we were called by a parent for first-pass |
364 | # and don't despair if nothing was found (there may be other parallel branches |
365 | # to dive into) |
82f0e0aa |
366 | if ($args->{_parent_info}{underdefined}) { |
9f98c4b2 |
367 | return $collapse_map->{-identifying_columns} ? $collapse_map : undef |
76031e14 |
368 | } |
369 | # nothing down the chain resolved - can't calculate a collapse-map |
9f98c4b2 |
370 | elsif (! $collapse_map->{-identifying_columns}) { |
76031e14 |
371 | $self->throw_exception ( sprintf |
372 | "Unable to calculate a definitive collapse column set for %s%s: fetch more unique non-nullable columns", |
373 | $self->source_name, |
82f0e0aa |
374 | @{$args->{_rel_chain}} > 1 |
375 | ? sprintf (' (last member of the %s chain)', join ' -> ', @{$args->{_rel_chain}} ) |
76031e14 |
376 | : '' |
377 | , |
378 | ); |
379 | } |
380 | |
381 | # If we got that far - we are collapsable - GREAT! Now go down all children |
382 | # a second time, and fill in the rest |
383 | |
a0726a33 |
384 | $collapse_map->{-identifying_columns} = [ __unique_numlist( |
385 | @{ $args->{_parent_info}{collapse_on_idcols}||[] }, |
386 | @{ $collapse_map->{-identifying_columns} }, |
387 | )]; |
3faac878 |
388 | |
389 | my @id_sets; |
76031e14 |
390 | for my $rel (sort keys %$relinfo) { |
391 | |
82f0e0aa |
392 | $collapse_map->{$rel} = $relinfo->{$rel}{rsrc}->_resolve_collapse ({ |
393 | as => { map { $_ => 1 } ( keys %{$rel_cols->{$rel}} ) }, |
394 | _rel_chain => [ @{$args->{_rel_chain}}, $rel], |
395 | _parent_info => { |
3faac878 |
396 | # shallow copy |
9f98c4b2 |
397 | collapse_on_idcols => [ @{$collapse_map->{-identifying_columns}} ], |
76031e14 |
398 | |
399 | rel_condition => $relinfo->{$rel}{fk_map}, |
400 | |
a0726a33 |
401 | is_optional => ! $relinfo->{$rel}{is_inner}, |
402 | |
403 | # if there is at least one *inner* reverse relationship which is HASH-based (equality only) |
404 | # we can safely assume that the child can not exist without us |
405 | rev_rel_is_optional => ( first |
406 | { ref $_->{cond} eq 'HASH' and ($_->{attrs}{join_type}||'') !~ /^left/i } |
407 | values %{ $self->reverse_relationship_info($rel) }, |
408 | ) ? 0 : 1, |
76031e14 |
409 | |
410 | # if this is a 1:1 our own collapser can be used as a collapse-map |
411 | # (regardless of left or not) |
3d8caf63 |
412 | collapser_reusable => ( |
413 | $relinfo->{$rel}{is_single} |
414 | && |
415 | $relinfo->{$rel}{is_inner} |
416 | && |
417 | @{$collapse_map->{-identifying_columns}} |
418 | ) ? 1 : 0, |
76031e14 |
419 | }, |
82f0e0aa |
420 | }, $common_args ); |
76031e14 |
421 | |
422 | $collapse_map->{$rel}{-is_single} = 1 if $relinfo->{$rel}{is_single}; |
423 | $collapse_map->{$rel}{-is_optional} ||= 1 unless $relinfo->{$rel}{is_inner}; |
3faac878 |
424 | } |
76031e14 |
425 | |
426 | return $collapse_map; |
427 | } |
428 | |
76031e14 |
429 | # adding a dep on MoreUtils *just* for this is retarded |
430 | sub __unique_numlist { |
3faac878 |
431 | sort { $a <=> $b } keys %{ {map { $_ => 1 } @_ }} |
76031e14 |
432 | } |
433 | |
76031e14 |
434 | 1; |