use warnings;
use base 'DBIx::Class::ResultSource::RowParser';
-use mro 'c3';
use DBIx::Class::Carp;
use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dbic_internal_try fail_on_internal_call );
use namespace::clean;
-__PACKAGE__->mk_group_accessors(simple => qw/
- source_name name source_info
- _ordered_columns _columns _primaries _unique_constraints
- _relationships resultset_attributes
- column_info_from_storage sqlt_deploy_callback
-/);
+my @hashref_attributes = qw(
+ source_info resultset_attributes
+ _columns _unique_constraints _relationships
+);
+my @arrayref_attributes = qw(
+ _ordered_columns _primaries
+);
+__PACKAGE__->mk_group_accessors(simple =>
+ @hashref_attributes,
+ @arrayref_attributes,
+ qw( source_name name column_info_from_storage sqlt_deploy_callback ),
+);
__PACKAGE__->mk_group_accessors(component_class => qw/
resultset_class
=cut
-sub new {
- my ($class, $attrs) = @_;
- $class = ref $class if ref $class;
-
- my $new = bless { %{$attrs || {}} }, $class;
- $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
- $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} };
- $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}];
- $new->{_columns} = { %{$new->{_columns}||{}} };
- $new->{_relationships} = { %{$new->{_relationships}||{}} };
- $new->{name} ||= "!!NAME NOT SET!!";
- $new->{_columns_info_loaded} ||= 0;
- $new->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook';
- return $new;
+{
+ sub new {
+ my ($class, $attrs) = @_;
+ $class = ref $class if ref $class;
+
+ my $self = bless { %{$attrs || {}} }, $class;
+
+
+ DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
+ and
+ # a constructor with 'name' as sole arg clearly isn't "inheriting" from anything
+ ( not ( keys(%$self) == 1 and exists $self->{name} ) )
+ and
+ defined CORE::caller(1)
+ and
+ (CORE::caller(1))[3] !~ / ::new$ | ^ DBIx::Class :: (?:
+ ResultSourceProxy::Table::table
+ |
+ ResultSourceProxy::Table::_init_result_source_instance
+ |
+ ResultSource::clone
+ ) $ /x
+ and
+ local $Carp::CarpLevel = $Carp::CarpLevel + 1
+ and
+ Carp::confess("Incorrect instantiation of '$self': you almost certainly wanted to call ->clone() instead");
+
+
+ $self->{resultset_class} ||= 'DBIx::Class::ResultSet';
+ $self->{name} ||= "!!NAME NOT SET!!";
+ $self->{_columns_info_loaded} ||= 0;
+ $self->{sqlt_deploy_callback} ||= 'default_sqlt_deploy_hook';
+
+ $self->{$_} = { %{ $self->{$_} || {} } }
+ for @hashref_attributes;
+
+ $self->{$_} = [ @{ $self->{$_} || [] } ]
+ for @arrayref_attributes;
+
+ $self;
+ }
+}
+
+=head2 clone
+
+ $rsrc_instance->clone( atribute_name => overriden_value );
+
+A wrapper around L</new> inheriting any defaults from the callee. This method
+also not normally invoked directly by end users.
+
+=cut
+
+sub clone {
+ my $self = shift;
+
+ $self->new({
+ (
+ (length ref $self)
+ ? %$self
+ : ()
+ ),
+ (
+ (@_ == 1 and ref $_[0] eq 'HASH')
+ ? %{ $_[0] }
+ : @_
+ ),
+ });
}
=pod
return $self;
}
-sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB
+sub add_column {
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+ shift->add_columns(@_)
+}
=head2 has_column
$self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
}
-# DO NOT CHANGE THIS TO A GLOB
sub remove_column {
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
shift->remove_columns(@_)
=cut
sub add_unique_constraints {
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+
my $self = shift;
my @constraints = @_;
L<DBIx::Class::ResultSet> produced from this result source.
B<CAVEAT>: C<resultset_attributes> comes with its own set of issues and
-bugs! While C<resultset_attributes> isn't deprecated per se, its usage is
-not recommended!
+bugs! Notably the contents of the attributes are B<entirely static>, which
+greatly hinders composability (things like L<current_source_alias
+|DBIx::Class::ResultSet/current_source_alias> can not possibly be respected).
+While C<resultset_attributes> isn't deprecated per se, you are strongly urged
+to seek alternatives.
Since relationships use attributes to link tables together, the "default"
attributes you set may cause unpredictable and undesired behavior. Furthermore,
-the defaults cannot be turned off, so you are stuck with them.
+the defaults B<cannot be turned off>, so you are stuck with them.
In most cases, what you should actually be using are project-specific methods:
# however beware - on older perls the exception seems randomly untrappable
# due to some weird race condition during thread joining :(((
local $SIG{__DIE__} if $SIG{__DIE__};
- local $@;
+ local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
eval {
weaken $_[0]->{schema};