use Class::Inspector ();
use Scalar::Util 'looks_like_number';
use File::Slurp 'slurp';
-use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed/;
+use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_without_redefine_warnings/;
use DBIx::Class::Schema::Loader::Optional::Dependencies ();
use Try::Tiny;
use DBIx::Class ();
$code = $self->_rewrite_old_classnames($code);
if ($self->dynamic) { # load the class too
- # kill redefined warnings
- my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
- local $SIG{__WARN__} = sub {
- $warn_handler->(@_)
- unless $_[0] =~ /^Subroutine \S+ redefined/;
- };
- eval $code;
- die $@ if $@;
+ eval_without_redefine_warnings($code);
}
$self->_ext_stmt($class,
* PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the
new name of the Result.
EOF
- # kill redefined warnings
- my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
- local $SIG{__WARN__} = sub {
- $warn_handler->(@_)
- unless $_[0] =~ /^Subroutine \S+ redefined/;
- };
- eval $code;
- die $@ if $@;
+ eval_without_redefine_warnings($code);
}
chomp $code;
delete $INC{ $class_path };
# kill redefined warnings
- my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
- local $SIG{__WARN__} = sub {
- $warn_handler->(@_)
- unless $_[0] =~ /^Subroutine \S+ redefined/;
+ eval {
+ eval_without_redefine_warnings ("require $class");
};
- eval "require $class;";
die "Failed to reload class $class: $@" if $@;
}
if ($dbh->can('column_info')) {
my %result;
eval {
- my $sth = eval { local $SIG{__WARN__} = sub {}; $dbh->column_info( undef, $self->db_schema, $table, '%' ); };
+ my $sth = do {
+ # FIXME - seems to only warn on MySQL, and even then the output is valuable
+ # need to figure out how no to mask it away (and still have tests pass)
+ local $SIG{__WARN__} = sub {};
+ $dbh->column_info( undef, $self->db_schema, $table, '%' );
+ };
while ( my $info = $sth->fetchrow_hashref() ){
my $column_info = {};
$column_info->{data_type} = lc $info->{TYPE_NAME};
}
$sth->finish;
};
- return \%result if !$@ && scalar keys %result;
+
+ return \%result if !$@ && scalar keys %result;
}
my %result;
sub _table_uniq_info {
my ($self, $table) = @_;
+ # FIXME - remove blind mask (can't test sybase yet)
local $SIG{__WARN__} = sub {};
my $dbh = $self->schema->storage->dbh;
use warnings;
use Exporter 'import';
-our @EXPORT_OK = qw/split_name dumper dumper_squashed/;
+our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_without_redefine_warnings/;
use constant BY_CASE_TRANSITION =>
qr/(?<=[[:lower:]\d])[\W_]*(?=[[:upper:]])|[\W_]+/;
return $dd->Values([ $val ])->Dump;
}
+sub eval_without_redefine_warnings {
+ my $code = shift;
+
+ my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
+ local $SIG{__WARN__} = sub {
+ $warn_handler->(@_)
+ unless $_[0] =~ /^Subroutine \S+ redefined/;
+ };
+ eval $code;
+ die $@ if $@;
+}
+
1;
# vim:et sts=4 sw=4 tw=0:
user => $user,
password => $password,
loader_options => { preserve_case => 1 },
+ connect_info_opts => {
+ on_connect_do => [ 'SET client_min_messages=WARNING' ],
+ },
quote_char => '"',
data_types => {
# http://www.postgresql.org/docs/7.4/interactive/datatype.html
use warnings;
use Test::More;
use Test::Exception;
+use Test::Warn;
# use this if you keep a copy of DBD::Sybase linked to FreeTDS somewhere else
BEGIN {
my $dbh = $schema->storage->dbh;
$dbh->do("DROP TABLE mssql_loader_test3");
- my @warnings;
- {
- local $SIG{__WARN__} = sub { push @warnings, $_[0] };
- $schema->rescan;
- }
- ok ((grep /^Bad table or view 'mssql_loader_test4'/, @warnings),
- 'bad view ignored');
+ warnings_exist { $schema->rescan }
+ qr/^Bad table or view 'mssql_loader_test4'/, 'bad view ignored';
throws_ok {
$schema->resultset($monikers->{mssql_loader_test4})
$schema->_loader->_setup;
{
+ # FIXME - need to remove blind trap (can not test firebird yet)
local $SIG{__WARN__} = sub {};
$schema->rescan;
}
else {
# get rid of stupid warning from InterBase/GetInfo.pm
if ($dbd_interbase_dsn) {
+ # FIXME - need to remove blind trap (can not test firebird yet)
local $SIG{__WARN__} = sub {};
require DBD::InterBase;
require DBD::InterBase::GetInfo;
my $schema = do {
local $SIG{__WARN__} = sub {
- warn $_[0] unless $_[0] =~ /really_erase_my_files/
+ warn $_[0] unless $_[0] =~ /Deleting existing file .+ due to 'really_erase_my_files' setting/
};
$cref->();
};
use strict;
use Test::More;
+use Test::Exception;
+use Test::Warn;
use lib qw(t/lib);
use File::Path;
use make_dbictest_db;
my $dump_path = "$tdir/dump";
-local $SIG{__WARN__} = sub {
- warn $_[0] unless $_[0] =~
- /really_erase_my_files|Dumping manual schema|Schema dump completed/;
-};
{
package DBICTest::Schema::1;
);
}
-plan tests => 5;
+plan tests => 7;
rmtree($dump_path, 1, 1);
-eval { DBICTest::Schema::1->connect($make_dbictest_db::dsn) };
-ok(!$@, 'no death with dump_directory set') or diag "Dump failed: $@";
+lives_ok {
+ warnings_exist { DBICTest::Schema::1->connect($make_dbictest_db::dsn) }
+ [ qr|^Dumping manual schema|, qr|^Schema dump completed| ];
+} 'no death with dump_directory set' or diag "Dump failed: $@";
DBICTest::Schema::1->_loader_invoked(undef);
SKIP: {
- my @warnings_regexes = (
- qr|Dumping manual schema|,
- qr|Schema dump completed|,
- );
-
- skip "ActiveState perl produces additional warnings", scalar @warnings_regexes
+ skip "ActiveState perl produces additional warnings", 1
if ($^O eq 'MSWin32');
- my @warn_output;
- {
- local $SIG{__WARN__} = sub { push(@warn_output, @_) };
- DBICTest::Schema::1->connect($make_dbictest_db::dsn);
- }
-
- like(shift @warn_output, $_) foreach (@warnings_regexes);
+ warnings_exist { DBICTest::Schema::1->connect($make_dbictest_db::dsn) }
+ [ qr|^Dumping manual schema|, qr|^Schema dump completed| ];
rmtree($dump_path, 1, 1);
}
-eval { DBICTest::Schema::2->connect($make_dbictest_db::dsn) };
-ok(!$@, 'no death with dump_directory set (overwrite1)')
- or diag "Dump failed: $@";
+lives_ok {
+ warnings_exist { DBICTest::Schema::2->connect($make_dbictest_db::dsn) }
+ [ qr|^Dumping manual schema|, qr|^Schema dump completed| ];
+} 'no death with dump_directory set (overwrite1)' or diag "Dump failed: $@";
DBICTest::Schema::2->_loader_invoked(undef);
-eval { DBICTest::Schema::2->connect($make_dbictest_db::dsn) };
-ok(!$@, 'no death with dump_directory set (overwrite2)')
- or diag "Dump failed: $@";
+
+lives_ok {
+ warnings_exist { DBICTest::Schema::2->connect($make_dbictest_db::dsn) }
+ [
+ qr/^Dumping manual schema/,
+ qr|^Deleting .+Schema/2.+ due to 'really_erase_my_files'|,
+ qr|^Deleting .+Schema/2/Result/Foo.+ due to 'really_erase_my_files'|,
+ qr|^Deleting .+Schema/2/Result/Bar.+ due to 'really_erase_my_files'|,
+ qr/^Schema dump completed/
+ ];
+} 'no death with dump_directory set (overwrite2)' or diag "Dump failed: $@";
END { rmtree($dump_path, 1, 1); }
my @connect_info = $make_dbictest_db_with_unique::dsn;
my @loader_warnings;
- local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
+ local $SIG{__WARN__} = sub { push(@loader_warnings, @_); };
eval qq{
package $SCHEMA_CLASS;
use base qw/DBIx::Class::Schema::Loader/;
use strict;
-use Test::More tests => 3;
+use Test::More tests => 5;
use Test::Exception;
+use Test::Warn;
use lib qw(t/lib);
use make_dbictest_db;
open my $in, '<', $foopm or die "$! reading $foopm";
my ($tfh,$temp) = tempfile( UNLINK => 1);
while(<$in>) {
- s/"bars"/"somethingelse"/;
- print $tfh $_;
+ s/"bars"/"somethingelse"/;
+ print $tfh $_;
}
close $tfh;
copy( $temp, $foopm );
# need to poke _loader_invoked in order to be able to rerun the
# loader multiple times.
DBICTest::Schema::Overwrite_modifications->_loader_invoked(0)
- if @DBICTest::Schema::Overwrite_modifications::ISA;
-
- local $SIG{__WARN__} = sub {
- warn @_
- unless $_[0] =~ /^Dumping manual schema|^Schema dump completed/;
- };
- DBIx::Class::Schema::Loader::make_schema_at( 'DBICTest::Schema::Overwrite_modifications',
- { dump_directory => $tempdir,
- @_,
- },
- [ $make_dbictest_db::dsn ],
- );
+ if @DBICTest::Schema::Overwrite_modifications::ISA;
+
+ my $args = \@_;
+
+ warnings_exist {
+ DBIx::Class::Schema::Loader::make_schema_at( 'DBICTest::Schema::Overwrite_modifications',
+ { dump_directory => $tempdir, @$args },
+ [ $make_dbictest_db::dsn ],
+ );
+ } [qr/^Dumping manual schema/, qr/^Schema dump completed/ ];
}
);
{
- # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..."
- local $SIG{__WARN__} = sub {
- my $msg = shift;
- warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
- };
-
my $dbh = $self->dbconnect(1);
$dbh->do($_) for @statements_rescan;
$dbh->disconnect;
if ($self->{dsn} =~ /^[^:]+:SQLite:/) {
$dbh->do ('PRAGMA synchronous = OFF');
}
+ elsif ($self->{dsn} =~ /^[^:]+:Pg:/) {
+ $dbh->do ('SET client_min_messages=WARNING');
+ }
die "Failed to connect to database: $DBI::errstr" if !$dbh;
my $dbh = $self->dbconnect(1);
- # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..."
- local $SIG{__WARN__} = sub {
- my $msg = shift;
- warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
- };
-
$dbh->do($_) for (@statements);
unless($self->{skip_rels}) {
# hack for now, since DB2 doesn't like inline comments, and we need
$self->drop_extra_tables_only;
my $dbh = $self->dbconnect(1);
- {
- # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..."
- local $SIG{__WARN__} = sub {
- my $msg = shift;
- warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
- };
-
-
- $dbh->do($_) for @{ $self->{extra}{create} || [] };
- $dbh->do($_) for @{ $self->{data_type_tests}{ddl} || []};
- }
+ $dbh->do($_) for @{ $self->{extra}{create} || [] };
+ $dbh->do($_) for @{ $self->{data_type_tests}{ddl} || []};
$self->{_created} = 1;
my $file_count = grep /CREATE (?:TABLE|VIEW)/i, @{ $self->{extra}{create} || [] };
my $dbh = $self->dbconnect(0);
- {
- local $SIG{__WARN__} = sub {}; # postgres notices
- $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] };
- }
-
+ $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] };
$dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] };
foreach my $data_type_table (@{ $self->{data_type_tests}{table_names} || [] }) {
my $file_count;
{
my @loader_warnings;
- local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
+ local $SIG{__WARN__} = sub { push(@loader_warnings, @_); };
eval qq{
package $schema_class;
use base qw/DBIx::Class::Schema::Loader/;
$conn->storage->disconnect; # needed for Firebird and Informix
my $dbh = $self->dbconnect(1);
-
- {
- # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..."
- local $SIG{__WARN__} = sub {
- my $msg = shift;
- warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
- };
-
- $dbh->do($_) for @statements_rescan;
- }
-
+ $dbh->do($_) for @statements_rescan;
$dbh->disconnect;
sleep 1;
my @new = do {
- # kill the 'Dumping manual schema' warnings
- local $SIG{__WARN__} = sub {};
+ local $SIG{__WARN__} = sub { warn @_
+ unless $_[0] =~ /(?i:loader_test)\d+ has no primary key|^Dumping manual schema|^Schema dump completed/
+ };
$conn->rescan;
};
is_deeply(\@new, [ qw/LoaderTest30/ ], "Rescan");
$conn->storage->dbh->do("DROP TABLE loader_test30");
@new = do {
- local $SIG{__WARN__} = sub {};
+ local $SIG{__WARN__} = sub { warn @_
+ unless $_[0] =~ /(?i:loader_test)\d+ has no primary key|^Dumping manual schema|^Schema dump completed/
+ };
$conn->rescan;
};
is_deeply(\@new, [], 'no new tables on rescan');
my ($oqt, $cqt) = $self->get_oqt_cqt(always => 1); # open quote, close quote
- my $dbh = $conn->storage->dbh;
-
- {
- # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..."
- local $SIG{__WARN__} = sub {
- my $msg = shift;
- warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
- };
+ my $dbh = $self->dbconnect;
- $dbh->do($_) for (
+ $dbh->do($_) for (
qq|
CREATE TABLE ${oqt}LoaderTest40${cqt} (
${oqt}Id${cqt} INTEGER NOT NULL PRIMARY KEY,
|,
qq| INSERT INTO ${oqt}LoaderTest40${cqt} VALUES (1, 'foo') |,
qq| INSERT INTO ${oqt}LoaderTest41${cqt} VALUES (1, 1) |,
- );
- }
+ );
$conn->storage->disconnect;
local $conn->_loader->{preserve_case} = 1;
$conn->_loader->_setup;
+
{
- local $SIG{__WARN__} = sub {};
+ local $SIG{__WARN__} = sub { warn @_
+ unless $_[0] =~ /(?i:loader_test)\d+ has no primary key|^Dumping manual schema|^Schema dump completed/
+ };
$conn->rescan;
- }
+ };
if (not $self->{skip_rels}) {
is $conn->resultset('LoaderTest41')->find(1)->loader_test40->foo3_bar, 'foo',
my $dbh = $self->dbconnect(1);
- # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..."
- local $SIG{__WARN__} = sub {
- my $msg = shift;
- warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
- };
-
$dbh->do($_) foreach (@statements);
$dbh->do($_) foreach (@{ $self->{data_type_tests}{ddl} || [] });
for (1,2) {
my $dbh = $self->dbconnect(0);
- {
- local $SIG{__WARN__} = sub {}; # postgres notices
- $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] };
- }
+ $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] };
$dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] };
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff