suport for coderef connect_infos, cleanup types

diff --git a/Changes b/Changes
index dbebfdb..66961b2 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 Revision history for Perl extension Catalyst::Model::DBIC::Schema
 
+        - support for coderef connect_info's
+
 0.28  Thu Aug 27 08:14:05 EDT 2009
         - autobox issues in dep chain, bump CX::Component::Traits dep
         (caelum)

diff --git a/Makefile.PL b/Makefile.PL
index 72e6648..c2a1789 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -3,7 +3,7 @@ use inc::Module::Install 0.91;
 name 'Catalyst-Model-DBIC-Schema';
 all_from 'lib/Catalyst/Model/DBIC/Schema.pm';
 
-requires 'DBIx::Class'           => '0.08107';
+requires 'DBIx::Class'           => '0.08110';
 requires 'Catalyst::Runtime'     => '5.80005';
 requires 'CatalystX::Component::Traits' => '0.10';
 

diff --git a/lib/Catalyst/Helper/Model/DBIC/Schema.pm b/lib/Catalyst/Helper/Model/DBIC/Schema.pm
index c851d68..97f313f 100644 (file)
--- a/lib/Catalyst/Helper/Model/DBIC/Schema.pm
+++ b/lib/Catalyst/Helper/Model/DBIC/Schema.pm
@@ -4,7 +4,7 @@ use namespace::autoclean;
 use Moose;
 no warnings 'uninitialized';
 
-our $VERSION = '0.28';
+our $VERSION = '0.29';
 $VERSION = eval $VERSION;
 
 use Carp;

diff --git a/lib/Catalyst/Model/DBIC/Schema.pm b/lib/Catalyst/Model/DBIC/Schema.pm
index 6c1c67a..3fcf84c 100644 (file)
--- a/lib/Catalyst/Model/DBIC/Schema.pm
+++ b/lib/Catalyst/Model/DBIC/Schema.pm
@@ -5,7 +5,7 @@ use mro 'c3';
 extends 'Catalyst::Model';
 with 'CatalystX::Component::Traits';
 
-our $VERSION = '0.28';
+our $VERSION = '0.29';
 $VERSION = eval $VERSION;
 
 use namespace::autoclean;
@@ -14,7 +14,7 @@ use Data::Dumper;
 use DBIx::Class ();
 
 use Catalyst::Model::DBIC::Schema::Types
-    qw/ConnectInfo LoadedClass/;
+    qw/ConnectInfo LoadedClass SchemaClass/;
 
 use MooseX::Types::Moose qw/ArrayRef Str ClassName Undef/;
 
@@ -445,7 +445,7 @@ Used often for debugging and controlling transactions.
 
 has schema_class => (
     is => 'ro',
-    isa => LoadedClass,
+    isa => SchemaClass,
     coerce => 1,
     required => 1
 );

diff --git a/lib/Catalyst/Model/DBIC/Schema/Types.pm b/lib/Catalyst/Model/DBIC/Schema/Types.pm
index 88467d8..0bf8c3b 100644 (file)
--- a/lib/Catalyst/Model/DBIC/Schema/Types.pm
+++ b/lib/Catalyst/Model/DBIC/Schema/Types.pm
@@ -2,18 +2,16 @@ package  # hide from PAUSE
     Catalyst::Model::DBIC::Schema::Types;
 
 use MooseX::Types -declare => [qw/
-    ConnectInfo ConnectInfos Replicants LoadedClass CreateOption
+    ConnectInfo ConnectInfos Replicants SchemaClass LoadedClass CreateOption
 /];
 
 use Carp::Clan '^Catalyst::Model::DBIC::Schema';
-use MooseX::Types::Moose qw/ArrayRef HashRef Str ClassName/;
+use MooseX::Types::Moose qw/ArrayRef HashRef CodeRef Str ClassName/;
 use Scalar::Util 'reftype';
 use List::MoreUtils 'all';
 
 use namespace::clean -except => 'meta';
 
-class_type 'DBIx::Class::Schema';
-
 subtype LoadedClass,
     as ClassName;
 
@@ -21,16 +19,25 @@ coerce LoadedClass,
     from Str,
     via { Class::MOP::load_class($_); $_ };
 
+subtype SchemaClass,
+    as ClassName,
+    where { $_->isa('DBIx::Class::Schema') };
+
+SchemaClass->coercion(LoadedClass->coercion);
+
 subtype ConnectInfo,
     as HashRef,
