Make result_source a straight wrapper around result_source_instance. This
should fix all the fallout introduced in 0.082800 (
4006691d), which sadly
went undetected all the way until ~7 months after its release. Ultimately
this is my fault, as I had an early warning, and even later made a conjecture
which spot exactly may blow up in my face (read towards end of
350e8d57)
Exploit the fact that result_source_instance until very recently was a toss-up
between a CAG 'inherited' and a Class::Data::Inheritable (removed in
5e0eea35)
with CAG not really involved in result-instance level calls, and the latter
making it downright impractical due to the closure-based approach. Combined
with the fact that result_source was a 'simple'-type accessor pointing at
the '_result_source' hash-slot allows us (at least seemingly) to switch to a
setup where result_source is nothing but a wrapper around a CAG inherited
accessor result_source_instance which point to the named slot '_result_source'
The changeset is deceptively small, and is kept this way for easier auditing.
See next commit for the armada of additional testing to verify the entire
stack is in fact still solid.
specific DateTime::Format dependencies
* Fixes
+ - Fix regresion (0.082800) of certain calls being presented stale
+ result source metadata (RT#107462)
- Fix incorrect SQL generated with invalid {rows} on complex resultset
operations, generally more robust handling of rows/offset attrs
- Fix incorrect $storage state on unexpected RDBMS disconnects and
sub _init_result_source_instance {
my $class = shift;
- $class->mk_group_accessors( inherited => 'result_source_instance' )
+ $class->mk_group_accessors( inherited => [ result_source_instance => '_result_source' ] )
unless $class->can('result_source_instance');
# might be pre-made for us courtesy of DBIC::DB::result_source_instance()
});
}
- $class->mk_group_accessors(inherited => 'result_source_instance')
+ $class->mk_group_accessors( inherited => [ result_source_instance => '_result_source' ] )
unless $class->can('result_source_instance');
$class->result_source_instance($table)->name;
=cut
sub result_source {
- $_[0]->throw_exception( 'result_source can be called on instances only' )
- unless ref $_[0];
-
- @_ > 1
- ? $_[0]->{_result_source} = $_[1]
-
- # note this is a || not a ||=, the difference is important
- : $_[0]->{_result_source} || do {
- $_[0]->can('result_source_instance')
- ? $_[0]->result_source_instance
- : $_[0]->throw_exception(
- "No result source instance registered for @{[ ref $_[0] ]}, did you forget to call @{[ ref $_[0] ]}->table(...) ?"
- )
- }
- ;
+ # this is essentially a `shift->result_source_instance(@_)` with handholding
+ &{
+ $_[0]->can('result_source_instance')
+ ||
+ $_[0]->throw_exception(
+ "No result source instance registered for '@{[ $_[0] ]}', did you forget to call @{[ ref $_[0] || $_[0] ]}->table(...) ?"
+ )
+ };
}
=head2 register_column
my $source = $schema->source($source_name);
my $class = $source->result_class;
#warn "$source_name $class $source ".$source->storage;
- $class->mk_classaccessor(result_source_instance => $source);
+
+ $class->mk_group_accessors( inherited => [ result_source_instance => '_result_source' ] );
+ # explicit set-call, avoid mro update lag
+ $class->set_inherited( result_source_instance => $source );
+
$class->mk_classaccessor(resultset_instance => $source->resultset);
$class->mk_classaccessor(class_resolver => $schema);
}
--- /dev/null
+BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use DBICTest;
+
+my $ar = DBICTest->init_schema->resultset("Artist")->find(1);
+
+ok (! $ar->can("not_yet_there_column"), "No accessor for nonexitentcolumn" );
+
+$ar->add_column("not_yet_there_column");
+ok ($ar->has_column("not_yet_there_column"), "Metadata correct after nonexitentcolumn addition" );
+ok ($ar->can("not_yet_there_column"), "Accessor generated for nonexitentcolumn" );
+
+$ar->not_yet_there_column('I EXIST \o/');
+
+is { $ar->get_columns }->{not_yet_there_column}, 'I EXIST \o/', "Metadata propagates to mutli-column methods";
+
+done_testing;
--- /dev/null
+BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
+
+use strict;
+use warnings;
+no warnings 'qw';
+
+use Test::More;
+
+use DBICTest;
+
+my $schema = DBICTest->init_schema;
+my $rsrc = $schema->source("Artist");
+
+is( (eval($_)||die $@), $rsrc, "Same source object after $_" ) for qw(
+ $rsrc->resultset->result_source,
+ $rsrc->resultset->next->result_source,
+ $rsrc->resultset->next->result_source_instance,
+ $schema->resultset("Artist")->result_source,
+ $schema->resultset("Artist")->next->result_source,
+ $schema->resultset("Artist")->next->result_source_instance,
+);
+
+done_testing;