use DBIx::Class::Exception;
use DBIx::Class::Carp;
use Try::Tiny;
-use Scalar::Util 'weaken';
+use Scalar::Util qw/weaken blessed/;
use Sub::Name 'subname';
use B 'svref_2object';
+use Devel::GlobalDestruction;
use namespace::clean;
use base qw/DBIx::Class/;
my $ns = shift || ref $proto || $proto;
require Module::Find;
- my @mods = Module::Find::findallmod($ns);
- # try to untaint module names. mods where this fails
- # are left alone so we don't have to change the old behavior
- no locale; # localized \w doesn't untaint expression
- return map { $_ =~ m/^( (?:\w+::)* \w+ )$/x ? $1 : $_ } @mods;
+ # untaint result
+ return map { $_ =~ /(.+)/ } Module::Find::findallmod($ns);
}
# returns a hash of $shortname => $fullname for every package
# returns the result_source_instance for the passed class/object,
# or dies with an informative message (used by load_namespaces)
sub _ns_get_rsrc_instance {
- my $class = shift;
- my $rs = ref ($_[0]) || $_[0];
-
- if ($rs->can ('result_source_instance') ) {
- return $rs->result_source_instance;
- }
- else {
- $class->throw_exception (
- "Attempt to load_namespaces() class $rs failed - are you sure this is a real Result Class?"
+ my $me = shift;
+ my $rs_class = ref ($_[0]) || $_[0];
+
+ return try {
+ $rs_class->result_source_instance
+ } catch {
+ $me->throw_exception (
+ "Attempt to load_namespaces() class $rs_class failed - are you sure this is a real Result Class?: $_"
);
- }
+ };
}
sub load_namespaces {
foreach my $to (@to_register) {
$class->register_class(@$to);
- # if $class->can('result_source_instance');
}
}
}
catch {
$self->throw_exception(
- "No arguments to load_classes and couldn't load ${storage_class} ($_)"
+ "Unable to load storage class ${storage_class}: $_"
);
};
my $storage = $storage_class->new($self=>$args);
sub compose_namespace {
my ($self, $target, $base) = @_;
+
my $schema = $self->clone;
+
+ $schema->source_registrations({});
+
+ # the original class-mappings must remain - otherwise
+ # reverse_relationship_info will not work
+ #$schema->class_mappings({});
+
{
no warnings qw/redefine/;
local *Class::C3::reinitialize = sub { } if DBIx::Class::_ENV_::OLD_MRO;
use warnings qw/redefine/;
no strict qw/refs/;
- foreach my $moniker ($schema->sources) {
- my $source = $schema->source($moniker);
+ foreach my $moniker ($self->sources) {
+ my $orig_source = $self->source($moniker);
+
my $target_class = "${target}::${moniker}";
- $self->inject_base(
- $target_class => $source->result_class, ($base ? $base : ())
+ $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($moniker, bless
+ { %$orig_source, result_class => $target_class },
+ ref $orig_source,
);
- $source->result_class($target_class);
- if ($target_class->can('result_source_instance')) {
- # since the newly created classes are registered only with
- # the instance of $schema, it should be safe to weaken
- # the ref (it will GC when $schema is destroyed)
- $target_class->result_source_instance($source);
- weaken ${"${target_class}::__cag_result_source_instance"};
+ 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,
+ );
}
- $schema->register_source($moniker, $source);
}
- }
- Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
- {
- no strict 'refs';
- no warnings 'redefine';
+
foreach my $meth (qw/class source resultset/) {
+ no warnings 'redefine';
*{"${target}::${meth}"} = subname "${target}::${meth}" =>
sub { shift->schema->$meth(@_) };
}
}
+
+ Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
+
return $schema;
}
};
bless $clone, (ref $self || $self);
- $clone->class_mappings({ %{$clone->class_mappings} });
- $clone->source_registrations({ %{$clone->source_registrations} });
- foreach my $moniker ($self->sources) {
- my $source = $self->source($moniker);
+ $clone->$_(undef) for qw/class_mappings source_registrations storage/;
+
+ $clone->_copy_state_from($self);
+
+ return $clone;
+}
+
+# Needed in Schema::Loader - if you refactor, please make a compatibility shim
+# -- Caelum
+sub _copy_state_from {
+ my ($self, $from) = @_;
+
+ $self->class_mappings({ %{$from->class_mappings} });
+ $self->source_registrations({ %{$from->source_registrations} });
+
+ foreach my $moniker ($from->sources) {
+ my $source = $from->source($moniker);
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
- $clone->register_extra_source($moniker => $new);
+ $self->register_extra_source($moniker => $new);
+ }
+
+ if ($from->storage) {
+ $self->storage($from->storage);
+ $self->storage->set_schema($self);
}
- $clone->storage->set_schema($clone) if $clone->storage;
- return $clone;
}
=head2 throw_exception
require File::Spec;
- my $filename = ref($self);
- $filename =~ s/::/-/g;
- $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
- $filename =~ s/$version/$preversion-$version/ if($preversion);
+ $version = "$preversion-$version" if $preversion;
- return $filename;
+ my $class = blessed($self) || $self;
+ $class =~ s/::/-/g;
+
+ return File::Spec->catfile($dir, "$class-$version-$type.sql");
}
=head2 thaw
=cut
-sub register_source {
- my $self = shift;
-
- $self->_register_source(@_);
-}
+sub register_source { shift->_register_source(@_) }
=head2 unregister_source
=cut
-sub unregister_source {
- my $self = shift;
-
- $self->_unregister_source(@_);
-}
+sub unregister_source { shift->_unregister_source(@_) }
=head2 register_extra_source
=cut
-sub register_extra_source {
- my $self = shift;
-
- $self->_register_source(@_, { extra => 1 });
-}
+sub register_extra_source { shift->_register_source(@_, { extra => 1 }) }
sub _register_source {
my ($self, $moniker, $source, $params) = @_;
- my $orig_source = $source;
-
$source = $source->new({ %$source, source_name => $moniker });
+
$source->schema($self);
weaken $source->{schema} if ref($self);
- my $rs_class = $source->result_class;
-
my %reg = %{$self->source_registrations};
$reg{$moniker} = $source;
$self->source_registrations(\%reg);
- return if ($params->{extra});
- return unless defined($rs_class) && $rs_class->can('result_source_instance');
-
- my %map = %{$self->class_mappings};
- if (
- exists $map{$rs_class}
- and
- $map{$rs_class} ne $moniker
- and
- $rs_class->result_source_instance ne $orig_source
- ) {
- carp "$rs_class already has a source, use register_extra_source for additional sources";
+ return $source if $params->{extra};
+
+ my $rs_class = $source->result_class;
+ if ($rs_class and my $rsrc = try { $rs_class->result_source_instance } ) {
+ my %map = %{$self->class_mappings};
+ if (
+ exists $map{$rs_class}
+ and
+ $map{$rs_class} ne $moniker
+ 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.'
+ ;
+ }
+
+ $map{$rs_class} = $moniker;
+ $self->class_mappings(\%map);
}
- $map{$rs_class} = $moniker;
- $self->class_mappings(\%map);
+
+ return $source;
}
-{
- my $global_phase_destroy;
-
- # SpeedyCGI runs END blocks every cycle but keeps object instances
- # hence we have to disable the globaldestroy hatch, and rely on the
- # eval trap below (which appears to work, but is risky done so late)
- END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy }
-
- 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
- #
- # during global destruction (if we have not yet bailed out) this will throw
- # which will serve as a signal to not try doing anything else
- if (ref $srcs->{$moniker} and svref_2object($srcs->{$moniker})->REFCNT > 1) {
- local $@;
- eval {
- $srcs->{$moniker}->schema($self);
- 1;
- } or do {
- $global_phase_destroy = 1;
- last;
- };
+my $global_phase_destroy;
+sub DESTROY {
+ return if $global_phase_destroy ||= in_global_destruction;
+ 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
+ #
+ # during global destruction (if we have not yet bailed out) this should throw
+ # which will serve as a signal to not try doing anything else
+ # however beware - on older perls the exception seems randomly untrappable
+ # due to some weird race condition during thread joining :(((
+ if (ref $srcs->{$moniker} and svref_2object($srcs->{$moniker})->REFCNT > 1) {
+ local $@;
+ eval {
+ $srcs->{$moniker}->schema($self);
weaken $srcs->{$moniker};
- last;
- }
+ 1;
+ } or do {
+ $global_phase_destroy = 1;
+ };
+
+ last;
}
}
}
1;
-=head1 AUTHORS
+=head1 AUTHOR AND CONTRIBUTORS
-Matt S. Trout <mst@shadowcatsystems.co.uk>
+See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
=head1 LICENSE
projects / dbsrgits/DBIx-Class.git / blobdiff