From: Rafael Kitover Date: Fri, 22 May 2009 04:41:03 +0000 (+0000) Subject: DBIC::Schema - add tests for connect_info coercions X-Git-Tag: v0.26~30 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Model-DBIC-Schema.git;a=commitdiff_plain;h=7b1fe8c2e5b881354624365a942e52a655229e8b DBIC::Schema - add tests for connect_info coercions --- diff --git a/Makefile.PL b/Makefile.PL index 304c99f..6a78820 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -14,7 +14,8 @@ requires 'namespace::clean'; requires 'Carp::Clan'; requires 'List::MoreUtils'; -build_requires 'Test::More'; +test_requires 'Test::More'; +test_requires 'Test::Exception'; feature 'Catalyst::Helper support', -default => 0, diff --git a/lib/Catalyst/Model/DBIC/Schema.pm b/lib/Catalyst/Model/DBIC/Schema.pm index 4d6f22d..3a2d431 100644 --- a/lib/Catalyst/Model/DBIC/Schema.pm +++ b/lib/Catalyst/Model/DBIC/Schema.pm @@ -396,12 +396,6 @@ has 'storage_type' => (is => 'rw', isa => Str); has 'connect_info' => (is => 'ro', isa => ConnectInfo, coerce => 1); -# ref $self changes to anon after roles are applied, and _original_class_name is -# broken in MX::O::P 0.0009 -has '_class_name' => (is => 'ro', isa => ClassName, default => sub { - ref shift -}); - has 'model_name' => (is => 'ro', isa => Str, default => sub { my $self = shift; @@ -496,7 +490,7 @@ sub ACCEPT_CONTEXT { shift } sub _install_rs_models { my $self = shift; - my $class = $self->_class_name; + my $class = $self->_original_class_name; no strict 'refs'; diff --git a/lib/Catalyst/Model/DBIC/Schema/Types.pm b/lib/Catalyst/Model/DBIC/Schema/Types.pm index 9eb76a3..45a523e 100644 --- a/lib/Catalyst/Model/DBIC/Schema/Types.pm +++ b/lib/Catalyst/Model/DBIC/Schema/Types.pm @@ -31,9 +31,9 @@ subtype ConnectInfo, coerce ConnectInfo, from Str, - via { +{ dsn => $_ } }, + via(\&_coerce_connect_info_from_str), from ArrayRef, - via \&_coerce_connect_info_from_arrayref; + via(\&_coerce_connect_info_from_arrayref); # { connect_info => [ ... ] } coercion would be nice, but no chained coercions # yet. @@ -47,15 +47,21 @@ subtype ConnectInfos, coerce ConnectInfos, from Str, - via { [ { dsn => $_ } ] }, - from ArrayRef[Str], - via { [ map +{ dsn => $_ }, @$_ ] }, - from ArrayRef[ArrayRef], - via { [ map \&_coerce_connect_info_from_arrayref, @$_ ] }; + via { [ _coerce_connect_info_from_str() ] }, + from ArrayRef, + via { [ map { + !ref $_ ? _coerce_connect_info_from_str() + : reftype $_ eq 'HASH' ? $_ + : reftype $_ eq 'ARRAY' ? _coerce_connect_info_from_arrayref() + : die 'invalid connect_info' + } @$_ ] }; sub _coerce_connect_info_from_arrayref { my %connect_info; + # make a copy + $_ = [ @$_ ]; + if (!ref $_->[0]) { # array style $connect_info{dsn} = shift @$_; $connect_info{user} = shift @$_ if !ref $_->[0]; @@ -76,7 +82,16 @@ sub _coerce_connect_info_from_arrayref { die "invalid connect_info"; } + for my $key (qw/user password/) { + $connect_info{$key} = '' + if not defined $connect_info{$key}; + } + \%connect_info; } +sub _coerce_connect_info_from_str { + +{ dsn => $_, user => '', password => '' } +} + 1; diff --git a/t/07connect_info.t b/t/07connect_info.t new file mode 100644 index 0000000..0e0ed70 --- /dev/null +++ b/t/07connect_info.t @@ -0,0 +1,96 @@ +use strict; +use warnings; + +use FindBin '$Bin'; +use lib "$Bin/lib"; + +use Test::More; +use Test::Exception; +use Catalyst::Model::DBIC::Schema; +use ASchemaClass; + +# execise the connect_info coercion + +my @tests = ( + ['dbi:SQLite:foo.db', '', ''], + { dsn => 'dbi:SQLite:foo.db', user => '', password => '' }, + + ['dbi:SQLite:foo.db', ''], + { dsn => 'dbi:SQLite:foo.db', user => '', password => '' }, + + ['dbi:SQLite:foo.db'], + { dsn => 'dbi:SQLite:foo.db', user => '', password => '' }, + + 'dbi:SQLite:foo.db', + { dsn => 'dbi:SQLite:foo.db', user => '', password => '' }, + + ['dbi:Pg:dbname=foo', 'user', 'pass', + { pg_enable_utf8 => 1, auto_savepoint => 1 }], + { dsn => 'dbi:Pg:dbname=foo', user => 'user', password => 'pass', + pg_enable_utf8 => 1, auto_savepoint => 1 }, + + ['dbi:Pg:dbname=foo', 'user', 'pass', + { pg_enable_utf8 => 1 }, { auto_savepoint => 1 }], + { dsn => 'dbi:Pg:dbname=foo', user => 'user', password => 'pass', + pg_enable_utf8 => 1, auto_savepoint => 1 }, + + [ { dsn => 'dbi:Pg:dbname=foo', user => 'user', password => 'pass', + pg_enable_utf8 => 1, auto_savepoint => 1 } ], + { dsn => 'dbi:Pg:dbname=foo', user => 'user', password => 'pass', + pg_enable_utf8 => 1, auto_savepoint => 1 }, +); + +my @invalid = ( + { foo => 'bar' }, + [ { foo => 'bar' } ], + ['dbi:Pg:dbname=foo', 'user', 'pass', + { pg_enable_utf8 => 1 }, { AutoCommit => 1 }, { auto_savepoint => 1 }], +); + +plan tests => @tests / 2 + @invalid + 1; + +# ignore redefined warnings, and uninitialized warnings from old +# ::Storage::DBI::Replicated +local $SIG{__WARN__} = sub { + $_[0] !~ /(?:redefined|uninitialized)/i && warn @_ +}; + +for (my $i = 0; $i < @tests; $i += 2) { + my $m = instance( + connect_info => $tests[$i] + ); + + is_deeply $m->connect_info, $tests[$i+1], + 'connect_info coerced correctly'; +} + +throws_ok { instance(connect_info => $_) } qr/valid connect_info/i, + 'invalid connect_info throws exception' + for @invalid; + +# try as ConnectInfos (e.g.: replicants) +my @replicants = map $tests[$_], grep $_ % 2 == 0, 0..$#tests; + +{ + package TryConnectInfos; + + use Moose; + use Catalyst::Model::DBIC::Schema::Types 'ConnectInfos'; + + has replicants => (is => 'ro', isa => ConnectInfos, coerce => 1); +} + +my $m = TryConnectInfos->new( + replicants => \@replicants +); + +is_deeply $m->replicants, [ + map $tests[$_], grep $_ % 2, 0 .. $#tests +], 'replicant connect_infos coerced correctly'; + +sub instance { + Catalyst::Model::DBIC::Schema->new({ + schema_class => 'ASchemaClass', + @_ + }) +} diff --git a/t/lib/ASchemaClass.pm b/t/lib/ASchemaClass.pm new file mode 100644 index 0000000..576e9d5 --- /dev/null +++ b/t/lib/ASchemaClass.pm @@ -0,0 +1,7 @@ +package ASchemaClass; + +use base 'DBIx::Class::Schema'; + +__PACKAGE__->load_classes; + +1; diff --git a/t/lib/ASchemaClass/Users.pm b/t/lib/ASchemaClass/Users.pm new file mode 100644 index 0000000..f1ab4ad --- /dev/null +++ b/t/lib/ASchemaClass/Users.pm @@ -0,0 +1,13 @@ +package ASchemaClass::Users; + +# empty schemas no longer work + +use strict; +use warnings; + +use base 'DBIx::Class'; + +__PACKAGE__->load_components("Core"); +__PACKAGE__->table("users"); + +1;