[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