From: Peter Rabbitson Date: Fri, 29 Jan 2010 12:00:54 +0000 (+0000) Subject: Fugly 5.8 workaround X-Git-Tag: v0.08116~19 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7146f619b7cab9b997cf9aa3e43f87306b19fcc0;p=dbsrgits%2FDBIx-Class.git Fugly 5.8 workaround --- diff --git a/lib/DBIx/Class/Componentised.pm b/lib/DBIx/Class/Componentised.pm index 7b6813e..5a59238 100644 --- a/lib/DBIx/Class/Componentised.pm +++ b/lib/DBIx/Class/Componentised.pm @@ -17,18 +17,24 @@ sub inject_base { no strict 'refs'; for my $comp (reverse @_) { - if ( - $comp->isa ('DBIx::Class::UTF8Columns') - and - my @broken = grep { $_ ne 'DBIx::Class::Row' and defined ${"${_}::"}{store_column} } (@present_components) - ) { + + if ($comp->isa ('DBIx::Class::UTF8Columns') ) { + require B; + my @broken; + + for (@present_components) { + my $cref = $_->can ('store_column') + or next; + push @broken, $_ if B::svref_2object($cref)->STASH->NAME ne 'DBIx::Class::Row'; + } + carp "Incorrect loading order of $comp by ${target} will affect other components overriding store_column (" . join (', ', @broken) - .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info'; - } - else { - unshift @present_components, $comp; + .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info' + if @broken; } + + unshift @present_components, $comp; } $class->next::method($target, @_); diff --git a/lib/DBIx/Class/Core.pm b/lib/DBIx/Class/Core.pm index 99e1624..a7e5f59 100644 --- a/lib/DBIx/Class/Core.pm +++ b/lib/DBIx/Class/Core.pm @@ -2,7 +2,6 @@ package DBIx::Class::Core; use strict; use warnings; -no warnings 'qw'; use base qw/DBIx::Class/; @@ -12,7 +11,8 @@ __PACKAGE__->load_components(qw/ PK::Auto PK Row - ResultSourceProxy::Table/); + ResultSourceProxy::Table +/); 1; diff --git a/t/85utf8.t b/t/85utf8.t index 08b91b7..fbba764 100644 --- a/t/85utf8.t +++ b/t/85utf8.t @@ -7,22 +7,23 @@ use lib qw(t/lib); use DBICTest; use utf8; -warning_like (sub { - - package A::Comp; - use base 'DBIx::Class'; - sub store_column { shift->next::method (@_) }; - 1; - - package A::Test; - use base 'DBIx::Class::Core'; - __PACKAGE__->load_components(qw(UTF8Columns +A::Comp)); - 1; -}, qr/Incorrect loading order of DBIx::Class::UTF8Columns.+affect other components overriding store_column \(A::Comp\)/ ); - +warning_like ( + sub { + package A::Comp; + use base 'DBIx::Class'; + sub store_column { shift->next::method (@_) }; + 1; + + package A::Test; + use base 'DBIx::Class::Core'; + __PACKAGE__->load_components(qw(UTF8Columns +A::Comp)); + 1; + }, + qr/Incorrect loading order of DBIx::Class::UTF8Columns.+affect other components overriding store_column \(A::Comp\)/, + 'incorrect order warning issued', +); my $schema = DBICTest->init_schema(); - DBICTest::Schema::CD->load_components('UTF8Columns'); DBICTest::Schema::CD->utf8_columns('title'); Class::C3->reinitialize();