From: Peter Rabbitson Date: Fri, 22 Apr 2016 10:39:00 +0000 (+0200) Subject: Comprehensive diagnostic on incorrect ResultSource metadata use X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=73f54e27;p=dbsrgits%2FDBIx-Class.git Comprehensive diagnostic on incorrect ResultSource metadata use This commit is the second part of the permanent RT#107462 solution f064a2ab. Given the amount of changes to the resultsource metadata subsystem, I can not be certain that everything has been accounted for, even despite the comprehensive assertion harness added in the previous commits passing with flying colors on the entire reverse dep list detailed in c8b1011e. As Dave Howorth correctly pointed out in [1], the diagnostic of why something stopped working within the metadata subsystem is pretty daunting, especially given the ass-backward nature of DBIC's implementation of it. The (minimal but present) performance hit is deemed worth it in order to be able to present this information to downstream. One unexpected bit of good news is that none of the downstreams tested emitted the warning, which is an extra point of confidence that the main change of f064a2ab, and the even more dangerous change in 9e36e3ec are both solid. The gist here is that this: ~/devel/dbic$ perl -Ilib -It/lib -MDBICTest -e ' my $art = DBICTest->init_schema->resultset("Artist")->find(1); DBICTest::Schema::Artist->add_column("foo"); DBICTest::Schema->source("Artist")->add_columns("foo"); $art->has_column("foo"); ' now emits a comprehensive non-trappable warning along the lines of: DBIx::Class::ResultSource::Table=HASH(0x2a32660) (the metadata instance of source 'Artist') is *OUTDATED*, and does not reflect the modifications of its *ancestors* as follows: * DBIx::Class::ResultSource::Table=HASH(0x24ed770)->add_column(...) at -e line 4 * DBIx::Class::ResultSource::Table=HASH(0x2955da8)->add_columns(...) at -e line 6 Stale metadata accessed by 'getter' DBIx::Class::ResultSource::Table=HASH(0x2a32660)->has_column(...) within the callstack beginning at lib/DBIx/Class/ResultSource.pm line 231. DBIx::Class::ResultSource::get_rsrc_instance_specific_attribute(DBIx::Class::ResultSource::Table=HASH(0x2a32660), "_columns") called at (eval 95) line 2 DBIx::Class::ResultSource::_columns(DBIx::Class::ResultSource::Table=HASH(0x2a32660)) called at lib/DBIx/Class/ResultSource.pm line 732 DBIx::Class::ResultSource::has_column(DBIx::Class::ResultSource::Table=HASH(0x2a32660), "foo") called at (eval 70) line 19 DBIx::Class::ResultSourceProxy::has_column(DBICTest::Artist=HASH(0x311e338), "foo") called at -e line 8 The performance hit consistently measures in the ~1.5% range: the test suite of @frioux's DBIx::Class::Helpers v2.032002 consistently completes within roughly ~63.7 CPU seconds at the base of this branch, yet climbs to ~64.6 as of this commit (on an idle low-clocked Xeon L3426) The warning can not be disabled for the time being (aside from monkeypatching DBIC::ResultSource) - the wide-range testing indicates it only fires on real legitimate problems. Hopefully I am making the right call... [1] http://lists.scsys.co.uk/pipermail/dbix-class/2016-January/012127.html --- diff --git a/Changes b/Changes index c2bb298..45b2f87 100644 --- a/Changes +++ b/Changes @@ -12,7 +12,8 @@ Revision history for DBIx::Class all seems out of place, please file a report at once - The unique constraint info (including the primary key columns) is no longer shared between related (class and schema-level) ResultSource - instances + instances. If your app stops working with no obvious pointers, set + DBIC_ASSERT_NO_ERRONEOUS_METAINSTANCE_USE=1 to obtain extra info - Neither exception_action() nor $SIG{__DIE__} handlers are invoked on recoverable errors. This ensures that the retry logic is fully insulated from changes in control flow, as the handlers are only diff --git a/lib/DBIx/Class/Carp.pm b/lib/DBIx/Class/Carp.pm index 9474dc1..e1c83a0 100644 --- a/lib/DBIx/Class/Carp.pm +++ b/lib/DBIx/Class/Carp.pm @@ -53,11 +53,23 @@ sub __find_caller { my $fr_num = 1; # skip us and the calling carp* - my (@f, $origin); + my (@f, $origin, $eval_src); while (@f = CORE::caller($fr_num++)) { - next if - ( $f[3] eq '(eval)' or $f[3] =~ /::__ANON__$/ ); + undef $eval_src; + + next if ( + $f[2] == 0 + or + # there is no value reporting a sourceless eval frame + ( + ( $f[3] eq '(eval)' or $f[1] =~ /^\(eval \d+\)$/ ) + and + not defined ( $eval_src = (CORE::caller($fr_num))[6] ) + ) + or + $f[3] =~ /::__ANON__$/ + ); $origin ||= ( $f[3] =~ /^ (.+) :: ([^\:]+) $/x @@ -84,7 +96,7 @@ sub __find_caller { } my $site = @f # if empty - nothing matched - full stack - ? "at $f[1] line $f[2]" + ? ( "at $f[1] line $f[2]" . ( $eval_src ? "\n === BEGIN $f[1]\n$eval_src\n === END $f[1]" : '' ) ) : Carp::longmess() ; diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index d6ca1ed..f8a1661 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -6,7 +6,11 @@ use warnings; use base 'DBIx::Class::ResultSource::RowParser'; use DBIx::Class::Carp; -use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dbic_internal_try fail_on_internal_call ); +use DBIx::Class::_Util qw( + UNRESOLVABLE_CONDITION + dbic_internal_try fail_on_internal_call + refdesc emit_loud_diag +); use SQL::Abstract 'is_literal_value'; use Devel::GlobalDestruction; use Scalar::Util qw( blessed weaken isweak refaddr ); @@ -23,16 +27,16 @@ my @hashref_attributes = qw( my @arrayref_attributes = qw( _ordered_columns _primaries ); -__PACKAGE__->mk_group_accessors(simple => +__PACKAGE__->mk_group_accessors(rsrc_instance_specific_attribute => @hashref_attributes, @arrayref_attributes, qw( source_name name column_info_from_storage sqlt_deploy_callback ), ); -__PACKAGE__->mk_group_accessors(component_class => qw/ +__PACKAGE__->mk_group_accessors(rsrc_instance_specific_handler => qw( resultset_class result_class -/); +)); =head1 NAME @@ -200,7 +204,7 @@ Creates a new ResultSource object. Not normally called directly by end users. $self->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook'; $self->{$_} = { %{ $self->{$_} || {} } } - for @hashref_attributes; + for @hashref_attributes, '__metadata_divergencies'; $self->{$_} = [ @{ $self->{$_} || [] } ] for @arrayref_attributes; @@ -217,6 +221,228 @@ Creates a new ResultSource object. Not normally called directly by end users. } values %$r } } + + + # needs direct access to $rsrc_registry under an assert + # + sub set_rsrc_instance_specific_attribute { + + # only mark if we are setting something different + if ( + ( + defined( $_[2] ) + xor + defined( $_[0]->{$_[1]} ) + ) + or + ( + # both defined + defined( $_[2] ) + and + ( + # differ in ref-ness + ( + length ref( $_[2] ) + xor + length ref( $_[0]->{$_[1]} ) + ) + or + # both refs (the mark-on-same-ref is deliberate) + length ref( $_[2] ) + or + # both differing strings + $_[2] ne $_[0]->{$_[1]} + ) + ) + ) { + + my $callsite; + # need to protect $_ here + for my $derivative ( + $_[0]->__derived_instances, + + # DO NOT REMOVE - this blob is marking *ancestors* as tainted, here to + # weed out any fallout from https://github.com/dbsrgits/dbix-class/commit/9e36e3ec + # Note that there is no way to kill this warning, aside from never + # calling set_primary_key etc more than once per hierarchy + # (this is why the entire thing is guarded by an assert) + ( + ( + DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE + and + grep { $_[1] eq $_ } qw( _unique_constraints _primaries source_info ) + ) + ? ( + map + { defined($_->{weakref}) ? $_->{weakref} : () } + grep + { defined( ( $_->{derivatives}{refaddr($_[0])} || {} )->{weakref} ) } + values %$rsrc_registry + ) + : () + ), + ) { + + $derivative->{__metadata_divergencies}{$_[1]}{ $callsite ||= do { + + # + # FIXME - this is horrible, but it's the best we can do for now + # Replace when Carp::Skip is written (it *MUST* take this use-case + # into consideration) + # + my ($cs) = DBIx::Class::Carp::__find_caller(__PACKAGE__); + + my ($fr_num, @fr) = 1; + while( @fr = CORE::caller($fr_num++) ) { + $cs =~ /^ \Qat $fr[1] line $fr[2]\E (?: $ | \n )/x + and + $fr[3] =~ s/.+::// + and + last + } + + # FIXME - using refdesc here isn't great, but I can't think of anything + # better at this moment + @fr + ? "@{[ refdesc $_[0] ]}->$fr[3](...) $cs" + : "$cs" + ; + } } = 1; + } + } + + $_[0]->{$_[1]} = $_[2]; + } +} + +sub get_rsrc_instance_specific_attribute { + + $_[0]->__emit_stale_metadata_diag( $_[1] ) if ( + ! $_[0]->{__in_rsrc_setter_callstack} + and + $_[0]->{__metadata_divergencies}{$_[1]} + ); + + $_[0]->{$_[1]}; +} + + +# reuse the elaborate set logic of instance_specific_attr +sub set_rsrc_instance_specific_handler { + $_[0]->set_rsrc_instance_specific_attribute($_[1], $_[2]); + + # trigger a load for the case of $foo->handler_accessor("bar")->new + $_[0]->get_rsrc_instance_specific_handler($_[1]) + if defined wantarray; +} + +# This is essentially the same logic as get_component_class +# (in DBIC::AccessorGroup). However the latter is a grouped +# accessor type, and here we are strictly after a 'simple' +# So we go ahead and recreate the logic as found in ::AG +sub get_rsrc_instance_specific_handler { + + # emit desync warnings if any + my $val = $_[0]->get_rsrc_instance_specific_attribute( $_[1] ); + + # plain string means class - load it + no strict 'refs'; + if ( + defined $val + and + # inherited CAG can't be set to undef effectively, so people may use '' + length $val + and + ! defined blessed $val + and + ! ${"${val}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"} + ) { + $_[0]->ensure_class_loaded($val); + + ${"${val}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"} + = do { \(my $anon = 'loaded') }; + } + + $val; +} + + +sub __construct_stale_metadata_diag { + return '' unless $_[0]->{__metadata_divergencies}{$_[1]}; + + my ($fr_num, @fr); + + # find the CAG getter FIRST + # allows unlimited user-namespace overrides without screwing around with + # $LEVEL-like crap + while( + @fr = CORE::caller(++$fr_num) + and + $fr[3] ne 'DBIx::Class::ResultSource::get_rsrc_instance_specific_attribute' + ) { 1 } + + Carp::confess( "You are not supposed to call __construct_stale_metadata_diag here..." ) + unless @fr; + + # then find the first non-local, non-private reportable callsite + while ( + @fr = CORE::caller(++$fr_num) + and + ( + $fr[2] == 0 + or + $fr[3] eq '(eval)' + or + $fr[1] =~ /^\(eval \d+\)$/ + or + $fr[3] =~ /::(?: __ANON__ | _\w+ )$/x + or + $fr[0] =~ /^DBIx::Class::ResultSource/ + ) + ) { 1 } + + my $by = ( @fr and $fr[3] =~ s/.+::// ) + # FIXME - using refdesc here isn't great, but I can't think of anything + # better at this moment + ? " by 'getter' @{[ refdesc $_[0] ]}->$fr[3](...)\n within the callstack beginning" + : '' + ; + + # Given the full stacktrace combined with the really involved callstack + # there is no chance the emitter will properly deduplicate this + # Only complain once per callsite per source + return( ( $by and $_[0]->{__encountered_divergencies}{$by}++ ) + + ? '' + + : "$_[0] (the metadata instance of source '@{[ $_[0]->source_name ]}') is " + . "*OUTDATED*, and does not reflect the modifications of its " + . "*ancestors* as follows:\n" + . join( "\n", + map + { " * $_->[0]" } + sort + { $a->[1] cmp $b->[1] } + map + { [ $_, ( $_ =~ /( at .+? line \d+)/ ) ] } + keys %{ $_[0]->{__metadata_divergencies}{$_[1]} } + ) + . "\nStale metadata accessed${by}" + ); +} + +sub __emit_stale_metadata_diag { + emit_loud_diag( + msg => ( + # short circuit: no message - no diag + $_[0]->__construct_stale_metadata_diag($_[1]) + || + return 0 + ), + # the constructor already does deduplication + emit_dups => 1, + confess => DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE, + ); } =head2 clone @@ -443,6 +669,10 @@ info keys as L. sub add_columns { my ($self, @cols) = @_; + + local $self->{__in_rsrc_setter_callstack} = 1 + unless $self->{__in_rsrc_setter_callstack}; + $self->_ordered_columns(\@cols) unless $self->_ordered_columns; my ( @added, $colinfos ); @@ -470,6 +700,7 @@ sub add_columns { } push @{ $self->_ordered_columns }, @added; + $self->_columns($columns); return $self; } @@ -666,6 +897,9 @@ broken result source. sub remove_columns { my ($self, @to_remove) = @_; + local $self->{__in_rsrc_setter_callstack} = 1 + unless $self->{__in_rsrc_setter_callstack}; + my $columns = $self->_columns or return; @@ -710,6 +944,9 @@ for more info. sub set_primary_key { my ($self, @cols) = @_; + local $self->{__in_rsrc_setter_callstack} = 1 + unless $self->{__in_rsrc_setter_callstack}; + my $colinfo = $self->columns_info(\@cols); for my $col (@cols) { carp_unique(sprintf ( @@ -792,6 +1029,9 @@ will be applied to the L of each L sub sequence { my ($self,$seq) = @_; + local $self->{__in_rsrc_setter_callstack} = 1 + unless $self->{__in_rsrc_setter_callstack}; + my @pks = $self->primary_columns or return; @@ -838,6 +1078,9 @@ the result source. sub add_unique_constraint { my $self = shift; + local $self->{__in_rsrc_setter_callstack} = 1 + unless $self->{__in_rsrc_setter_callstack}; + if (@_ > 2) { $self->throw_exception( 'add_unique_constraint() does not accept multiple constraints, use ' @@ -1329,10 +1572,11 @@ result source instance has been attached to. sub schema { if (@_ > 1) { - $_[0]->{schema} = $_[1]; + # invoke the mark-diverging logic + $_[0]->set_rsrc_instance_specific_attribute( schema => $_[1] ); } else { - $_[0]->{schema} || do { + $_[0]->get_rsrc_instance_specific_attribute( 'schema' ) || do { my $name = $_[0]->{source_name} || '_unnamed_'; my $err = 'Unable to perform storage-dependent operations with a detached result source ' . "(source '$name' is not associated with a schema)."; @@ -1448,6 +1692,10 @@ be resolved. sub add_relationship { my ($self, $rel, $f_source_name, $cond, $attrs) = @_; + + local $self->{__in_rsrc_setter_callstack} = 1 + unless $self->{__in_rsrc_setter_callstack}; + $self->throw_exception("Can't create relationship without join condition") unless $cond; $attrs ||= {}; diff --git a/lib/DBIx/Class/ResultSource/View.pm b/lib/DBIx/Class/ResultSource/View.pm index ede6d1d..818295e 100644 --- a/lib/DBIx/Class/ResultSource/View.pm +++ b/lib/DBIx/Class/ResultSource/View.pm @@ -5,8 +5,9 @@ use warnings; use base 'DBIx::Class::ResultSource'; -__PACKAGE__->mk_group_accessors( - 'simple' => qw(is_virtual view_definition deploy_depends_on) ); +__PACKAGE__->mk_group_accessors( rsrc_instance_specific_attribute => qw( + is_virtual view_definition deploy_depends_on +)); =head1 NAME diff --git a/lib/DBIx/Class/ResultSourceHandle.pm b/lib/DBIx/Class/ResultSourceHandle.pm index b9b54bf..169cb4a 100644 --- a/lib/DBIx/Class/ResultSourceHandle.pm +++ b/lib/DBIx/Class/ResultSourceHandle.pm @@ -116,7 +116,12 @@ sub STORABLE_thaw { $self->schema( $s ); } else { - $rs->source_name( $self->source_moniker ); + # FIXME do not use accessor here - will trigger the divergent meta logic + # Ideally this should be investigated and fixed properly, but the + # codepath is so obscure, and the trigger point (t/52leaks.t) so bizarre + # that... meh. + $rs->{source_name} = $self->source_moniker; + $rs->{_detached_thaw} = 1; $self->_detached_source( $rs ); } diff --git a/lib/DBIx/Class/ResultSourceProxy/Table.pm b/lib/DBIx/Class/ResultSourceProxy/Table.pm index 53dd26f..b0c4343 100644 --- a/lib/DBIx/Class/ResultSourceProxy/Table.pm +++ b/lib/DBIx/Class/ResultSourceProxy/Table.pm @@ -93,6 +93,29 @@ sub table { : undef ; + # Folks calling ->table on a class *might* expect the name + # to shift everywhere, but that can't happen + # So what we do is mark the ancestor as "dirty" + # even though it will have no "derived" link to the one we + # will use afterwards + if( + defined $ancestor + and + $ancestor->name ne $table + and + scalar $ancestor->__derived_instances + ) { + # Trigger the "descendants are dirty" logic, without giving + # it an explicit externally-callable interface + # This is ugly as sin, but likely saner in the long run + local $ancestor->{__in_rsrc_setter_callstack} = 1 + unless $ancestor->{__in_rsrc_setter_callstack}; + my $old_name = $ancestor->name; + $ancestor->set_rsrc_instance_specific_attribute( name => "\0" ); + $ancestor->set_rsrc_instance_specific_attribute( name => $old_name ); + } + + my $table_class = $class->table_class; $class->ensure_class_loaded($table_class); diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index c459c73..7f3549d 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -411,7 +411,10 @@ sub emit_loud_diag { exit 70; } - my $msg = "\n$0: $args->{msg}"; + my $msg = "\n" . join( ': ', + ( $0 eq '-e' ? () : $0 ), + $args->{msg} + ); # when we die - we usually want to keep doing it $args->{emit_dups} = !!$args->{confess} diff --git a/xt/dist/pod_coverage.t b/xt/dist/pod_coverage.t index 004f35e..e2389af 100644 --- a/xt/dist/pod_coverage.t +++ b/xt/dist/pod_coverage.t @@ -67,6 +67,10 @@ my $exceptions = { resolve_prefetch STORABLE_freeze STORABLE_thaw + get_rsrc_instance_specific_attribute + set_rsrc_instance_specific_attribute + get_rsrc_instance_specific_handler + set_rsrc_instance_specific_handler /], }, 'DBIx::Class::ResultSet' => { diff --git a/xt/extra/diagnostics/divergent_metadata.t b/xt/extra/diagnostics/divergent_metadata.t new file mode 100644 index 0000000..67e9bea --- /dev/null +++ b/xt/extra/diagnostics/divergent_metadata.t @@ -0,0 +1,97 @@ +BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } + +# things will die if this is set +BEGIN { $ENV{DBIC_ASSERT_NO_ERRONEOUS_METAINSTANCE_USE} = 0 } + +use strict; +use warnings; + +use Test::More; + +use DBICTest::Util 'capture_stderr'; +use DBICTest; + +my ($fn) = __FILE__ =~ /( [^\/\\]+ ) $/x; +my @divergence_lines; + +my $art = DBICTest->init_schema->resultset("Artist")->find(1); + +push @divergence_lines, __LINE__ + 1; +DBICTest::Schema::Artist->add_columns("Something_New"); + +push @divergence_lines, __LINE__ + 1; +$_->add_column("Something_New_2") for grep + { $_ != $art->result_source } + DBICTest::Schema::Artist->result_source_instance->__derived_instances +; + +push @divergence_lines, __LINE__ + 1; +DBICTest::Schema::Artist->result_source_instance->name("foo"); + +my $orig_class_rsrc_before_table_triggered_reinit = DBICTest::Schema::Artist->result_source_instance; + +push @divergence_lines, __LINE__ + 1; +DBICTest::Schema::Artist->table("bar"); + +is( + capture_stderr { + ok( + DBICTest::Schema::Artist->has_column( "Something_New" ), + 'Added column visible' + ); + + ok( + (! DBICTest::Schema::Artist->has_column( "Something_New_2" ) ), + 'Column added on children not visible' + ); + }, + '', + 'No StdErr output during rsrc augmentation' +); + +my $err = capture_stderr { + ok( + ! $art->has_column($_), + "Column '$_' not visible on @{[ $art->table ]}" + ) for qw(Something_New Something_New_2); +}; + +# Tricky text - check it painstakingly as things may go off +# in very subtle ways +my $expected_warning_1 = join '.+?', map { quotemeta $_ } + "@{[ $art->result_source ]} (the metadata instance of source 'Artist') is *OUTDATED*", + + "${orig_class_rsrc_before_table_triggered_reinit}->add_columns(...) at", + "$fn line $divergence_lines[0]", + + "@{[ DBICTest::Schema->source('Artist') ]}->add_column(...) at", + "$fn line $divergence_lines[1]", + + "Stale metadata accessed by 'getter' @{[ $art->result_source ]}->has_column(...)", +; + +like + $err, + qr/$expected_warning_1/s, + 'Correct warning on diverged metadata' +; + +my $expected_warning_2 = join '.+?', map { quotemeta $_ } + "@{[ $art->result_source ]} (the metadata instance of source 'Artist') is *OUTDATED*", + + "${orig_class_rsrc_before_table_triggered_reinit}->name(...) at", + "$fn line $divergence_lines[2]", + + "${orig_class_rsrc_before_table_triggered_reinit}->table(...) at", + "$fn line $divergence_lines[3]", + + "Stale metadata accessed by 'getter' @{[ $art->result_source ]}->table(...)", +; + +like + $err, + qr/$expected_warning_2/s, + 'Correct warning on diverged metadata' +; + +done_testing;