Commit | Line | Data |
113354d6 |
1 | package # hide from PAUSE |
2 | Catalyst::Model::DBIC::Schema::Types; |
0fbbc8d5 |
3 | |
4cbe63e7 |
4 | use MooseX::Types -declare => [qw/ |
7314403a |
5 | ConnectInfo ConnectInfos Replicants LoadedClass CreateOption |
4cbe63e7 |
6 | /]; |
0fbbc8d5 |
7 | |
bd309c0c |
8 | use Carp::Clan '^Catalyst::Model::DBIC::Schema'; |
0fbbc8d5 |
9 | use MooseX::Types::Moose qw/ArrayRef HashRef Str ClassName/; |
10 | use Scalar::Util 'reftype'; |
c4fee9b8 |
11 | use List::MoreUtils 'all'; |
0fbbc8d5 |
12 | |
13 | use namespace::clean -except => 'meta'; |
14 | |
fb691af9 |
15 | class_type 'DBIx::Class::Schema'; |
16 | |
7314403a |
17 | subtype LoadedClass, |
0fbbc8d5 |
18 | as ClassName; |
19 | |
7314403a |
20 | coerce LoadedClass, |
3f139b02 |
21 | from Str, |
22 | via { Class::MOP::load_class($_); $_ }; |
23 | |
0fbbc8d5 |
24 | subtype ConnectInfo, |
25 | as HashRef, |
26 | where { exists $_->{dsn} }, |
27 | message { 'Does not look like a valid connect_info' }; |
28 | |
29 | coerce ConnectInfo, |
30 | from Str, |
7b1fe8c2 |
31 | via(\&_coerce_connect_info_from_str), |
0fbbc8d5 |
32 | from ArrayRef, |
7b1fe8c2 |
33 | via(\&_coerce_connect_info_from_arrayref); |
0fbbc8d5 |
34 | |
35 | # { connect_info => [ ... ] } coercion would be nice, but no chained coercions |
c4fee9b8 |
36 | # yet. |
37 | # Also no coercion from base type (yet,) but in Moose git already. |
0fbbc8d5 |
38 | # from HashRef, |
39 | # via { $_->{connect_info} }, |
40 | |
c4fee9b8 |
41 | subtype ConnectInfos, |
42 | as ArrayRef[ConnectInfo], |
43 | message { "Not a valid array of connect_info's" }; |
44 | |
45 | coerce ConnectInfos, |
46 | from Str, |
7b1fe8c2 |
47 | via { [ _coerce_connect_info_from_str() ] }, |
48 | from ArrayRef, |
49 | via { [ map { |
50 | !ref $_ ? _coerce_connect_info_from_str() |
51 | : reftype $_ eq 'HASH' ? $_ |
52 | : reftype $_ eq 'ARRAY' ? _coerce_connect_info_from_arrayref() |
53 | : die 'invalid connect_info' |
54 | } @$_ ] }; |
c4fee9b8 |
55 | |
4cbe63e7 |
56 | # Helper stuff |
57 | |
58 | subtype CreateOption, |
59 | as Str, |
60 | where { /^(?:static|dynamic)\z/ }, |
61 | message { "Invalid create option, must be one of 'static' or 'dynamic'" }; |
62 | |
c4fee9b8 |
63 | sub _coerce_connect_info_from_arrayref { |
64 | my %connect_info; |
65 | |
7b1fe8c2 |
66 | # make a copy |
67 | $_ = [ @$_ ]; |
68 | |
c4fee9b8 |
69 | if (!ref $_->[0]) { # array style |
70 | $connect_info{dsn} = shift @$_; |
71 | $connect_info{user} = shift @$_ if !ref $_->[0]; |
72 | $connect_info{password} = shift @$_ if !ref $_->[0]; |
73 | |
74 | for my $i (0..1) { |
75 | my $extra = shift @$_; |
76 | last unless $extra; |
39f5f008 |
77 | die "invalid connect_info" unless reftype $extra eq 'HASH'; |
c4fee9b8 |
78 | |
79 | %connect_info = (%connect_info, %$extra); |
80 | } |
81 | |
39f5f008 |
82 | die "invalid connect_info" if @$_; |
c4fee9b8 |
83 | } elsif (@$_ == 1 && reftype $_->[0] eq 'HASH') { |
84 | return $_->[0]; |
85 | } else { |
39f5f008 |
86 | die "invalid connect_info"; |
c4fee9b8 |
87 | } |
88 | |
7b1fe8c2 |
89 | for my $key (qw/user password/) { |
90 | $connect_info{$key} = '' |
91 | if not defined $connect_info{$key}; |
92 | } |
93 | |
c4fee9b8 |
94 | \%connect_info; |
95 | } |
96 | |
7b1fe8c2 |
97 | sub _coerce_connect_info_from_str { |
98 | +{ dsn => $_, user => '', password => '' } |
99 | } |
100 | |
0fbbc8d5 |
101 | 1; |