Revision history for DBIx::Class
+ * New Features / Changes
+ - Schema/resultsource instances are now crossreferenced via a new
+ system guaranteeing leak-free mutually assuered destruction
+
* Fixes
- Revert default selection to being lazy again (eagerness introduced
in 0.08125) - fixes DBIx::Class::Helper::ResultSet::RemoveColumns
use Carp::Clan qw/^DBIx::Class/;
use DBIx::Class::Exception;
use Data::Page;
-use Storable;
use DBIx::Class::ResultSetColumn;
use DBIx::Class::ResultSourceHandle;
use Hash::Merge ();
'bool' => "_bool",
fallback => 1;
-__PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/);
+__PACKAGE__->mk_group_accessors('simple' => qw/_result_class result_source/);
=head1 NAME
return $class->new_result(@_) if ref $class;
my ($source, $attrs) = @_;
- $source = $source->handle
- unless $source->isa('DBIx::Class::ResultSourceHandle');
+ $source = $source->resolve
+ if $source->isa('DBIx::Class::ResultSourceHandle');
$attrs = { %{$attrs||{}} };
if ($attrs->{page}) {
# Creation of {} and bless separated to mitigate RH perl bug
# see https://bugzilla.redhat.com/show_bug.cgi?id=196836
my $self = {
- _source_handle => $source,
+ result_source => $source,
cond => $attrs->{where},
pager => undef,
- attrs => $attrs
+ attrs => $attrs,
};
bless $self, $class;
$self->result_class(
- $attrs->{result_class} || $source->resolve->result_class
+ $attrs->{result_class} || $source->result_class
);
return $self;
@$cols_from_relations
? (-cols_from_relations => $cols_from_relations)
: (),
- -source_handle => $self->_source_handle,
-result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
);
}
}
-sub result_source {
- my $self = shift;
-
- if (@_) {
- $self->_source_handle($_[0]->handle);
- } else {
- $self->_source_handle->resolve;
- }
-}
-
-
sub STORABLE_freeze {
my ($self, $cloning) = @_;
my $to_serialize = { %$self };
sub throw_exception {
my $self=shift;
- if (ref $self && $self->_source_handle->schema) {
- $self->_source_handle->schema->throw_exception(@_)
+ if (ref $self and my $rsrc = $self->result_source) {
+ $rsrc->throw_exception(@_)
}
else {
DBIx::Class::Exception->throw(@_);
use Carp::Clan qw/^DBIx::Class/;
use Try::Tiny;
use List::Util 'first';
+use Scalar::Util qw/weaken isweak/;
+use Storable qw/nfreeze thaw/;
use namespace::clean;
use base qw/DBIx::Class/;
});
}
+{
+ my $global_phase_destroy;
+
+ END { $global_phase_destroy++ }
+
+ sub DESTROY {
+ return if $global_phase_destroy;
+
+######
+# !!! ACHTUNG !!!!
+######
+#
+# Under no circumstances shall $_[0] be stored anywhere else (like copied to
+# a lexical variable, or shifted, or anything else). Doing so will mess up
+# the refcount of this particular result source, and will allow the $schema
+# we are trying to save to reattach back to the source we are destroying.
+# The relevant code checking refcounts is in ::Schema::DESTROY()
+
+ # if we are not a schema instance holder - we don't matter
+ return if(
+ ! ref $_[0]->{schema}
+ or
+ isweak $_[0]->{schema}
+ );
+
+ # weaken our schema hold forcing the schema to find somewhere else to live
+ weaken $_[0]->{schema};
+
+ # if schema is still there reintroduce ourselves with strong refs back
+ if ($_[0]->{schema}) {
+ my $srcregs = $_[0]->{schema}->source_registrations;
+ for (keys %$srcregs) {
+ $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
+ }
+ }
+ }
+}
+
+sub STORABLE_freeze {
+ my ($self, $cloning) = @_;
+ nfreeze($self->handle);
+}
+
+sub STORABLE_thaw {
+ my ($self, $cloning, $ice) = @_;
+ %$self = %{ (thaw $ice)->resolve };
+}
+
+
+
=head2 throw_exception
See L<DBIx::Class::Schema/"throw_exception">.
: sub () { 0 };
}
-__PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
+__PACKAGE__->mk_group_accessors('simple' => [result_source => '_result_source']);
=head1 NAME
L<DBIx::Class::ResultSet> object.
When calling it directly, you will not get a complete, usable row
-object until you pass or set the C<source_handle> attribute, to a
+object until you pass or set the C<result_source> attribute, to a
L<DBIx::Class::ResultSource> instance that is attached to a
L<DBIx::Class::Schema> with a valid connection.
C<$attrs> is a hashref of column name, value data. It can also contain
-some other attributes such as the C<source_handle>.
+some other attributes such as the C<result_source>.
Passing an object, or an arrayref of objects as a value will call
L<DBIx::Class::Relationship::Base/set_from_related> for you. When
my ($class, $attrs) = @_;
$class = ref $class if ref $class;
- my $new = {
- _column_data => {},
- };
- bless $new, $class;
-
- if (my $handle = delete $attrs->{-source_handle}) {
- $new->_source_handle($handle);
- }
+ my $new = bless { _column_data => {} }, $class;
- my $source;
- if ($source = delete $attrs->{-result_source}) {
- $new->result_source($source);
- }
+ 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} = ();
my $colinfo = $self->column_info ($column);
# cache for speed (the object may *not* have a resultsource instance)
- if (! defined $colinfo->{is_numeric} && $self->_source_handle) {
+ if (
+ ! defined $colinfo->{is_numeric}
+ and
+ my $storage = try { $self->result_source->schema->storage }
+ ) {
$colinfo->{is_numeric} =
- $self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type})
+ $storage->is_datatype_numeric ($colinfo->{data_type})
? 1
: 0
;
sub inflate_result {
my ($class, $source, $me, $prefetch) = @_;
- my ($source_handle) = $source;
-
- if ($source->isa('DBIx::Class::ResultSourceHandle')) {
- $source = $source_handle->resolve
- }
- else {
- $source_handle = $source->handle
- }
+ $source = $source->resolve
+ if $source->isa('DBIx::Class::ResultSourceHandle');
- my $new = {
- _source_handle => $source_handle,
- _column_data => $me,
- };
- bless $new, (ref $class || $class);
+ my $new = bless
+ { _column_data => $me, _result_source => $source },
+ ref $class || $class
+ ;
foreach my $pre (keys %{$prefetch||{}}) {
=over
-=item Arguments: none
+=item Arguments: $result_source_instance
=item Returns: a ResultSource instance
Accessor to the L<DBIx::Class::ResultSource> this object was created from.
-=cut
-
-sub result_source {
- my $self = shift;
-
- if (@_) {
- $self->_source_handle($_[0]->handle);
- } else {
- $self->_source_handle->resolve;
- }
-}
-
=head2 register_column
$column_info = { .... };
use Sub::Name 'subname';
use Module::Find();
use Storable();
+use B qw/svref_2object/;
use namespace::clean;
use base qw/DBIx::Class/;
$self->class_mappings(\%map);
}
+{
+ my $global_phase_destroy;
+
+ END { $global_phase_destroy++ }
+
+ sub DESTROY {
+ return if $global_phase_destroy;
+
+ my $self = shift;
+ my $srcs = $self->source_registrations;
+
+ for my $moniker (keys %$srcs) {
+ # find first source that is not about to be GCed (someone other than $self
+ # holds a reference to it) and reattach to it, weakening our own link
+ if (ref $srcs->{$moniker} and svref_2object($srcs->{$moniker})->REFCNT > 1) {
+ $srcs->{$moniker}->schema($self);
+ weaken $srcs->{$moniker};
+ last;
+ }
+ }
+ }
+}
+
sub _unregister_source {
my ($self, $moniker) = @_;
my %reg = %{$self->source_registrations};
-use strict;
-use warnings;
-
# Do the override as early as possible so that CORE::bless doesn't get compiled away
# We will replace $bless_override only if we are in author mode
my $bless_override;
*CORE::GLOBAL::bless = sub { goto $bless_override };
}
+use strict;
+use warnings;
use Test::More;
use lib qw(t/lib);
$weak_registry->{"basic $_"} = { weakref => $base_collection->{$_} };
weaken $weak_registry->{"basic $_"}{weakref};
}
-
}
-memory_cycle_ok($weak_registry, 'No cycles in the weakened object collection')
- if $have_test_cycle;
+# check that "phantom-chaining" works - we never lose track of the original $schema
+# and have access to the entire tree without leaking anything
+{
+ my $phantom;
+ for (
+ sub { DBICTest->init_schema },
+ sub { shift->source('Artist') },
+ sub { shift->resultset },
+ sub { shift->result_source },
+ sub { shift->schema },
+ sub { shift->resultset('Artist') },
+ sub { shift->find_or_create({ name => 'detachable' }) },
+ sub { shift->result_source },
+ sub { shift->schema },
+ sub { shift->clone },
+ sub { shift->resultset('Artist') },
+ sub { shift->next },
+ sub { shift->result_source },
+ sub { shift->resultset },
+ sub { shift->create({ name => 'detached' }) },
+ sub { shift->update({ name => 'reattached' }) },
+ sub { shift->discard_changes },
+ sub { shift->delete },
+ sub { shift->insert },
+ ) {
+ $phantom = $_->($phantom);
+
+ my $slot = (sprintf 'phantom %s=%s(0x%x)', # so we don't trigger stringification
+ ref $phantom,
+ reftype $phantom,
+ refaddr $phantom,
+ );
+ $weak_registry->{$slot} = $phantom;
+ weaken $weak_registry->{$slot};
+ }
+
+ ok( $phantom->in_storage, 'Properly deleted/reinserted' );
+ is( $phantom->name, 'reattached', 'Still correct name' );
+}
# Naturally we have some exceptions
my $cleared;
resolve_condition
resolve_join
resolve_prefetch
+ STORABLE_freeze
+ STORABLE_thaw
/],
},
'DBIx::Class::ResultSet' => {
projects / dbsrgits/DBIx-Class.git / commitdiff