C::M::DBIC::Schema - warn on create=dynamic, other cleanups, ::Role::Replicated ...
[catagits/Catalyst-Model-DBIC-Schema.git] / lib / Catalyst / Model / DBIC / Schema / Types.pm
CommitLineData
0fbbc8d5 1package Catalyst::Model::DBIC::Schema::Types;
2
3use MooseX::Types
c4fee9b8 4 -declare => [qw/ConnectInfo ConnectInfos Replicants SchemaClass/];
0fbbc8d5 5
6use MooseX::Types::Moose qw/ArrayRef HashRef Str ClassName/;
7use Scalar::Util 'reftype';
c4fee9b8 8use List::MoreUtils 'all';
0fbbc8d5 9use Carp;
10
11use namespace::clean -except => 'meta';
12
13subtype SchemaClass,
14 as ClassName;
15
16coerce SchemaClass,
17 from Str,
18 via { Class::MOP::load_class($_); $_ };
19
20subtype ConnectInfo,
21 as HashRef,
22 where { exists $_->{dsn} },
23 message { 'Does not look like a valid connect_info' };
24
25coerce ConnectInfo,
26 from Str,
27 via { +{ dsn => $_ } },
28 from ArrayRef,
c4fee9b8 29 via \&_coerce_connect_info_from_arrayref;
0fbbc8d5 30
31# { connect_info => [ ... ] } coercion would be nice, but no chained coercions
c4fee9b8 32# yet.
33# Also no coercion from base type (yet,) but in Moose git already.
0fbbc8d5 34# from HashRef,
35# via { $_->{connect_info} },
36
c4fee9b8 37subtype ConnectInfos,
38 as ArrayRef[ConnectInfo],
39 message { "Not a valid array of connect_info's" };
40
41coerce ConnectInfos,
42 from Str,
43 via { [ { dsn => $_ } ] },
44 from ArrayRef[Str],
45 via { [ map +{ dsn => $_ }, @$_ ] },
46 from ArrayRef[ArrayRef],
47 via { [ map \&_coerce_connect_info_from_arrayref, @$_ ] };
48
49sub _coerce_connect_info_from_arrayref {
50 my %connect_info;
51
52 if (!ref $_->[0]) { # array style
53 $connect_info{dsn} = shift @$_;
54 $connect_info{user} = shift @$_ if !ref $_->[0];
55 $connect_info{password} = shift @$_ if !ref $_->[0];
56
57 for my $i (0..1) {
58 my $extra = shift @$_;
59 last unless $extra;
60 croak "invalid connect_info" unless reftype $extra eq 'HASH';
61
62 %connect_info = (%connect_info, %$extra);
63 }
64
65 croak "invalid connect_info" if @$_;
66 } elsif (@$_ == 1 && reftype $_->[0] eq 'HASH') {
67 return $_->[0];
68 } else {
69 croak "invalid connect_info";
70 }
71
72 \%connect_info;
73}
74
0fbbc8d5 751;