SQL areas ( group_by => \[ ... ] now works properly )
- Allow populate to skip empty has_many relationships which makes
it easier to pass HashRefInflator data directly to ->populate
+ - Improve freeze/thaw semantics and error messages (RT#62546)
* Misc
- Fix test warning on win32 - at this point the test suite is
return $fresh_rs->search( {}, {
from => [{
$attrs->{alias} => $self->as_query,
- -alias => $attrs->{alias},
- -source_handle => $self->result_source->handle,
+ -alias => $attrs->{alias},
+ -rsrc => $self->result_source,
}],
alias => $attrs->{alias},
});
);
$from = [{
- -source_handle => $source->handle,
- -alias => $attrs->{alias},
+ -rsrc => $source,
+ -alias => $attrs->{alias},
$attrs->{alias} => $rs_copy->as_query,
}];
delete @{$attrs}{@force_subq_attrs, qw/where bind/};
}
else {
$from = [{
- -source_handle => $source->handle,
+ -rsrc => $source,
-alias => $attrs->{alias},
$attrs->{alias} => $source->from,
}];
$attrs->{as} = \@as;
$attrs->{from} ||= [{
- -source_handle => $source->handle,
- -alias => $self->{attrs}{alias},
+ -rsrc => $source,
+ -alias => $self->{attrs}{alias},
$self->{attrs}{alias} => $source->from,
}];
# A cursor in progress can't be serialized (and would make little sense anyway)
delete $to_serialize->{cursor};
- return nfreeze($to_serialize);
+ nfreeze($to_serialize);
}
# need this hook for symmetry
%$self = %{ thaw($serialized) };
- return $self;
+ $self;
}
__PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
_columns _primaries _unique_constraints name resultset_attributes
- schema from _relationships column_info_from_storage source_info
+ from _relationships column_info_from_storage source_info
source_name sqlt_deploy_callback/);
__PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
if ( ! $self->_columns->{$column}{data_type}
and ! $self->{_columns_info_loaded}
and $self->column_info_from_storage
- and $self->schema and my $stor = $self->storage )
+ and my $stor = try { $self->storage } )
{
$self->{_columns_info_loaded}++;
and
$self->column_info_from_storage
and
- $self->schema
- and
- my $stor = $self->storage
+ my $stor = try { $self->storage }
) {
$self->{_columns_info_loaded}++;
'call it on the schema instead.'
) if scalar @_;
- return $self->resultset_class->new(
+ $self->resultset_class->new(
$self,
{
+ try { %{$self->schema->default_resultset_attributes} },
%{$self->{resultset_attributes}},
- %{$self->schema->default_resultset_attributes}
},
);
}
=over 4
-=item Arguments: None
+=item Arguments: $schema
=item Return value: A schema object
my $schema = $source->schema();
-Returns the L<DBIx::Class::Schema> object that this result source
-belongs to.
+Sets and/or returns the L<DBIx::Class::Schema> object to which this
+result source instance has been attached to.
+
+=cut
+
+sub schema {
+ if (@_ > 1) {
+ $_[0]->{schema} = $_[1];
+ }
+ else {
+ $_[0]->{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).";
+
+ $err .= ' You need to use $schema->thaw() or manually set'
+ . ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.'
+ if $_[0]->{_detached_thaw};
+
+ DBIx::Class::Exception->throw($err);
+ };
+ }
+}
=head2 storage
my $rel_src = $self->related_source($join);
return [ { $as => $rel_src->from,
- -source_handle => $rel_src->handle,
+ -rsrc => $rel_src,
-join_type => $parent_force_left
? 'left'
: $rel_info->{attrs}{join_type}
=head2 handle
-Obtain a new handle to this source. Returns an instance of a
-L<DBIx::Class::ResultSourceHandle>.
+=over 4
+
+=item Arguments: None
+
+=item Return value: $source_handle
+
+=back
+
+Obtain a new L<result source handle instance|DBIx::Class::ResultSourceHandle>
+for this source. Used as a serializable pointer to this resultsource, as it is not
+easy (nor advisable) to serialize CODErefs which may very well be present in e.g.
+relationship definitions.
=cut
sub handle {
- return DBIx::Class::ResultSourceHandle->new({
- schema => $_[0]->schema,
- source_moniker => $_[0]->source_name
- });
+ return DBIx::Class::ResultSourceHandle->new({
+ source_moniker => $_[0]->source_name,
+
+ # so that a detached thaw can be re-frozen
+ $_[0]->{_detached_thaw}
+ ? ( _detached_source => $_[0] )
+ : ( schema => $_[0]->schema )
+ ,
+ });
}
{
}
}
-sub STORABLE_freeze {
- my ($self, $cloning) = @_;
- nfreeze($self->handle);
-}
+sub STORABLE_freeze { nfreeze($_[0]->handle) }
sub STORABLE_thaw {
my ($self, $cloning, $ice) = @_;
%$self = %{ (thaw $ice)->resolve };
}
-
-
=head2 throw_exception
See L<DBIx::Class::Schema/"throw_exception">.
sub throw_exception {
my $self = shift;
- if (defined $self->schema) {
- $self->schema->throw_exception(@_);
- }
- else {
- DBIx::Class::Exception->throw(@_);
- }
+ $self->{schema}
+ ? $self->{schema}->throw_exception(@_)
+ : DBIx::Class::Exception->throw(@_)
+ ;
}
=head2 source_info
use strict;
use warnings;
-use Storable;
-use Carp;
use base qw/DBIx::Class/;
+use Storable qw/nfreeze thaw/;
+use DBIx::Class::Exception;
+use Try::Tiny;
+
+use namespace::clean;
+
use overload
# on some RH perls the following line causes serious performance problem
# see https://bugzilla.redhat.com/show_bug.cgi?id=196836
q/""/ => sub { __PACKAGE__ . ":" . shift->source_moniker; },
fallback => 1;
-__PACKAGE__->mk_group_accessors('simple' => qw/schema source_moniker/);
+__PACKAGE__->mk_group_accessors('simple' => qw/schema source_moniker _detached_source/);
# Schema to use when thawing.
our $thaw_schema;
=head1 NAME
-DBIx::Class::ResultSourceHandle - Decouple Rows/ResultSets objects from their Source objects
+DBIx::Class::ResultSourceHandle - Serializable pointers to ResultSource instances
=head1 DESCRIPTION
-This module removes fixed link between Rows/ResultSets and the actual source
-objects, which gets round the following problems
-
-=over 4
-
-=item *
-
-Needing to keep C<$schema> in scope, since any objects/result_sets
-will have a C<$schema> object through their source handle
-
-=item *
+Currently instances of this class are used to allow proper serialization of
+L<ResultSources|DBIx::Class::ResultSource> (which may contain unserializable
+elements like C<CODE> references).
-Large output when using Data::Dump(er) since this class can be set to
-stringify to almost nothing
-
-=back
+Originally this module was used to remove the fixed link between
+L<Rows|DBIx::Class::Row>/L<ResultSets|DBIx::Class::ResultSet> and the actual
+L<result source objects|DBIx::Class::ResultSource> in order to obviate the need
+of keeping a L<schema instance|DBIx::Class::Schema> constantly in scope, while
+at the same time avoiding leaks due to circular dependencies. This is however
+no longer needed after introduction of a proper mutual-assured-destruction
+contract between a C<Schema> instance and its C<ResultSource> registrants.
=head1 METHODS
=cut
sub new {
- my ($class, $data) = @_;
+ my ($class, $args) = @_;
+ my $self = bless $args, ref $class || $class;
- $class = ref $class if ref $class;
+ unless( ($self->{schema} || $self->{_detached_source}) && $self->{source_moniker} ) {
+ my $err = 'Expecting a schema instance and a source moniker';
+ $self->{schema}
+ ? $self->{schema}->throw_exception($err)
+ : DBIx::Class::Exception->throw($err)
+ }
- bless $data, $class;
+ $self;
}
=head2 resolve
=cut
-sub resolve { return $_[0]->schema->source($_[0]->source_moniker) }
+sub resolve {
+ return $_[0]->{schema}->source($_[0]->source_moniker) if $_[0]->{schema};
+
+ $_[0]->_detached_source || DBIx::Class::Exception->throw( sprintf (
+ # vague error message as this is never supposed to happen
+ "Unable to resolve moniker '%s' - please contact the dev team at %s",
+ $_[0]->source_moniker,
+ 'http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT',
+ ), 'full_stacktrace');
+}
=head2 STORABLE_freeze
=cut
sub STORABLE_freeze {
- my ($self, $cloning) = @_;
+ my ($self, $cloning) = @_;
- my $to_serialize = { %$self };
+ my $to_serialize = { %$self };
- delete $to_serialize->{schema};
- $to_serialize->{_frozen_from_class} = $self->schema->class($self->source_moniker);
+ delete $to_serialize->{schema};
+ delete $to_serialize->{_detached_source};
+ $to_serialize->{_frozen_from_class} = $self->{schema}
+ ? $self->{schema}->class($self->source_moniker)
+ : $self->{_detached_source}->result_class
+ ;
- return (Storable::nfreeze($to_serialize));
+ nfreeze($to_serialize);
}
=head2 STORABLE_thaw
=cut
-
sub STORABLE_thaw {
- my ($self, $cloning, $ice) = @_;
- %$self = %{ Storable::thaw($ice) };
-
- my $class = delete $self->{_frozen_from_class};
- if( $thaw_schema ) {
- $self->{schema} = $thaw_schema;
+ my ($self, $cloning, $ice) = @_;
+ %$self = %{ thaw($ice) };
+
+ my $from_class = delete $self->{_frozen_from_class};
+
+ if( $thaw_schema ) {
+ $self->schema( $thaw_schema );
+ }
+ elsif( my $rs = $from_class->result_source_instance ) {
+ # in the off-chance we are using CDBI-compat and have leaked $schema already
+ if( my $s = try { $rs->schema } ) {
+ $self->schema( $s );
}
else {
- my $rs = $class->result_source_instance;
- $self->{schema} = $rs->schema if $rs;
+ $rs->source_name( $self->source_moniker );
+ $rs->{_detached_thaw} = 1;
+ $self->_detached_source( $rs );
}
-
- carp "Unable to restore schema. Look at 'freeze' and 'thaw' methods in DBIx::Class::Schema."
- unless $self->{schema};
+ }
+ else {
+ DBIx::Class::Exception->throw(
+ "Thaw failed - original result class '$from_class' does not exist on this system"
+ );
+ }
}
=head1 AUTHOR
$class->ensure_class_loaded($table_class);
$table = $table_class->new({
- $class->can('result_source_instance') ?
- %{$class->result_source_instance||{}} : (),
+ $class->can('result_source_instance')
+ ? %{$class->result_source_instance||{}}
+ : ()
+ ,
name => $table,
result_class => $class,
- source_name => undef,
});
}
my $new = bless { _column_data => {} }, $class;
- my $source =
- delete $attrs->{-result_source}
- or
- ( $attrs->{-source_handle} and (delete $attrs->{-source_handle})->resolve )
- ;
- $new->result_source($source) if $source;
-
- if (my $related = delete $attrs->{-cols_from_relations}) {
- @{$new->{_ignore_at_insert}={}}{@$related} = ();
- }
-
if ($attrs) {
$new->throw_exception("attrs must be a hashref")
unless ref($attrs) eq 'HASH';
+ my $source = delete $attrs->{-result_source};
+ if ( my $h = delete $attrs->{-source_handle} ) {
+ $source ||= $h->resolve;
+ }
+
+ $new->result_source($source) if $source;
+
+ if (my $col_from_rel = delete $attrs->{-cols_from_relations}) {
+ @{$new->{_ignore_at_insert}={}}{@$col_from_rel} = ();
+ }
+
my ($related,$inflated);
foreach my $key (keys %$attrs) {
sub throw_exception {
my $self=shift;
- if (ref $self && ref $self->result_source && $self->result_source->schema) {
- $self->result_source->schema->throw_exception(@_)
+ if (ref $self && ref $self->result_source ) {
+ $self->result_source->throw_exception(@_)
}
else {
DBIx::Class::Exception->throw(@_);
? $requested_order
: [ map
{ "$rs_attrs->{alias}.$_" }
- ( $rs_attrs->{_rsroot_source_handle}->resolve->_pri_cols )
+ ( $rs_attrs->{_rsroot_rsrc}->_pri_cols )
]
);
sub _GenericSubQ {
my ($self, $sql, $rs_attrs, $rows, $offset) = @_;
- my $root_rsrc = $rs_attrs->{_rsroot_source_handle}->resolve;
+ my $root_rsrc = $rs_attrs->{_rsroot_rsrc};
my $root_tbl_name = $root_rsrc->name;
# mangle the input sql as we will be replacing the selector
my ($self, $cloning) = @_;
my $to_serialize = { %$self };
- # The source is either derived from _source_handle or is
- # reattached in the thaw handler below
- delete $to_serialize->{result_source};
-
# Dynamic values, easy to recalculate
delete $to_serialize->{$_} for qw/related_resultsets _inflated_column/;
my ($self, $cloning, $serialized) = @_;
%$self = %{ Storable::thaw($serialized) };
-
- # if the handle went missing somehow, reattach
- $self->result_source($self->result_source_instance)
- if !$self->_source_handle && $self->can('result_source_instance');
}
1;
from => $ident,
where => $where,
$rs_alias && $alias2source->{$rs_alias}
- ? ( _rsroot_source_handle => $alias2source->{$rs_alias}->handle )
+ ? ( _rsroot_rsrc => $alias2source->{$rs_alias} )
: ()
,
};
+{
-alias => $attrs->{alias},
- -source_handle => $inner_from->[0]{-source_handle},
+ -rsrc => $inner_from->[0]{-rsrc},
$attrs->{alias} => $subq,
};
};
$tabinfo = $_->[0];
}
- $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-source_handle}->resolve
- if ($tabinfo->{-source_handle});
+ $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-rsrc}
+ if ($tabinfo->{-rsrc});
}
}
require Class::Struct;
require FileHandle;
require Hash::Merge;
+ require Storable;
no warnings qw/redefine once/;
no strict qw/refs/;
}
my $base_collection = {
- schema => $schema,
- storage => $storage,
-
resultset => $rs,
# twice so that we make sure only one H::M object spawned
result_source => $rs->result_source,
+ result_source_handle => $rs->result_source->handle,
+
fresh_pager => $rs->page(5)->pager,
pager => $pager,
pager_explicit_count => $pager_explicit_count,
- sql_maker => $storage->sql_maker,
- dbh => $storage->_dbh
};
+ %$base_collection = (
+ %$base_collection,
+ refrozen => Storable::dclone( $base_collection ),
+ rerefrozen => Storable::dclone( Storable::dclone( $base_collection ) ),
+ schema => $schema,
+ storage => $storage,
+ sql_maker => $storage->sql_maker,
+ dbh => $storage->_dbh,
+ );
+
memory_cycle_ok ($base_collection, 'No cycles in the object collection')
if $have_test_cycle;
}
+# make sure that obsolete handle-based source tracking continues to work for the time being
+{
+ my $handle = $schema->source('Artist')->handle;
+
+ my $rowdata = {
+ artistid => 3,
+ charfield => undef,
+ name => "We Are In Rehab",
+ rank => 13
+ };
+
+ my $rs = DBIx::Class::ResultSet->new($handle);
+ my $rs_result = $rs->next;
+ isa_ok( $rs_result, 'DBICTest::Artist' );
+ is_deeply (
+ { $rs_result->get_columns },
+ $rowdata,
+ 'Correct columns retrieved (rset/source link healthy)'
+ );
+
+ my $row = DBICTest::Artist->new({ -source_handle => $handle });
+ is_deeply(
+ { $row->get_columns },
+ {},
+ 'No columns yet'
+ );
+
+ # store_column to fool the _orig_ident tracker
+ $row->store_column('artistid', $rowdata->{artistid});
+ $row->in_storage(1);
+
+ $row->discard_changes;
+ is_deeply(
+ { $row->get_columns },
+ $rowdata,
+ 'Storage refetch successful'
+ );
+}
+
# make sure we got rid of the compat shims
SKIP: {
skip "Remove in 0.082", 3 if $DBIx::Class::VERSION < 0.082;
$schema->storage->debugcb(undef);
}
+# test schema-less detached thaw
+{
+ my $artist = $schema->resultset('Artist')->find(1);
+
+ $artist = dclone $artist;
+
+ is( $artist->name, 'Caterwauler McCrae', 'getting column works' );
+
+ ok( $artist->update, 'Non-dirty update noop' );
+
+ ok( $artist->name( 'Beeeeeeees' ), 'setting works' );
+
+ ok( $artist->is_column_changed( 'name' ), 'Column dirtyness works' );
+ ok( $artist->is_changed, 'object dirtyness works' );
+
+ my $rs = $artist->result_source->resultset;
+ $rs->set_cache([ $artist ]);
+
+ is( $rs->count, 1, 'Synthetic resultset count works' );
+
+ my $exc = qr/Unable to perform storage-dependent operations with a detached result source.+use \$schema->thaw/;
+
+ throws_ok { $artist->update }
+ $exc,
+ 'Correct exception on row op'
+ ;
+
+ throws_ok { $artist->discard_changes }
+ $exc,
+ 'Correct exception on row op'
+ ;
+
+ throws_ok { $rs->find(1) }
+ $exc,
+ 'Correct exception on rs op'
+ ;
+}
+
done_testing;