use warnings;
use base 'DBIx::Class';
-use mro 'c3';
use DBIx::Class::Carp;
use Try::Tiny;
use DBIx::Class::_Util qw(
refcount quote_sub scope_guard
is_exception dbic_internal_try
- fail_on_internal_call
+ fail_on_internal_call emit_loud_diag
);
use Devel::GlobalDestruction;
use namespace::clean;
__PACKAGE__->mk_group_accessors( inherited => qw( storage exception_action ) );
-__PACKAGE__->mk_classaccessor('class_mappings' => {});
-__PACKAGE__->mk_classaccessor('source_registrations' => {});
__PACKAGE__->mk_classaccessor('storage_type' => '::DBI');
__PACKAGE__->mk_classaccessor('stacktrace' => $ENV{DBIC_TRACE} || 0);
__PACKAGE__->mk_classaccessor('default_resultset_attributes' => {});
+# These two should have been private from the start but too late now
+# Undocumented on purpose, hopefully it won't ever be necessary to
+# screw with them
+__PACKAGE__->mk_classaccessor('class_mappings' => {});
+__PACKAGE__->mk_classaccessor('source_registrations' => {});
+
=head1 NAME
DBIx::Class::Schema - composable schemas
Config::[class] or your choice. See
L<DBIx::Class::Storage::DBI::Replicated> for an example of this.
+=head2 default_resultset_attributes
+
+=over 4
+
+=item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
+
+=item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
+
+=item Default value: None
+
+=back
+
+Like L<DBIx::Class::ResultSource/resultset_attributes> stores a collection
+of resultset attributes, to be used as defaults for B<every> ResultSet
+instance schema-wide. The same list of CAVEATS and WARNINGS applies, with
+the extra downside of these defaults being practically inescapable: you will
+B<not> be able to derive a ResultSet instance with these attributes unset.
+
+Example:
+
+ package My::Schema;
+ use base qw/DBIx::Class::Schema/;
+ __PACKAGE__->default_resultset_attributes( { software_limit => 1 } );
+
=head2 exception_action
=over 4
=cut
sub source {
- my $self = shift;
+ my ($self, $source_name) = @_;
$self->throw_exception("source() expects a source name")
- unless @_;
+ unless $source_name;
- my $source_name = shift;
+ my $source_registrations;
- my $sreg = $self->source_registrations;
- return $sreg->{$source_name} if exists $sreg->{$source_name};
+ my $rsrc =
+ ( $source_registrations = $self->source_registrations )->{$source_name}
+ ||
+ # if we got here, they probably passed a full class name
+ $source_registrations->{ $self->class_mappings->{$source_name} || '' }
+ ||
+ $self->throw_exception( "Can't find source for ${source_name}" )
+ ;
- # if we got here, they probably passed a full class name
- my $mapped = $self->class_mappings->{$source_name};
- $self->throw_exception("Can't find source for ${source_name}")
- unless $mapped && exists $sreg->{$mapped};
- return $sreg->{$mapped};
+ # DO NOT REMOVE:
+ # We need to prevent alterations of pre-existing $@ due to where this call
+ # sits in the overall stack ( *unless* of course there is an actual error
+ # to report ). set_mro does alter $@ (and yes - it *can* throw an exception)
+ # We do not use local because set_mro *can* throw an actual exception
+ # We do not use a try/catch either, as on one hand it would slow things
+ # down for no reason (we would always rethrow), but also because adding *any*
+ # try/catch block below will segfault various threading tests on older perls
+ # ( which in itself is a FIXME but ENOTIMETODIG )
+ my $old_dollarat = $@;
+
+ no strict 'refs';
+ mro::set_mro($_, 'c3') for
+ grep
+ {
+ # some pseudo-sources do not have a result/resultset yet
+ defined $_
+ and
+ (
+ (
+ ${"${_}::__INITIAL_MRO_UPON_DBIC_LOAD__"}
+ ||= mro::get_mro($_)
+ )
+ ne
+ 'c3'
+ )
+ }
+ map
+ { length ref $_ ? ref $_ : $_ }
+ ( $rsrc, $rsrc->result_class, $rsrc->resultset_class )
+ ;
+
+ # DO NOT REMOVE - see comment above
+ $@ = $old_dollarat;
+
+ $rsrc;
}
=head2 class
=item Arguments: @args
-=item Return Value: $new_schema
+=item Return Value: $self
=back
Similar to L</connect> except sets the storage object and connection
-data in-place on the Schema class. You should probably be calling
-L</connect> to get a proper Schema object instead.
+data B<in-place> on C<$self>. You should probably be calling
+L</connect> to get a properly L<cloned|/clone> Schema object instead.
=head3 Overloading
my $target_class = "${target}::${source_name}";
$self->inject_base($target_class, $orig_source->result_class, ($base || ()) );
- # register_source examines result_class, and then returns us a clone
- my $new_source = $schema->register_source($source_name, bless
- { %$orig_source, result_class => $target_class },
- ref $orig_source,
+ $schema->register_source(
+ $source_name,
+ $orig_source->clone(
+ result_class => $target_class
+ ),
);
-
- if ($target_class->can('result_source_instance')) {
- # give the class a schema-less source copy
- $target_class->result_source_instance( bless
- { %$new_source, schema => ref $new_source->{schema} || $new_source->{schema} },
- ref $new_source,
- );
- }
}
+ # Legacy stuff, not inserting INDIRECT assertions
quote_sub "${target}::${_}" => "shift->schema->$_(\@_)"
for qw(class source resultset);
}
Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
+ # Give each composed class yet another *schema-less* source copy
+ # this is used for the freeze/thaw cycle
+ #
+ # This is not covered by any tests directly, but is indirectly exercised
+ # in t/cdbi/sweet/08pager by re-setting the schema on an existing object
+ # FIXME - there is likely a much cheaper way to take care of this
+ for my $source_name ($self->sources) {
+
+ my $target_class = "${target}::${source_name}";
+
+ $target_class->result_source_instance(
+ $self->source($source_name)->clone(
+ result_class => $target_class,
+ schema => ( ref $schema || $schema ),
+ )
+ );
+ }
+
return $schema;
}
+# LEGACY: The intra-call to this was removed in 66d9ef6b and then
+# the sub was de-documented way later in 249963d4. No way to be sure
+# nothing on darkpan is calling it directly, so keeping as-is
sub setup_connection_class {
my ($class, $target, @info) = @_;
$class->inject_base($target => 'DBIx::Class::DB');
$self->class_mappings({ %{$from->class_mappings} });
$self->source_registrations({ %{$from->source_registrations} });
- foreach my $source_name ($from->sources) {
- my $source = $from->source($source_name);
- my $new = $source->new($source);
- # we use extra here as we want to leave the class_mappings as they are
- # but overwrite the source_registrations entry with the new source
- $self->register_extra_source($source_name => $new);
- }
+ # we use extra here as we want to leave the class_mappings as they are
+ # but overwrite the source_registrations entry with the new source
+ $self->register_extra_source( $_ => $from->source($_) )
+ for $from->sources;
if ($from->storage) {
$self->storage($from->storage);
my $guard = scope_guard {
return if $guard_disarmed;
- local $SIG{__WARN__};
- Carp::cluck("
+ emit_loud_diag( emit_dups => 1, msg => "
+
!!! DBIx::Class INTERNAL PANIC !!!
The exception_action() handler installed on '$self'
!!! FIX YOUR ERROR HANDLING !!!
-This guard was activated beginning"
+This guard was activated starting",
);
};
sub register_extra_source { shift->_register_source(@_, { extra => 1 }) }
sub _register_source {
- my ($self, $source_name, $source, $params) = @_;
+ my ($self, $source_name, $supplied_rsrc, $params) = @_;
+
+ my $derived_rsrc = $supplied_rsrc->clone({
+ source_name => $source_name,
+ });
- $source = $source->new({ %$source, source_name => $source_name });
+ # Do not move into the clone-hashref above: there are things
+ # on CPAN that do hook 'sub schema' </facepalm>
+ # https://metacpan.org/source/LSAUNDERS/DBIx-Class-Preview-1.000003/lib/DBIx/Class/ResultSource/Table/Previewed.pm#L9-38
+ $derived_rsrc->schema($self);
- $source->schema($self);
- weaken $source->{schema} if ref($self);
+ weaken $derived_rsrc->{schema}
+ if length ref($self);
my %reg = %{$self->source_registrations};
- $reg{$source_name} = $source;
+ $reg{$source_name} = $derived_rsrc;
$self->source_registrations(\%reg);
- return $source if $params->{extra};
+ return $derived_rsrc if $params->{extra};
- my $rs_class = $source->result_class;
- if ($rs_class and my $rsrc = dbic_internal_try { $rs_class->result_source_instance } ) {
+ my( $result_class, $result_class_level_rsrc );
+ if (
+ $result_class = $derived_rsrc->result_class
+ and
+ # There are known cases where $rs_class is *ONLY* an inflator, without
+ # any hint of a rsrc (e.g. DBIx::Class::KiokuDB::EntryProxy)
+ $result_class_level_rsrc = dbic_internal_try { $result_class->result_source_instance }
+ ) {
my %map = %{$self->class_mappings};
- if (
- exists $map{$rs_class}
+
+ carp (
+ "$result_class already had a registered source which was replaced by "
+ . 'this call. Perhaps you wanted register_extra_source(), though it is '
+ . 'more likely you did something wrong.'
+ ) if (
+ exists $map{$result_class}
and
- $map{$rs_class} ne $source_name
+ $map{$result_class} ne $source_name
and
- $rsrc ne $_[2] # orig_source
- ) {
- carp
- "$rs_class already had a registered source which was replaced by this call. "
- . 'Perhaps you wanted register_extra_source(), though it is more likely you did '
- . 'something wrong.'
- ;
- }
+ $result_class_level_rsrc != $supplied_rsrc
+ );
- $map{$rs_class} = $source_name;
+ $map{$result_class} = $source_name;
$self->class_mappings(\%map);
}
- return $source;
+ $derived_rsrc;
}
my $global_phase_destroy;
# due to some weird race condition during thread joining :(((
if (length ref $srcs->{$source_name} and refcount($srcs->{$source_name}) > 1) {
local $SIG{__DIE__} if $SIG{__DIE__};
- local $@;
+ local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
eval {
$srcs->{$source_name}->schema($self);
weaken $srcs->{$source_name};
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);
}
projects / dbsrgits/DBIx-Class.git / blobdiff