From: Peter Rabbitson Date: Tue, 19 Jan 2010 12:41:03 +0000 (+0000) Subject: Some minor test refactor and tab cleanups X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d7a58a293db88796ae70bbfaad9edae9fd94abd0;p=dbsrgits%2FDBIx-Class-Historic.git Some minor test refactor and tab cleanups --- diff --git a/lib/DBIx/Class/Relationship/ManyToMany.pm b/lib/DBIx/Class/Relationship/ManyToMany.pm index 07a244a..137fb30 100644 --- a/lib/DBIx/Class/Relationship/ManyToMany.pm +++ b/lib/DBIx/Class/Relationship/ManyToMany.pm @@ -64,15 +64,15 @@ EOW my $rs = $self->search_related($rel)->search_related( $f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs } ); - return $rs; + return $rs; }; my $meth_name = join '::', $class, $meth; *$meth_name = Sub::Name::subname $meth_name, sub { - my $self = shift; - my $rs = $self->$rs_meth( @_ ); - return (wantarray ? $rs->all : $rs); - }; + my $self = shift; + my $rs = $self->$rs_meth( @_ ); + return (wantarray ? $rs->all : $rs); + }; my $add_meth_name = join '::', $class, $add_meth; *$add_meth_name = Sub::Name::subname $add_meth_name, sub { @@ -102,7 +102,7 @@ EOW my $link = $self->search_related($rel)->new_result($link_vals); $link->set_from_related($f_rel, $obj); $link->insert(); - return $obj; + return $obj; }; my $set_meth_name = join '::', $class, $set_meth; diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index e6af6e0..c4daa0d 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -268,7 +268,7 @@ and the schema_version which is retrieved via $self->schema_version =cut sub create_upgrade_path { - ## override this method + ## override this method } =head2 upgrade @@ -321,7 +321,7 @@ sub upgrade return; } - carp "\nDB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n"; + carp "DB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n"; # backup if necessary then apply upgrade $self->_filedata($self->_read_sql_file($upgrade_file)); @@ -391,7 +391,7 @@ differently. sub apply_statement { my ($self, $statement) = @_; - $self->storage->dbh->do($_) or carp "SQL was:\n $_"; + $self->storage->dbh->do($_) or carp "SQL was: $_"; } =head2 get_db_version @@ -502,7 +502,7 @@ sub _on_connect return 1; } - carp "Versions out of sync. This is " . $self->schema_version . + carp "Versions out of sync. This is " . $self->schema_version . ", your database contains version $pversion, please call upgrade on your Schema.\n"; } diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index fe81851..55cad0e 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -209,11 +209,15 @@ sub connect_call_datetime_setup { my $timestamp_tz_format = $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM'; - $self->_do_query("alter session set nls_date_format = '$date_format'"); $self->_do_query( -"alter session set nls_timestamp_format = '$timestamp_format'"); + "alter session set nls_date_format = '$date_format'" + ); $self->_do_query( -"alter session set nls_timestamp_tz_format='$timestamp_tz_format'"); + "alter session set nls_timestamp_format = '$timestamp_format'" + ); + $self->_do_query( + "alter session set nls_timestamp_tz_format='$timestamp_tz_format'" + ); } =head2 source_bind_attributes @@ -235,35 +239,35 @@ table with more than one LOB column. sub source_bind_attributes { - require DBD::Oracle; - my $self = shift; - my($source) = @_; + require DBD::Oracle; + my $self = shift; + my($source) = @_; - my %bind_attributes; + my %bind_attributes; - foreach my $column ($source->columns) { - my $data_type = $source->column_info($column)->{data_type} || ''; - next unless $data_type; + foreach my $column ($source->columns) { + my $data_type = $source->column_info($column)->{data_type} || ''; + next unless $data_type; - my %column_bind_attrs = $self->bind_attribute_by_data_type($data_type); + my %column_bind_attrs = $self->bind_attribute_by_data_type($data_type); - if ($data_type =~ /^[BC]LOB$/i) { - $column_bind_attrs{'ora_type'} = uc($data_type) eq 'CLOB' ? - DBD::Oracle::ORA_CLOB() : - DBD::Oracle::ORA_BLOB(); - $column_bind_attrs{'ora_field'} = $column; - } + if ($data_type =~ /^[BC]LOB$/i) { + $column_bind_attrs{'ora_type'} = uc($data_type) eq 'CLOB' + ? DBD::Oracle::ORA_CLOB() + : DBD::Oracle::ORA_BLOB() + ; + $column_bind_attrs{'ora_field'} = $column; + } - $bind_attributes{$column} = \%column_bind_attrs; - } + $bind_attributes{$column} = \%column_bind_attrs; + } - return \%bind_attributes; + return \%bind_attributes; } sub _svp_begin { - my ($self, $name) = @_; - - $self->_get_dbh->do("SAVEPOINT $name"); + my ($self, $name) = @_; + $self->_get_dbh->do("SAVEPOINT $name"); } # Oracle automatically releases a savepoint when you start another one with the @@ -271,9 +275,8 @@ sub _svp_begin { sub _svp_release { 1 } sub _svp_rollback { - my ($self, $name) = @_; - - $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name") + my ($self, $name) = @_; + $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name") } =head2 relname_to_table_alias diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index 200483d..f8958da 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -409,7 +409,7 @@ bits get put into the correct places. =cut sub BUILDARGS { - my ($class, $schema, $storage_type_args, @args) = @_; + my ($class, $schema, $storage_type_args, @args) = @_; return { schema=>$schema, diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm index a7a1dfa..a496512 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm @@ -280,16 +280,15 @@ sub _safely { eval { $code->() - }; + }; if ($@) { - $replicant - ->debugobj - ->print( - sprintf( "Exception trying to $name for replicant %s, error is %s", - $replicant->_dbi_connect_info->[0], $@) - ); - return; + $replicant->debugobj->print(sprintf( + "Exception trying to $name for replicant %s, error is %s", + $replicant->_dbi_connect_info->[0], $@) + ); + return undef; } + return 1; } diff --git a/t/94versioning.t b/t/94versioning.t index 674a855..2d286ef 100644 --- a/t/94versioning.t +++ b/t/94versioning.t @@ -3,7 +3,10 @@ use strict; use warnings; use Test::More; -use File::Spec; +use Test::Warn; +use Test::Exception; + +use Path::Class; use File::Copy; #warn "$dsn $user $pass"; @@ -28,11 +31,11 @@ BEGIN { my $version_table_name = 'dbix_class_schema_versions'; my $old_table_name = 'SchemaVersions'; -my $ddl_dir = File::Spec->catdir ('t', 'var'); +my $ddl_dir = dir ('t', 'var'); my $fn = { - v1 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-1.0-MySQL.sql'), - v2 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-2.0-MySQL.sql'), - trans => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-1.0-2.0-MySQL.sql'), + v1 => $ddl_dir->file ('DBICVersion-Schema-1.0-MySQL.sql'), + v2 => $ddl_dir->file ('DBICVersion-Schema-2.0-MySQL.sql'), + trans => $ddl_dir->file ('DBICVersion-Schema-1.0-2.0-MySQL.sql'), }; use lib qw(t/lib); @@ -68,60 +71,46 @@ my $schema_upgrade = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_v $schema_upgrade->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0'); ok(-f $fn->{trans}, 'Created DDL file'); - { - my $w; - local $SIG{__WARN__} = sub { $w = shift }; - - sleep 1; # remove this when TODO below is completed - - $schema_upgrade->upgrade(); - like ($w, qr/Attempting upgrade\.$/, 'Warn before upgrade'); - } + sleep 1; # remove this when TODO below is completed + warnings_like ( + sub { $schema_upgrade->upgrade() }, + qr/DB version .+? is lower than the schema version/, + 'Warn before upgrade', + ); is($schema_upgrade->get_db_version(), '2.0', 'db version number upgraded'); - eval { + lives_ok ( sub { $schema_upgrade->storage->dbh->do('select NewVersionName from TestVersion'); - }; - is($@, '', 'new column created'); - - # should overwrite files and warn about it - my @w; - local $SIG{__WARN__} = sub { - if ($_[0] =~ /Overwriting existing/) { - push @w, $_[0]; - } - else { - warn @_; - } - }; - $schema_upgrade->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0'); - - is (2, @w, 'A warning generated for both the DDL and the diff'); - like ($w[0], qr/Overwriting existing DDL file - $fn->{v2}/, 'New version DDL overwrite warning'); - like ($w[1], qr/Overwriting existing diff file - $fn->{trans}/, 'Upgrade diff overwrite warning'); + }, 'new column created' ); + + warnings_exist ( + sub { $schema_upgrade->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0') }, + [ + qr/Overwriting existing DDL file - $fn->{v2}/, + qr/Overwriting existing diff file - $fn->{trans}/, + ], + 'An overwrite warning generated for both the DDL and the diff', + ); } { my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass); - eval { + lives_ok (sub { $schema_version->storage->dbh->do('select * from ' . $version_table_name); - }; - is($@, '', 'version table exists'); + }, 'version table exists'); - eval { + lives_ok (sub { $schema_version->storage->dbh->do("DROP TABLE IF EXISTS $old_table_name"); $schema_version->storage->dbh->do("RENAME TABLE $version_table_name TO $old_table_name"); - }; - is($@, '', 'versions table renamed to old style table'); + }, 'versions table renamed to old style table'); $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass); is($schema_version->get_db_version, '2.0', 'transition from old table name to new okay'); - eval { + dies_ok (sub { $schema_version->storage->dbh->do('select * from ' . $old_table_name); - }; - ok($@, 'old version table gone'); + }, 'old version table gone'); } @@ -133,28 +122,23 @@ my $schema_upgrade = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_v }; - my $warn = ''; - local $SIG{__WARN__} = sub { $warn = shift }; - $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass); - like($warn, qr/Your DB is currently unversioned/, 'warning detected without env var or attr'); + warnings_like ( sub { + $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass); + }, qr/Your DB is currently unversioned/, 'warning detected without env var or attr' ); + warnings_like ( sub { + $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); + }, [], 'warning not detected with attr set'); - # should warn - $warn = ''; - $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); - is($warn, '', 'warning not detected with attr set'); - # should not warn local $ENV{DBIC_NO_VERSION_CHECK} = 1; - $warn = ''; - $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass); - is($warn, '', 'warning not detected with env var set'); - # should not warn + warnings_like ( sub { + $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass); + }, [], 'warning not detected with env var set'); - $warn = ''; - $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 0 }); - like($warn, qr/Your DB is currently unversioned/, 'warning detected without env var or attr'); - # should warn + warnings_like ( sub { + $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 0 }); + }, qr/Your DB is currently unversioned/, 'warning detected without env var or attr'); } # attempt a deploy/upgrade cycle within one second diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm index 66a79e8..8006961 100644 --- a/t/lib/DBICTest.pm +++ b/t/lib/DBICTest.pm @@ -32,7 +32,7 @@ DBIx::Class. no_populate=>1, storage_type=>'::DBI::Replicated', storage_type_args=>{ - balancer_type=>'DBIx::Class::Storage::DBI::Replicated::Balancer::Random' + balancer_type=>'DBIx::Class::Storage::DBI::Replicated::Balancer::Random' }, ); @@ -48,7 +48,7 @@ default, unless the no_deploy or no_populate flags are set. =cut sub has_custom_dsn { - return $ENV{"DBICTEST_DSN"} ? 1:0; + return $ENV{"DBICTEST_DSN"} ? 1:0; } sub _sqlite_dbfilename { @@ -59,7 +59,7 @@ sub _sqlite_dbname { my $self = shift; my %args = @_; return $self->_sqlite_dbfilename if $args{sqlite_use_file} or $ENV{"DBICTEST_SQLITE_USE_FILE"}; - return ":memory:"; + return ":memory:"; } sub _database { @@ -85,7 +85,7 @@ sub init_schema { my %args = @_; my $schema; - + if ($args{compose_connection}) { $schema = DBICTest::Schema->compose_connection( 'DBICTest', $self->_database(%args) @@ -94,8 +94,8 @@ sub init_schema { $schema = DBICTest::Schema->compose_namespace('DBICTest'); } if( $args{storage_type}) { - $schema->storage_type($args{storage_type}); - } + $schema->storage_type($args{storage_type}); + } if ( !$args{no_connect} ) { $schema = $schema->connect($self->_database(%args)); $schema->storage->on_connect_do(['PRAGMA synchronous = OFF'])