Commit | Line | Data |
12e7015a |
1 | package DBIx::Class::Schema::SanityChecker; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use DBIx::Class::_Util qw( |
7 | dbic_internal_try refdesc uniq serialize |
8 | describe_class_methods emit_loud_diag |
9 | ); |
10 | use DBIx::Class (); |
11 | use DBIx::Class::Exception (); |
12 | use Scalar::Util qw( blessed refaddr ); |
13 | use namespace::clean; |
14 | |
15 | =head1 NAME |
16 | |
17 | DBIx::Class::Schema::SanityChecker - Extensible "critic" for your Schema class hierarchy |
18 | |
19 | =head1 SYNOPSIS |
20 | |
21 | package MyApp::Schema; |
22 | use base 'DBIx::Class::Schema'; |
23 | |
24 | # this is the default on Perl v5.10 and later |
25 | __PACKAGE__->schema_sanity_checker('DBIx::Class::Schema::SanityChecker'); |
26 | ... |
27 | |
28 | =head1 DESCRIPTION |
29 | |
30 | This is the default implementation of the Schema and related classes |
31 | L<validation framework|DBIx::Class::Schema/schema_sanity_checker>. |
32 | |
33 | The validator is B<enabled by default> on perls C<v5.10> and above. See |
34 | L</Performance considerations> for discussion of the runtime effects. |
35 | |
36 | Use of this class begins by invoking L</perform_schema_sanity_checks> |
37 | (usually via L<DBIx::Class::Schema/connection>), which in turn starts |
38 | invoking validators I<C<check_$checkname()>> in the order listed in |
39 | L</available_checks>. For each set of returned errors (if any) |
40 | I<C<format_$checkname_errors()>> is called and the resulting strings are |
41 | passed to L</emit_errors>, where final headers are prepended and the entire |
42 | thing is printed on C<STDERR>. |
43 | |
44 | The class does not provide a constructor, due to the lack of state to be |
45 | passed around: object orientation was chosen purely for the ease of |
46 | overriding parts of the chain of events as described above. The general |
47 | pattern of communicating errors between the individual methods (both |
48 | before and after formatting) is an arrayref of hash references. |
49 | |
50 | =head2 WHY |
51 | |
52 | DBIC existed for more than a decade without any such setup validation |
53 | fanciness, let alone something that is enabled by default (which in turn |
54 | L<isn't free|/Performance considerations>). The reason for this relatively |
55 | drastic change is a set of revamps within the metadata handling framework, |
56 | in order to resolve once and for all problems like |
57 | L<RT#107462|https://rt.cpan.org/Ticket/Display.html?id=107462>, |
58 | L<RT#114440|https://rt.cpan.org/Ticket/Display.html?id=114440>, etc. While |
59 | DBIC internals are now way more robust than they were before, this comes at |
60 | a price: some non-issues in code that has been working for a while, will |
61 | now become hard to explain, or if you are unlucky: B<silent breakages>. |
62 | |
63 | Thus, in order to protect existing codebases to the fullest extent possible, |
64 | the executive decision (and substantial effort) was made to introduce this |
65 | on-by-default setup validation framework. A massive amount of work has been |
66 | invested ensuring that none of the builtin checks emit a false-positive: |
67 | each and every complaint made by these checks B<should be investigated>. |
68 | |
69 | =head2 Performance considerations |
70 | |
71 | First of all - after your connection has been established - there is B<no |
72 | runtime penalty> whenever the checks are enabled. |
73 | |
74 | By default the checks are triggered every time |
75 | L<DBIx::Class::Schema/connection> is called. Thus there is a |
76 | noticeable startup slowdown, most notably during testing (each test is |
77 | effectively a standalone program connecting anew). As an example the test |
78 | execution phase of the L<DBIx::Class::Helpers> C<v2.032002> distribution |
79 | suffers a consistent slowdown of about C<16%>. This is considered a relatively |
80 | small price to pay for the benefits provided. |
81 | |
82 | Nevertheless, there are valid cases for disabling the checks during |
83 | day-to-day development, and having them run only during CI builds. In fact |
84 | the test suite of DBIC does exactly this as can be seen in |
85 | F<t/lib/DBICTest/BaseSchema.pm>: |
86 | |
87 | ~/dbic_repo$ git show 39636786 | perl -ne "print if 16..61" |
88 | |
89 | Whatever you do, B<please do not disable the checks entirely>: it is not |
90 | worth the risk. |
91 | |
92 | =head3 Perl5.8 |
93 | |
94 | The situation with perl interpreters before C<v5.10.0> is sadly more |
95 | complicated: due to lack of built-in L<pluggable mro support|mro>, the |
96 | mechanism used to interrogate various classes is |
97 | L<< B<much> slower|https://github.com/dbsrgits/dbix-class/commit/296248c3 >>. |
98 | As a result the very same version of L<DBIx::Class::Helpers> |
99 | L<mentioned above|/Performance considerations> takes a C<B<220%>> hit on its |
100 | test execution time (these numbers are observed with the speedups of |
101 | L<Class::C3::XS> available, without them the slowdown reaches the whopping |
102 | C<350%>). |
103 | |
104 | Therefore, on these versions of perl the sanity checks are B<not enabled> by |
105 | default. Instead a C<false> placeholder value is inserted into the |
106 | L<schema_sanity_checker attribute|DBIx::Class::Schema/schema_sanity_checker>, |
107 | urging the user to decide for themselves how to proceed. |
108 | |
109 | It is the author's B<strongest> recommendation to find a way to run the |
110 | checks on your codebase continuously, even if it takes much longer. Refer to |
111 | the last paragraph of L</Performance considerations> above for an example how |
112 | to do this during CI builds only. |
113 | |
114 | =head2 Validations provided by this module |
115 | |
116 | =head3 no_indirect_method_overrides |
117 | |
118 | There are many methods within DBIC which are |
119 | L<"strictly sugar"|DBIx::Class::MethodAttributes/DBIC_method_is_indirect_sugar> |
120 | and should never be overridden by your application (e.g. see warnings at the |
121 | end of L<DBIx::Class::ResultSet/create> and L<DBIx::Class::Schema/connect>). |
122 | Starting with C<v0.082900> DBIC is much more aggressive in calling the |
123 | underlying non-sugar methods directly, which in turn means that almost all |
124 | user-side overrides of sugar methods are never going to be invoked. These |
125 | situations are now reliably detected and reported individually (you may |
126 | end up with a lot of output on C<STDERR> due to this). |
127 | |
128 | Note: B<ANY AND ALL ISSUES> reported by this check B<*MUST*> be resolved |
129 | before upgrading DBIC in production. Malfunctioning business logic and/or |
130 | B<SEVERE DATA LOSS> may result otherwise. |
131 | |
132 | =head3 valid_c3_composition |
133 | |
134 | Looks through everything returned by L</all_schema_related_classes>, and |
135 | for any class that B<does not> already utilize L<c3 MRO|mro/The C3 MRO> a |
136 | L<method shadowing map|App::Isa::Splain/SYNOPSIS> is calculated and then |
137 | compared to the shadowing map as if C<c3 MRO> was requested in the first place. |
138 | Any discrepancies are reported in order to clearly identify L<hard to explain |
139 | bugs|https://blog.afoolishmanifesto.com/posts/mros-and-you> especially when |
140 | encountered within complex inheritance hierarchies. |
141 | |
142 | =head3 no_inheritance_crosscontamination |
143 | |
144 | Checks that every individual L<Schema|DBIx::Class::Schema>, |
145 | L<Storage|DBIx::Class::Storage>, L<ResultSource|DBIx::Class::ResultSource>, |
146 | L<ResultSet|DBIx::Class::ResultSet> |
147 | and L<Result|DBIx::Class::Manual::ResultClass> class does not inherit from |
148 | an unexpected DBIC base class: e.g. an error will be raised if your |
149 | C<MyApp::Schema> inherits from both C<DBIx::Class::Schema> and |
150 | C<DBIx::Class::ResultSet>. |
151 | |
152 | =head1 METHODS |
153 | |
154 | =head2 perform_schema_sanity_checks |
155 | |
156 | =over |
157 | |
158 | =item Arguments: L<$schema|DBIx::Class::Schema> |
159 | |
160 | =item Return Value: unspecified (ignored by caller) |
161 | |
162 | =back |
163 | |
164 | The entry point expected by the |
165 | L<validation framework|DBIx::Class::Schema/schema_sanity_checker>. See |
166 | L</DESCRIPTION> for details. |
167 | |
168 | =cut |
169 | |
170 | sub perform_schema_sanity_checks { |
171 | my ($self, $schema) = @_; |
172 | |
173 | local $DBIx::Class::_Util::describe_class_query_cache->{'!internal!'} = {} |
174 | if |
175 | # does not make a measurable difference on 5.10+ |
176 | DBIx::Class::_ENV_::OLD_MRO |
177 | and |
178 | # the callstack shouldn't really be recursive, but for completeness... |
179 | ! $DBIx::Class::_Util::describe_class_query_cache->{'!internal!'} |
180 | ; |
181 | |
182 | my (@errors_found, $schema_desc); |
183 | for my $ch ( @{ $self->available_checks } ) { |
184 | |
185 | my $err = $self->${\"check_$ch"} ( $schema ); |
186 | |
187 | push @errors_found, map |
188 | { |
189 | { |
190 | check_name => $ch, |
191 | formatted_error => $_, |
192 | schema_desc => ( $schema_desc ||= |
193 | ( length ref $schema ) |
194 | ? refdesc $schema |
195 | : "'$schema'" |
196 | ), |
197 | } |
198 | } |
199 | @{ |
200 | $self->${\"format_${ch}_errors"} ( $err ) |
201 | || |
202 | [] |
203 | } |
204 | if @$err; |
205 | } |
206 | |
207 | $self->emit_errors(\@errors_found) |
208 | if @errors_found; |
209 | } |
210 | |
211 | =head2 available_checks |
212 | |
213 | =over |
214 | |
215 | =item Arguments: none |
216 | |
217 | =item Return Value: \@list_of_check_names |
218 | |
219 | =back |
220 | |
221 | The list of checks L</perform_schema_sanity_checks> will perform on the |
222 | provided L<$schema|DBIx::Class::Schema> object. For every entry returned |
223 | by this method, there must be a pair of I<C<check_$checkname()>> and |
224 | I<C<format_$checkname_errors()>> methods available. |
225 | |
226 | Override this method to add checks to the |
227 | L<currently available set|/Validations provided by this module>. |
228 | |
229 | =cut |
230 | |
231 | sub available_checks { [qw( |
232 | valid_c3_composition |
233 | no_inheritance_crosscontamination |
234 | no_indirect_method_overrides |
235 | )] } |
236 | |
237 | =head2 emit_errors |
238 | |
239 | =over |
240 | |
241 | =item Arguments: \@list_of_formatted_errors |
242 | |
243 | =item Return Value: unspecified (ignored by caller) |
244 | |
245 | =back |
246 | |
247 | Takes an array reference of individual errors returned by various |
248 | I<C<format_$checkname_errors()>> formatters, and outputs them on C<STDERR>. |
249 | |
250 | This method is the most convenient integration point for a 3rd party logging |
251 | framework. |
252 | |
253 | Each individual error is expected to be a hash reference with all values being |
254 | plain strings as follows: |
255 | |
256 | { |
257 | schema_desc => $human_readable_description_of_the_passed_in_schema |
258 | check_name => $name_of_the_check_as_listed_in_available_checks() |
259 | formatted_error => $error_text_as_returned_by_format_$checkname_errors() |
260 | } |
261 | |
262 | If the environment variable C<DBIC_ASSERT_NO_FAILING_SANITY_CHECKS> is set to |
263 | a true value this method will throw an exception with the same text. Those who |
264 | prefer to take no chances could set this variable permanently as part of their |
265 | deployment scripts. |
266 | |
267 | =cut |
268 | |
269 | # *NOT* using carp_unique and the warn framework - make |
270 | # it harder to accidentaly silence problems via $SIG{__WARN__} |
271 | sub emit_errors { |
272 | #my ($self, $errs) = @_; |
273 | |
274 | my @final_error_texts = map { |
275 | sprintf( "Schema %s failed the '%s' sanity check: %s\n", |
276 | @{$_}{qw( schema_desc check_name formatted_error )} |
277 | ); |
278 | } @{$_[1]}; |
279 | |
280 | emit_loud_diag( |
281 | msg => $_ |
282 | ) for @final_error_texts; |
283 | |
284 | # Do not use the constant - but instead check the env every time |
285 | # This will allow people to start auditing their apps piecemeal |
286 | DBIx::Class::Exception->throw( join "\n", @final_error_texts, ' ' ) |
287 | if $ENV{DBIC_ASSERT_NO_FAILING_SANITY_CHECKS}; |
288 | } |
289 | |
290 | =head2 all_schema_related_classes |
291 | |
292 | =over |
293 | |
294 | =item Arguments: L<$schema|DBIx::Class::Schema> |
295 | |
296 | =item Return Value: @sorted_list_of_unique_class_names |
297 | |
298 | =back |
299 | |
300 | This is a convenience method providing a list (not an arrayref) of |
301 | "interesting classes" related to the supplied schema. The returned list |
302 | currently contains the following class names: |
303 | |
304 | =over |
305 | |
306 | =item * The L<Schema|DBIx::Class::Schema> class itself |
307 | |
308 | =item * The associated L<Storage|DBIx::Class::Schema/storage> class if any |
309 | |
310 | =item * The classes of all L<registered ResultSource instances|DBIx::Class::Schema/sources> if any |
311 | |
312 | =item * All L<Result|DBIx::Class::ResultSource/result_class> classes for all registered ResultSource instances |
313 | |
314 | =item * All L<ResultSet|DBIx::Class::ResultSource/resultset_class> classes for all registered ResultSource instances |
315 | |
316 | =back |
317 | |
318 | =cut |
319 | |
320 | sub all_schema_related_classes { |
321 | my ($self, $schema) = @_; |
322 | |
323 | sort( uniq( map { |
324 | ( not defined $_ ) ? () |
325 | : ( defined blessed $_ ) ? ref $_ |
326 | : $_ |
327 | } ( |
328 | $schema, |
329 | $schema->storage, |
330 | ( map { |
331 | $_, |
332 | $_->result_class, |
333 | $_->resultset_class, |
334 | } map { $schema->source($_) } $schema->sources ), |
335 | ))); |
336 | } |
337 | |
338 | |
339 | sub format_no_indirect_method_overrides_errors { |
340 | # my ($self, $errors) = @_; |
341 | |
342 | [ map { sprintf( |
343 | "Method(s) %s override the convenience shortcut %s::%s(): " |
344 | . 'it is almost certain these overrides *MAY BE COMPLETELY IGNORED* at ' |
345 | . 'runtime. You MUST reimplement each override to hook a method from the ' |
346 | . "chain of calls within the convenience shortcut as seen when running:\n " |
347 | . '~$ perl -M%2$s -MDevel::Dwarn -e "Ddie { %3$s => %2$s->can(q(%3$s)) }"', |
348 | join (', ', map { "$_()" } sort @{ $_->{by} } ), |
349 | $_->{overriden}{via_class}, |
350 | $_->{overriden}{name}, |
351 | )} @{ $_[1] } ] |
352 | } |
353 | |
354 | sub check_no_indirect_method_overrides { |
355 | my ($self, $schema) = @_; |
356 | |
357 | my( @err, $seen_shadowing_configurations ); |
358 | |
359 | METHOD_STACK: |
360 | for my $method_stack ( map { |
361 | values %{ describe_class_methods($_)->{methods_with_supers} || {} } |
362 | } $self->all_schema_related_classes($schema) ) { |
363 | |
364 | my $nonsugar_methods; |
365 | |
366 | for (@$method_stack) { |
367 | |
368 | push @$nonsugar_methods, $_ and next |
369 | unless $_->{attributes}{DBIC_method_is_indirect_sugar}; |
370 | |
371 | push @err, { |
372 | overriden => { |
373 | name => $_->{name}, |
28ef9468 |
374 | via_class => ( |
375 | # this way we report a much better Dwarn oneliner in the error |
376 | $_->{attributes}{DBIC_method_is_bypassable_resultsource_proxy} |
377 | ? 'DBIx::Class::ResultSource' |
378 | : $_->{via_class} |
379 | ), |
12e7015a |
380 | }, |
381 | by => [ map { "$_->{via_class}::$_->{name}" } @$nonsugar_methods ], |
382 | } if ( |
383 | $nonsugar_methods |
384 | and |
385 | ! $seen_shadowing_configurations->{ |
386 | join "\0", |
387 | map |
388 | { refaddr $_ } |
389 | ( |
390 | $_, |
391 | @$nonsugar_methods, |
392 | ) |
393 | }++ |
394 | ) |
395 | ; |
396 | |
397 | next METHOD_STACK; |
398 | } |
399 | } |
400 | |
401 | \@err |
402 | } |
403 | |
404 | |
405 | sub format_valid_c3_composition_errors { |
406 | # my ($self, $errors) = @_; |
407 | |
408 | [ map { sprintf( |
409 | "Class '%s' %s using the '%s' MRO affecting the lookup order of the " |
410 | . "following method(s): %s. You MUST add the following line to '%1\$s' " |
411 | . "right after strict/warnings:\n use mro 'c3';", |
412 | $_->{class}, |
413 | ( ($_->{initial_mro} eq $_->{current_mro}) ? 'is' : 'was originally' ), |
414 | $_->{initial_mro}, |
415 | join (', ', map { "$_()" } sort keys %{$_->{affected_methods}} ), |
416 | )} @{ $_[1] } ] |
417 | } |
418 | |
419 | |
420 | my $base_ISA = { |
421 | map { $_ => 1 } @{mro::get_linear_isa("DBIx::Class")} |
422 | }; |
423 | |
424 | sub check_valid_c3_composition { |
425 | my ($self, $schema) = @_; |
426 | |
427 | my @err; |
428 | |
429 | # |
430 | # A *very* involved check, to absolutely minimize false positives |
431 | # If this check returns an issue - it *better be* a real one |
432 | # |
433 | for my $class ( $self->all_schema_related_classes($schema) ) { |
434 | |
435 | my $desc = do { |
436 | no strict 'refs'; |
437 | describe_class_methods({ |
438 | class => $class, |
439 | ( ${"${class}::__INITIAL_MRO_UPON_DBIC_LOAD__"} |
440 | ? ( use_mro => ${"${class}::__INITIAL_MRO_UPON_DBIC_LOAD__"} ) |
441 | : () |
442 | ), |
443 | }) |
444 | }; |
445 | |
446 | # is there anything to check? |
447 | next unless ( |
448 | ! $desc->{mro}{is_c3} |
449 | and |
450 | $desc->{methods_with_supers} |
451 | and |
452 | my @potentially_problematic_method_stacks = |
453 | grep |
454 | { |
455 | # at least 2 variants came via inheritance (not ours) |
456 | ( |
457 | (grep { $_->{via_class} ne $class } @$_) |
458 | > |
459 | 1 |
460 | ) |
461 | and |
462 | # |
463 | # last ditch effort to skip examining an alternative mro |
464 | # IFF the entire "foreign" stack is located in the "base isa" |
465 | # |
466 | # This allows for extra efficiency (as there are several |
467 | # with_supers methods that would always be there), but more |
468 | # importantly saves one from tripping on the nonsensical yet |
469 | # begrudgingly functional (as in - no adverse effects): |
470 | # |
471 | # use base 'DBIx::Class'; |
472 | # use base 'DBIx::Class::Schema'; |
473 | # |
474 | ( |
475 | grep { |
476 | # not ours |
477 | $_->{via_class} ne $class |
478 | and |
479 | # not from the base stack either |
480 | ! $base_ISA->{$_->{via_class}} |
481 | } @$_ |
482 | ) |
483 | } |
484 | values %{ $desc->{methods_with_supers} } |
485 | ); |
486 | |
487 | my $affected_methods; |
488 | |
489 | for my $stack (@potentially_problematic_method_stacks) { |
490 | |
491 | # If we got so far - we need to see what the class would look |
492 | # like under c3 and compare, sigh |
493 | # |
494 | # Note that if the hierarchy is *really* fucked (like the above |
495 | # double-base e.g.) then recalc under 'c3' WILL FAIL, hence the |
496 | # extra eval: if we fail we report things as "jumbled up" |
497 | # |
498 | $affected_methods->{$stack->[0]{name}} = [ |
499 | map { $_->{via_class} } @$stack |
500 | ] unless dbic_internal_try { |
501 | |
502 | serialize($stack) |
503 | eq |
504 | serialize( |
505 | describe_class_methods({ class => $class, use_mro => 'c3' }) |
506 | ->{methods} |
507 | ->{$stack->[0]{name}} |
508 | ) |
509 | }; |
510 | } |
511 | |
512 | push @err, { |
513 | class => $class, |
514 | isa => $desc->{isa}, |
515 | initial_mro => $desc->{mro}{type}, |
516 | current_mro => mro::get_mro($class), |
517 | affected_methods => $affected_methods, |
518 | } if $affected_methods; |
519 | } |
520 | |
521 | \@err; |
522 | } |
523 | |
524 | |
525 | sub format_no_inheritance_crosscontamination_errors { |
526 | # my ($self, $errors) = @_; |
527 | |
528 | [ map { sprintf( |
529 | "Class '%s' registered in the role of '%s' unexpectedly inherits '%s': " |
530 | . 'you must resolve this by either removing an erroneous `use base` call ' |
531 | . "or switching to Moo(se)-style delegation (i.e. the 'handles' keyword)", |
532 | $_->{class}, |
533 | $_->{type}, |
534 | $_->{unexpectedly_inherits}, |
535 | )} @{ $_[1] } ] |
536 | } |
537 | |
538 | sub check_no_inheritance_crosscontamination { |
539 | my ($self, $schema) = @_; |
540 | |
541 | my @err; |
542 | |
543 | my $to_check = { |
544 | Schema => [ $schema ], |
545 | Storage => [ $schema->storage ], |
546 | ResultSource => [ map { $schema->source($_) } $schema->sources ], |
547 | }; |
548 | |
549 | $to_check->{ResultSet} = [ |
550 | map { $_->resultset_class } @{$to_check->{ResultSource}} |
551 | ]; |
552 | |
553 | $to_check->{Core} = [ |
554 | map { $_->result_class } @{$to_check->{ResultSource}} |
555 | ]; |
556 | |
557 | # Reduce everything to a unique sorted list of class names |
558 | $_ = [ sort( uniq( map { |
559 | ( not defined $_ ) ? () |
560 | : ( defined blessed $_ ) ? ref $_ |
561 | : $_ |
562 | } @$_ ) ) ] for values %$to_check; |
563 | |
564 | for my $group ( sort keys %$to_check ) { |
565 | for my $class ( @{ $to_check->{$group} } ) { |
566 | for my $foreign_base ( |
567 | map { "DBIx::Class::$_" } sort grep { $_ ne $group } keys %$to_check |
568 | ) { |
569 | |
570 | push @err, { |
571 | class => $class, |
572 | type => ( $group eq 'Core' ? 'ResultClass' : $group ), |
573 | unexpectedly_inherits => $foreign_base |
574 | } if $class->isa($foreign_base); |
575 | } |
576 | } |
577 | } |
578 | |
579 | \@err; |
580 | } |
581 | |
582 | 1; |
583 | |
584 | __END__ |
585 | |
586 | =head1 FURTHER QUESTIONS? |
587 | |
588 | Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>. |
589 | |
590 | =head1 COPYRIGHT AND LICENSE |
591 | |
592 | This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE> |
593 | by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can |
594 | redistribute it and/or modify it under the same terms as the |
595 | L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>. |