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.
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];
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;
--- /dev/null
+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',
+ @_
+ })
+}