[Catalyst-commits] r10235 - in trunk/Catalyst-Model-DBIC-Schema: .
lib/Catalyst/Model/DBIC lib/Catalyst/Model/DBIC/Schema t
t/lib t/lib/ASchemaClass
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Fri May 22 04:41:04 GMT 2009
Author: caelum
Date: 2009-05-22 04:41:03 +0000 (Fri, 22 May 2009)
New Revision: 10235
Added:
trunk/Catalyst-Model-DBIC-Schema/t/07connect_info.t
trunk/Catalyst-Model-DBIC-Schema/t/lib/ASchemaClass.pm
trunk/Catalyst-Model-DBIC-Schema/t/lib/ASchemaClass/
trunk/Catalyst-Model-DBIC-Schema/t/lib/ASchemaClass/Users.pm
Modified:
trunk/Catalyst-Model-DBIC-Schema/Makefile.PL
trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Model/DBIC/Schema.pm
trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Model/DBIC/Schema/Types.pm
Log:
DBIC::Schema - add tests for connect_info coercions
Modified: trunk/Catalyst-Model-DBIC-Schema/Makefile.PL
===================================================================
--- trunk/Catalyst-Model-DBIC-Schema/Makefile.PL 2009-05-22 01:28:50 UTC (rev 10234)
+++ trunk/Catalyst-Model-DBIC-Schema/Makefile.PL 2009-05-22 04:41:03 UTC (rev 10235)
@@ -14,7 +14,8 @@
requires 'Carp::Clan';
requires 'List::MoreUtils';
-build_requires 'Test::More';
+test_requires 'Test::More';
+test_requires 'Test::Exception';
feature 'Catalyst::Helper support',
-default => 0,
Modified: trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Model/DBIC/Schema/Types.pm
===================================================================
--- trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Model/DBIC/Schema/Types.pm 2009-05-22 01:28:50 UTC (rev 10234)
+++ trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Model/DBIC/Schema/Types.pm 2009-05-22 04:41:03 UTC (rev 10235)
@@ -31,9 +31,9 @@
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 @@
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 @@
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;
Modified: trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Model/DBIC/Schema.pm
===================================================================
--- trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Model/DBIC/Schema.pm 2009-05-22 01:28:50 UTC (rev 10234)
+++ trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Model/DBIC/Schema.pm 2009-05-22 04:41:03 UTC (rev 10235)
@@ -396,12 +396,6 @@
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 _install_rs_models {
my $self = shift;
- my $class = $self->_class_name;
+ my $class = $self->_original_class_name;
no strict 'refs';
Added: trunk/Catalyst-Model-DBIC-Schema/t/07connect_info.t
===================================================================
--- trunk/Catalyst-Model-DBIC-Schema/t/07connect_info.t (rev 0)
+++ trunk/Catalyst-Model-DBIC-Schema/t/07connect_info.t 2009-05-22 04:41:03 UTC (rev 10235)
@@ -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',
+ @_
+ })
+}
Added: trunk/Catalyst-Model-DBIC-Schema/t/lib/ASchemaClass/Users.pm
===================================================================
--- trunk/Catalyst-Model-DBIC-Schema/t/lib/ASchemaClass/Users.pm (rev 0)
+++ trunk/Catalyst-Model-DBIC-Schema/t/lib/ASchemaClass/Users.pm 2009-05-22 04:41:03 UTC (rev 10235)
@@ -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;
Added: trunk/Catalyst-Model-DBIC-Schema/t/lib/ASchemaClass.pm
===================================================================
--- trunk/Catalyst-Model-DBIC-Schema/t/lib/ASchemaClass.pm (rev 0)
+++ trunk/Catalyst-Model-DBIC-Schema/t/lib/ASchemaClass.pm 2009-05-22 04:41:03 UTC (rev 10235)
@@ -0,0 +1,7 @@
+package ASchemaClass;
+
+use base 'DBIx::Class::Schema';
+
+__PACKAGE__->load_classes;
+
+1;
More information about the Catalyst-commits
mailing list