filesystems (OSX and Windows)
- support for DBD::Firebird
- support for unicode Firebird data types
+ - handle "use warnings FATAL => 'all';" in custom/external content
+ (RT#59849)
+ - for dynamic schemas, if the schema is loaded in backcompat mode, or
+ naming => { monikers => 'v4' } is not explicitly set, will
+ automatically turn on use_namespaces=1 as well. Set use_namespaces=0
+ to disable this behavior (RT#59849)
0.07010 2011-03-04 08:26:31
- add result_component_map option
use Class::Inspector ();
use Scalar::Util 'looks_like_number';
use File::Slurp 'slurp';
-use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_without_redefine_warnings/;
+use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path/;
use DBIx::Class::Schema::Loader::Optional::Dependencies ();
use Try::Tiny;
use DBIx::Class ();
Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
to disable this warning.
-Also consider setting 'use_namespaces => 1' if/when upgrading.
-
See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
details.
EOF
$self->naming->{relationships} ||= 'v4';
$self->naming->{monikers} ||= 'v4';
+ if ((not defined $self->use_namespaces)
+ && $self->naming->{monikers} ne 'v4') {
+ $self->use_namespaces(1);
+ }
+
if ($self->use_namespaces) {
$self->_upgrading_from_load_classes(1);
}
return;
}
-sub _class_path {
- my ($self, $class) = @_;
-
- my $class_path = $class;
- $class_path =~ s{::}{/}g;
- $class_path .= '.pm';
-
- return $class_path;
-}
-
sub _find_class_in_inc {
my ($self, $class) = @_;
- return $self->_find_file_in_inc($self->_class_path($class));
+ return $self->_find_file_in_inc(class_path($class));
}
sub _rewriting {
my $code = $self->_rewrite_old_classnames(scalar slurp $real_inc_path);
if ($self->dynamic) { # load the class too
- eval_without_redefine_warnings($code);
+ eval_package_without_redefine_warnings($class, $code);
}
$self->_ext_stmt($class,
* PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the
new name of the Result.
EOF
- eval_without_redefine_warnings($code);
+ eval_package_without_redefine_warnings($class, $code);
}
chomp $code;
sub _reload_class {
my ($self, $class) = @_;
- my $class_path = $self->_class_path($class);
- delete $INC{ $class_path };
+ delete $INC{ +class_path($class) };
-# kill redefined warnings
try {
- eval_without_redefine_warnings ("require $class");
+ eval_package_without_redefine_warnings ($class, "require $class");
}
catch {
my $source = slurp $self->_get_dump_filename($class);
use namespace::clean;
use Exporter 'import';
-our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_without_redefine_warnings warnings_exist warnings_exist_silent/;
+our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_package_without_redefine_warnings class_path warnings_exist warnings_exist_silent/;
use constant BY_CASE_TRANSITION =>
qr/(?<=[[:lower:]\d])[\W_]*(?=[[:upper:]])|[\W_]+/;
return $dd->Values([ $val ])->Dump;
}
-sub eval_without_redefine_warnings {
- my $code = shift;
+sub eval_package_without_redefine_warnings {
+ my ($pkg, $code) = @_;
my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
+
local $SIG{__WARN__} = sub {
$warn_handler->(@_)
unless $_[0] =~ /^Subroutine \S+ redefined/;
};
- eval $code;
- die $@ if $@;
+
+ # This hairiness is to handle people using "use warnings FATAL => 'all';"
+ # in their custom or external content.
+ my @delete_syms;
+ my $try_again = 1;
+
+ while ($try_again) {
+ eval $code;
+
+ if (my ($sym) = $@ =~ /^Subroutine (\S+) redefined/) {
+ delete $INC{ +class_path($pkg) };
+ push @delete_syms, $sym;
+
+ foreach my $sym (@delete_syms) {
+ no strict 'refs';
+ undef *{"${pkg}::${sym}"};
+ }
+ }
+ elsif ($@) {
+ die $@ if $@;
+ }
+ else {
+ $try_again = 0;
+ }
+ }
+}
+
+sub class_path {
+ my $class = shift;
+
+ my $class_path = $class;
+ $class_path =~ s{::}{/}g;
+ $class_path .= '.pm';
+
+ return $class_path;
}
sub warnings_exist(&$$) {
--- /dev/null
+# test for loading additional methods from file-defined packages
+# by Mark Hedges ( hedges -at| scriptdolphin.com )
+
+use strict;
+use Test::More tests => 7 * 5;
+use Test::Exception;
+
+use lib 't/lib';
+
+use make_dbictest_db;
+
+use DBIx::Class::Schema::Loader;
+
+$ENV{SCHEMA_LOADER_BACKCOMPAT} = 1;
+
+# In the first test run, then, Foo should be a DBICTestMethods::Namespaces::Schema::Result::Foo
+
+run_test_sequence(
+ testname => "naming => 'current'",
+ schema_class => 'DBICTestMethods::Namespaces::Schema',
+ foo_class => 'DBICTestMethods::Namespaces::Schema::Result::Foo',
+ schema_opts => {
+ naming => 'current',
+ },
+);
+
+# In the second test run with use_namespaces => 0 (backcompat), Foo should be a DBICTestMethods::Backcompat::Schema
+
+run_test_sequence(
+ testname => "naming => 'current', use_namespaces => 0",
+ schema_class => 'DBICTestMethods::Backcompat::Schema',
+ foo_class => 'DBICTestMethods::Backcompat::Schema::Foo',
+ schema_opts => {
+ naming => 'current',
+ use_namespaces => 0,
+ },
+);
+
+# In the third test, with use_namespaces => 1, Foo gets the explicit Result class again
+
+run_test_sequence(
+ testname => "naming => 'current', use_namespaces => 1",
+ schema_class => 'DBICTestMethods::Namespaces::Schema',
+ foo_class => 'DBICTestMethods::Namespaces::Schema::Result::Foo',
+ schema_opts => {
+ naming => 'current',
+ use_namespaces => 1,
+ },
+);
+
+# try it in full backcompat 0.04006 mode with no schema options
+
+run_test_sequence(
+ testname => "no naming or namespaces options (0.04006 mode)",
+ schema_class => 'DBICTestMethods::Backcompat::Schema',
+ foo_class => 'DBICTestMethods::Backcompat::Schema::Foo',
+ schema_opts => {
+ },
+);
+
+# try it in backcompat mode (no naming option) but with use_namespaces => 1
+
+run_test_sequence(
+ testname => "no naming, but with use_namespaces options (0.04006 mode)",
+ schema_class => 'DBICTestMethods::Namespaces::Schema',
+ foo_class => 'DBICTestMethods::Namespaces::Schema::Result::Foo',
+ schema_opts => {
+ use_namespaces => 1,
+ },
+);
+
+sub run_test_sequence {
+ my %p = @_;
+ die "specify a $_ test param" for grep !$p{$_},
+ qw( testname schema_opts schema_class foo_class );
+
+ my $schema;
+ lives_ok { $schema = make_schema_with(%p) } "($p{testname}) get schema";
+
+ SKIP: {
+ skip 'no point in checking if schema could not be connected', 6 unless defined $schema;
+
+ # well, if that worked, try to get a ResultSet
+ my $foo_rs;
+ lives_ok {
+ $foo_rs = $schema->resultset('Foo')->search();
+ } "($p{testname}) get a ResultSet for Foo";
+
+ # get a foo
+ my $foo;
+ lives_ok {
+ $foo = $foo_rs->first();
+ } "($p{testname}) get the first foo";
+
+ ok(defined $foo, "($p{testname}) \$foo is defined");
+
+ SKIP: {
+ skip 'foo is not defined', 3 unless defined $foo;
+
+ isa_ok $foo, $p{foo_class};
+
+ # call the file-defined method
+ my $biz;
+ lives_ok {
+ $biz = $foo->biz();
+ } "($p{testname}) call the file-defined Foo->biz method";
+
+ SKIP: {
+ skip 'no point in checking value if method was not found', 1 unless defined $biz;
+
+ ok(
+ $biz eq 'foo bar biz baz boz noz schnozz',
+ "($p{testname}) biz() method returns correct string"
+ );
+ }
+ }
+ }
+}
+
+sub make_schema_with {
+ my %p = @_;
+ return DBIx::Class::Schema::Loader::make_schema_at(
+ $p{schema_class},
+ $p{schema_opts},
+ [ $make_dbictest_db::dsn ],
+ );
+}
--- /dev/null
+package DBICTestMethods::Backcompat::Schema::Foo;
+
+use strict;
+use warnings FATAL => 'all';
+use English '-no_match_vars';
+
+sub biz {
+ my ($self) = @_;
+ return 'foo bar biz baz boz noz schnozz';
+}
+
+1;
--- /dev/null
+package DBICTestMethods::Namespaces::Schema::Result::Foo;
+
+use strict;
+use warnings FATAL => 'all';
+use English '-no_match_vars';
+
+sub biz {
+ my ($self) = @_;
+ return 'foo bar biz baz boz noz schnozz';
+}
+
+1;
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff