X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FModel%2FDBIC%2FSchema%2FTypes.pm;h=0bf8c3bb7b33d1539d638a9ff1c0007f2b75aa87;hb=2fa0a1f11f9a8e53c107f407e4bfdc8715114b23;hp=45a523e2235ec1a185434b145ae54944f901bc4b;hpb=7b1fe8c2e5b881354624365a942e52a655229e8b;p=catagits%2FCatalyst-Model-DBIC-Schema.git

diff --git a/lib/Catalyst/Model/DBIC/Schema/Types.pm b/lib/Catalyst/Model/DBIC/Schema/Types.pm
index 45a523e..0bf8c3b 100644
--- a/lib/Catalyst/Model/DBIC/Schema/Types.pm
+++ b/lib/Catalyst/Model/DBIC/Schema/Types.pm
@@ -1,39 +1,43 @@
-package Catalyst::Model::DBIC::Schema::Types;
+package  # hide from PAUSE
+    Catalyst::Model::DBIC::Schema::Types;
 
-use MooseX::Types
- -declare => [qw/ConnectInfo ConnectInfos Replicants SchemaClass CursorClass/];
+use MooseX::Types -declare => [qw/
+    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';
 
-subtype SchemaClass,
+subtype LoadedClass,
     as ClassName;
 
-coerce SchemaClass,
+coerce LoadedClass,
     from Str,
     via { Class::MOP::load_class($_); $_ };
 
-subtype CursorClass,
-    as ClassName;
+subtype SchemaClass,
+    as ClassName,
+    where { $_->isa('DBIx::Class::Schema') };
 
-coerce CursorClass,
-    from Str,
-    via { Class::MOP::load_class($_); $_ };
+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.
@@ -47,44 +51,67 @@ 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
+
+subtype CreateOption,
+    as Str,
+    where { /^(?:static|dynamic)\z/ },
+    message { "Invalid create option, must be one of 'static' or 'dynamic'" };
+
 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];
-        $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);
         }
+    };
+
+    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 @$_;
 
-        die "invalid connect_info" if @$_;
-    } elsif (@$_ == 1 && reftype $_->[0] eq 'HASH') {
+        $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;