Commit | Line | Data |
75d07914 |
1 | package # hide from PAUSE |
c0e7b4e5 |
2 | DBIx::Class::ResultSourceProxy; |
b98e75f6 |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
8d73fcd4 |
7 | use base 'DBIx::Class'; |
8 | |
28ef9468 |
9 | # ! LOAD ORDER SENSITIVE ! |
1b822bd3 |
10 | # needs to be loaded early to query method attributes below |
28ef9468 |
11 | # and to do the around()s properly |
1b822bd3 |
12 | use DBIx::Class::ResultSource; |
28ef9468 |
13 | my @wrap_rsrc_methods = qw( |
14 | add_columns |
15 | add_relationship |
16 | ); |
1b822bd3 |
17 | |
28ef9468 |
18 | use DBIx::Class::_Util qw( |
19 | quote_sub perlstring fail_on_internal_call describe_class_methods |
20 | ); |
a93c65f2 |
21 | use namespace::clean; |
b98e75f6 |
22 | |
28ef9468 |
23 | # FIXME: this is truly bizarre, not sure why it is this way since 93405cf0 |
24 | # This value *IS* *DIFFERENT* from source_name in the underlying rsrc |
25 | # instance, and there is *ZERO EFFORT* made to synchronize them... |
26 | # FIXME: Due to the above marking this as a rsrc_proxy method is also out |
27 | # of the question... |
a93c65f2 |
28 | __PACKAGE__->mk_group_accessors('inherited_ro_instance' => 'source_name'); |
29 | |
d46eac43 |
30 | sub get_inherited_ro_instance { $_[0]->get_inherited($_[1]) } |
b98e75f6 |
31 | |
93405cf0 |
32 | sub set_inherited_ro_instance { |
d46eac43 |
33 | $_[0]->throw_exception ("Cannot set '$_[1]' on an instance") |
34 | if length ref $_[0]; |
93405cf0 |
35 | |
d46eac43 |
36 | $_[0]->set_inherited( $_[1], $_[2] ); |
93405cf0 |
37 | } |
38 | |
28ef9468 |
39 | sub add_columns :DBIC_method_is_bypassable_resultsource_proxy { |
b98e75f6 |
40 | my ($class, @cols) = @_; |
e570488a |
41 | my $source = $class->result_source; |
28ef9468 |
42 | local $source->{__callstack_includes_rsrc_proxy_method} = "add_columns"; |
43 | |
1f23a877 |
44 | $source->add_columns(@cols); |
b83736a7 |
45 | |
46 | my $colinfos; |
1f23a877 |
47 | foreach my $c (grep { !ref } @cols) { |
157ce0cf |
48 | # If this is an augment definition get the real colname. |
49 | $c =~ s/^\+//; |
50 | |
b83736a7 |
51 | $class->register_column( |
52 | $c, |
53 | ( $colinfos ||= $source->columns_info )->{$c} |
54 | ); |
1f23a877 |
55 | } |
b98e75f6 |
56 | } |
57 | |
1b822bd3 |
58 | sub add_column :DBIC_method_is_indirect_sugar { |
e5053694 |
59 | DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; |
60 | shift->add_columns(@_) |
61 | } |
002a359a |
62 | |
28ef9468 |
63 | sub add_relationship :DBIC_method_is_bypassable_resultsource_proxy { |
a93c65f2 |
64 | my ($class, $rel, @rest) = @_; |
e570488a |
65 | my $source = $class->result_source; |
28ef9468 |
66 | local $source->{__callstack_includes_rsrc_proxy_method} = "add_relationship"; |
67 | |
a93c65f2 |
68 | $source->add_relationship($rel => @rest); |
69 | $class->register_relationship($rel => $source->relationship_info($rel)); |
bc0c9800 |
70 | } |
71 | |
b98e75f6 |
72 | |
a93c65f2 |
73 | # legacy resultset_class accessor, seems to be used by cdbi only |
1b822bd3 |
74 | sub iterator_class :DBIC_method_is_indirect_sugar { |
e5053694 |
75 | DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; |
e570488a |
76 | shift->result_source->resultset_class(@_) |
e5053694 |
77 | } |
a83cdbf2 |
78 | |
a93c65f2 |
79 | for my $method_to_proxy (qw/ |
80 | source_info |
81 | result_class |
82 | resultset_class |
83 | resultset_attributes |
bc0c9800 |
84 | |
a93c65f2 |
85 | columns |
86 | has_column |
034d0be4 |
87 | |
a93c65f2 |
88 | remove_column |
89 | remove_columns |
87f0da6a |
90 | |
a93c65f2 |
91 | column_info |
52416317 |
92 | columns_info |
a93c65f2 |
93 | column_info_from_storage |
1bc0b925 |
94 | |
a93c65f2 |
95 | set_primary_key |
96 | primary_columns |
89170201 |
97 | sequence |
1bc0b925 |
98 | |
a93c65f2 |
99 | add_unique_constraint |
100 | add_unique_constraints |
8c49f629 |
101 | |
a93c65f2 |
102 | unique_constraints |
103 | unique_constraint_names |
104 | unique_constraint_columns |
8c49f629 |
105 | |
a93c65f2 |
106 | relationships |
107 | relationship_info |
108 | has_relationship |
109 | /) { |
28ef9468 |
110 | my $qsub_opts = { attributes => [ |
111 | do { |
112 | no strict 'refs'; |
113 | attributes::get( \&{"DBIx::Class::ResultSource::$method_to_proxy"} ); |
114 | } |
115 | ] }; |
1b822bd3 |
116 | |
28ef9468 |
117 | # bypassable default for backcompat, except for indirect methods |
118 | # ( those will simply warn during the sanheck ) |
119 | if(! grep |
120 | { $_ eq 'DBIC_method_is_indirect_sugar' } |
121 | @{ $qsub_opts->{attributes} } |
122 | ) { |
123 | push @wrap_rsrc_methods, $method_to_proxy; |
124 | push @{ $qsub_opts->{atributes} }, 'DBIC_method_is_bypassable_resultsource_proxy'; |
125 | } |
1b822bd3 |
126 | |
127 | quote_sub __PACKAGE__."::$method_to_proxy", sprintf( <<'EOC', $method_to_proxy ), {}, $qsub_opts; |
4006691d |
128 | DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call; |
e570488a |
129 | |
28ef9468 |
130 | my $rsrc = shift->result_source; |
131 | local $rsrc->{__callstack_includes_rsrc_proxy_method} = q(%1$s); |
132 | $rsrc->%1$s (@_); |
133 | EOC |
134 | |
135 | } |
136 | |
137 | # This is where the "magic" of detecting/invoking the proper overridden |
138 | # Result method takes place. It isn't implemented as a stateless out-of-band |
139 | # SanityCheck as invocation requires certain state in the $rsrc object itself |
140 | # in order not to loop over itself. It is not in ResultSource.pm either |
141 | # because of load order and because the entire stack is just terrible :/ |
142 | # |
143 | # The code is not easily readable, as it it optimized for execution time |
144 | # (this stuff will be run all the time across the entire install base :/ ) |
145 | # |
146 | { |
147 | our %__rsrc_proxy_meta_cache; |
148 | |
149 | sub DBIx::Class::__RsrcProxy_iThreads_handler__::CLONE { |
150 | # recreating this cache is pretty cheap: just blow it away |
151 | %__rsrc_proxy_meta_cache = (); |
152 | } |
153 | |
154 | for my $method_to_wrap (@wrap_rsrc_methods) { |
155 | |
156 | my @src_args = ( |
157 | perlstring $method_to_wrap, |
158 | ); |
159 | |
160 | my $orig = do { |
161 | no strict 'refs'; |
162 | \&{"DBIx::Class::ResultSource::$method_to_wrap"} |
163 | }; |
164 | |
165 | my %unclassified_override_warn_emitted; |
166 | |
167 | my @qsub_args = ( |
168 | { |
169 | # ref to hashref, this is how S::Q works |
170 | '$rsrc_proxy_meta_cache' => \\%__rsrc_proxy_meta_cache, |
171 | '$unclassified_override_warn_emitted' => \\%unclassified_override_warn_emitted, |
172 | '$orig' => \$orig, |
173 | }, |
174 | { attributes => [ attributes::get($orig) ] } |
175 | ); |
176 | |
177 | quote_sub "DBIx::Class::ResultSource::$method_to_wrap", sprintf( <<'EOC', @src_args ), @qsub_args; |
178 | |
179 | my $overridden_proxy_cref; |
180 | |
181 | # fall through except when... |
182 | return &$orig unless ( |
183 | |
184 | # FIXME - this may be necessary some day, but skip the hit for now |
185 | # Scalar::Util::reftype $_[0] eq 'HASH' |
186 | # and |
187 | |
188 | # there is a class to check in the first place |
189 | defined $_[0]->{result_class} |
190 | |
191 | and |
192 | # we are not in a reinvoked callstack |
193 | ( |
194 | ( $_[0]->{__callstack_includes_rsrc_proxy_method} || '' ) |
195 | ne |
196 | %1$s |
197 | ) |
198 | |
199 | and |
200 | # there is a proxied method in the first place |
201 | ( |
202 | ( $rsrc_proxy_meta_cache->{address}{%1$s} ||= 0 + ( |
203 | DBIx::Class::ResultSourceProxy->can(%1$s) |
204 | || |
205 | -1 |
206 | ) ) |
207 | > |
208 | 0 |
209 | ) |
210 | |
211 | and |
212 | # the proxied method *is overridden* |
213 | ( |
214 | $rsrc_proxy_meta_cache->{address}{%1$s} |
215 | != |
216 | # the can() should not be able to fail in theory, but the |
217 | # result class may not inherit from ::Core *at all* |
218 | # hence we simply ||ourselves to paper over this eventuality |
219 | ( |
220 | ( $overridden_proxy_cref = $_[0]->{result_class}->can(%1$s) ) |
221 | || |
222 | $rsrc_proxy_meta_cache->{address}{%1$s} |
223 | ) |
224 | ) |
225 | |
226 | and |
227 | # no short-circuiting atributes |
228 | (! grep |
229 | { |
230 | # checking that: |
231 | # |
232 | # - Override is not something DBIC plastered on top of things |
233 | # One would think this is crazy, yet there it is... sigh: |
234 | # https://metacpan.org/source/KARMAN/DBIx-Class-RDBOHelpers-0.12/t/lib/MyDBIC/Schema/Cd.pm#L26-27 |
235 | # |
236 | # - And is not an m2m crapfest |
237 | # |
238 | # - And is not something marked as bypassable |
239 | |
240 | $_ =~ / ^ DBIC_method_is_ (?: |
241 | generated_from_resultsource_metadata |
242 | | |
243 | m2m_ (?: extra_)? sugar (?:_with_attrs)? |
244 | | |
245 | bypassable_resultsource_proxy |
246 | ) $ /x |
247 | } |
248 | keys %%{ $rsrc_proxy_meta_cache->{attrs}{$overridden_proxy_cref} ||= { |
249 | map { $_ => 1 } attributes::get($overridden_proxy_cref) |
250 | }} |
251 | ) |
252 | ); |
253 | |
254 | # Getting this far means that there *is* an override |
255 | # and it is *not* marked for a skip |
256 | |
257 | # we were asked to loop back through the Result override |
258 | if ( |
259 | $rsrc_proxy_meta_cache->{attrs} |
260 | {$overridden_proxy_cref} |
261 | {DBIC_method_is_mandatory_resultsource_proxy} |
262 | ) { |
263 | local $_[0]->{__callstack_includes_rsrc_proxy_method} = %1$s; |
264 | |
265 | # replace $self without compromising aliasing |
266 | splice @_, 0, 1, $_[0]->{result_class}; |
267 | |
268 | return &$overridden_proxy_cref; |
269 | } |
270 | # complain (sparsely) and carry on |
271 | else { |
272 | |
273 | # FIXME!!! - terrible, need to swap for something saner later |
274 | my ($cs) = DBIx::Class::Carp::__find_caller( __PACKAGE__ ); |
275 | |
276 | my $key = $cs . $overridden_proxy_cref; |
277 | |
278 | unless( $unclassified_override_warn_emitted->{$key} ) { |
279 | |
280 | # find the real origin |
281 | my @meth_stack = @{ DBIx::Class::_Util::describe_class_methods( |
282 | ref $_[0]->{result_class} || $_[0]->{result_class} |
283 | )->{methods}{%1$s} }; |
284 | |
285 | my $in_class = (shift @meth_stack)->{via_class}; |
286 | |
287 | my $possible_supers; |
288 | while ( |
289 | @meth_stack |
290 | and |
291 | $meth_stack[0]{via_class} ne __PACKAGE__ |
292 | ) { |
293 | push @$possible_supers, (shift @meth_stack)->{via_class}; |
294 | } |
295 | |
296 | $possible_supers = $possible_supers |
297 | ? sprintf( |
298 | ' ( and possible SUPERs: %%s )', |
299 | join ', ', map |
300 | { join '::', $_, %1$s } |
301 | @$possible_supers |
302 | ) |
303 | : '' |
304 | ; |
305 | |
306 | my $fqmeth = $in_class . '::' . %1$s . '()'; |
307 | |
308 | DBIx::Class::_Util::emit_loud_diag( |
91028369 |
309 | |
310 | # Repurpose the assertion envvar ( the override-check is independent |
311 | # from the schema san-checker, but the spirit is the same ) |
28ef9468 |
312 | confess => $ENV{DBIC_ASSERT_NO_FAILING_SANITY_CHECKS}, |
91028369 |
313 | |
28ef9468 |
314 | msg => |
315 | "The override method $fqmeth$possible_supers has been bypassed " |
316 | . "$cs\n" |
317 | . "In order to silence this warning you must tag the " |
318 | . "definition of $fqmeth with one of the attributes " |
319 | . "':DBIC_method_is_bypassable_resultsource_proxy' or " |
320 | . "':DBIC_method_is_mandatory_resultsource_proxy' ( see " |
321 | . "https://is.gd/dbic_rsrcproxy_methodattr for more info )\n" |
322 | ); |
323 | |
324 | # only set if we didn't throw |
325 | $unclassified_override_warn_emitted->{$key} = 1; |
326 | } |
327 | |
328 | return &$orig; |
329 | } |
4006691d |
330 | EOC |
331 | |
28ef9468 |
332 | } |
333 | |
334 | Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO; |
335 | } |
336 | |
337 | # CI sanity check that all annotations make sense |
338 | if( |
339 | DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE |
340 | and |
341 | # no point taxing 5.8 with this |
342 | ! DBIx::Class::_ENV_::OLD_MRO |
343 | ) { |
344 | |
345 | my ( $rsrc_methods, $rsrc_proxy_methods, $base_methods ) = map { |
346 | describe_class_methods($_)->{methods} |
347 | } qw( |
348 | DBIx::Class::ResultSource |
349 | DBIx::Class::ResultSourceProxy |
350 | DBIx::Class |
351 | ); |
352 | |
353 | delete $rsrc_methods->{$_}, delete $rsrc_proxy_methods->{$_} |
354 | for keys %$base_methods; |
355 | |
356 | ( |
357 | $rsrc_methods->{$_} |
358 | and |
359 | ! $rsrc_proxy_methods->{$_}[0]{attributes}{DBIC_method_is_indirect_sugar} |
360 | ) |
361 | or |
362 | delete $rsrc_proxy_methods->{$_} |
363 | for keys %$rsrc_proxy_methods; |
364 | |
365 | # see fat FIXME at top of file |
366 | delete @{$rsrc_proxy_methods}{qw( source_name _source_name_accessor )}; |
367 | |
368 | if ( |
369 | ( my $proxied = join "\n", map "\t$_", sort keys %$rsrc_proxy_methods ) |
370 | ne |
371 | ( my $wrapped = join "\n", map "\t$_", sort @wrap_rsrc_methods ) |
372 | ) { |
373 | Carp::confess( |
374 | "Unexpected mismatch between the list of proxied methods:\n\n$proxied" |
375 | . "\n\nand the list of wrapped rsrc methods:\n\n$wrapped\n\n" |
376 | ); |
377 | } |
8c49f629 |
378 | } |
379 | |
b98e75f6 |
380 | 1; |