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