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 DBIx::Class::GlobalDestruction;
+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
};
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);
}
- $clone->storage->set_schema($clone) if $clone->storage;
- return $clone;
+ if ($from->storage) {
+ $self->storage($from->storage);
+ $self->storage->set_schema($self);
+ }
}
=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;
+
+ my $class = blessed($self) || $self;
+ $class =~ s/::/-/g;
- return $filename;
+ return File::Spec->catfile($dir, "$class-$version-$type.sql");
}
=head2 thaw