-    where { exists $_->{dsn} },
+    where { exists $_->{dsn} || exists $_->{dbh_maker} },
     message { 'Does not look like a valid connect_info' };
 
 coerce ConnectInfo,
     from Str,
     via(\&_coerce_connect_info_from_str),
     from ArrayRef,
-    via(\&_coerce_connect_info_from_arrayref);
+    via(\&_coerce_connect_info_from_arrayref),
+    from CodeRef,
+    via { +{ dbh_maker => $_ } },
+;
 
 # { connect_info => [ ... ] } coercion would be nice, but no chained coercions
 # yet.
@@ -44,13 +51,16 @@ subtype ConnectInfos,
 
 coerce ConnectInfos,
     from Str,
-    via  { [ _coerce_connect_info_from_str() ] },
+    via { [ _coerce_connect_info_from_str() ] },
+    from CodeRef,
+    via { [ +{ dbh_maker => $_ } ]  },
     from ArrayRef,
     via { [ map {
         !ref $_ ? _coerce_connect_info_from_str()
             : reftype $_ eq 'HASH' ? $_
+            : reftype $_ eq 'CODE' ? +{ dbh_maker => $_ }
             : reftype $_ eq 'ARRAY' ? _coerce_connect_info_from_arrayref()
-            : die 'invalid connect_info'
+            : croak 'invalid connect_info'
     } @$_ ] };
 
 # Helper stuff
@@ -66,29 +76,42 @@ sub _coerce_connect_info_from_arrayref {
     # make a copy
     $_ = [ @$_ ];
 
-    if (!ref $_->[0]) { # array style
-        $connect_info{dsn}      = shift @$_;
-        $connect_info{user}     = shift @$_ if !ref $_->[0];
-        $connect_info{password} = shift @$_ if !ref $_->[0];
-
+    my $slurp_hashes = sub {
         for my $i (0..1) {
             my $extra = shift @$_;
             last unless $extra;
-            die "invalid connect_info" unless reftype $extra eq 'HASH';
+            croak "invalid connect_info"
+                unless ref $extra && reftype $extra eq 'HASH';
 
             %connect_info = (%connect_info, %$extra);
         }
+    };
 
-        die "invalid connect_info" if @$_;
-    } elsif (@$_ == 1 && reftype $_->[0] eq 'HASH') {
+    if (!ref $_->[0]) { # array style
+        $connect_info{dsn}      = shift @$_;
+        $connect_info{user}     = shift @$_ if !ref $_->[0];
+        $connect_info{password} = shift @$_ if !ref $_->[0];
+
+        $slurp_hashes->();
+
+        croak "invalid connect_info" if @$_;
+    } elsif (ref $_->[0] && reftype $_->[0] eq 'CODE') {
+        $connect_info{dbh_maker} = shift @$_;
+
+        $slurp_hashes->();
+
+        croak "invalid connect_info" if @$_;
+    } elsif (@$_ == 1 && ref $_->[0] && reftype $_->[0] eq 'HASH') {
         return $_->[0];
     } else {
-        die "invalid connect_info";
+        croak "invalid connect_info";
     }
 
-    for my $key (qw/user password/) {
-        $connect_info{$key} = ''
-            if not defined $connect_info{$key};
+    unless ($connect_info{dbh_maker}) {
+        for my $key (qw/user password/) {
+            $connect_info{$key} = ''
+                if not defined $connect_info{$key};
+        }
     }
 
     \%connect_info;

diff --git a/t/07connect_info.t b/t/07connect_info.t
index e49dba1..bb5c9ad 100644 (file)
--- a/t/07connect_info.t
+++ b/t/07connect_info.t
@@ -11,6 +11,8 @@ use ASchemaClass;
 
 # execise the connect_info coercion
 
+my $coderef = sub {};
+
 my @tests = (
     ['dbi:SQLite:foo.db', '', ''],
     { dsn => 'dbi:SQLite:foo.db', user => '', password => '' },
@@ -38,6 +40,9 @@ my @tests = (
         pg_enable_utf8 => 1, auto_savepoint => 1 } ],
     { dsn => 'dbi:Pg:dbname=foo', user => 'user', password => 'pass',
         pg_enable_utf8 => 1, auto_savepoint => 1 },
+
+    [$coderef, { pg_enable_utf8 => 1, auto_savepoint => 1 }],
+    { dbh_maker => $coderef, pg_enable_utf8 => 1, auto_savepoint => 1 },
 );
 
 my @invalid = (