lib/Catalyst/Model/DBIC/Schema/Types.pm

   1 package Catalyst::Model::DBIC::Schema::Types;
   2
   3 use MooseX::Types
   4  -declare => [qw/ConnectInfo ConnectInfos Replicants SchemaClass CursorClass/];
   5
   6 use Carp::Clan '^Catalyst::Model::DBIC::Schema';
   7 use MooseX::Types::Moose qw/ArrayRef HashRef Str ClassName/;
   8 use Scalar::Util 'reftype';
   9 use List::MoreUtils 'all';
  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
  20 subtype CursorClass,
  21     as ClassName;
  22
  23 coerce CursorClass,
  24     from Str,
  25     via { Class::MOP::load_class($_); $_ };
  26
  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(\&_coerce_connect_info_from_str),
  35     from ArrayRef,
  36     via(\&_coerce_connect_info_from_arrayref);
  37
  38 # { connect_info => [ ... ] } coercion would be nice, but no chained coercions
  39 # yet.
  40 # Also no coercion from base type (yet,) but in Moose git already.
  41 #    from HashRef,
  42 #    via { $_->{connect_info} },
  43
  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  { [ _coerce_connect_info_from_str() ] },
  51     from ArrayRef,
  52     via { [ map {
  53         !ref $_ ? _coerce_connect_info_from_str()
  54             : reftype $_ eq 'HASH' ? $_
  55             : reftype $_ eq 'ARRAY' ? _coerce_connect_info_from_arrayref()
  56             : die 'invalid connect_info'
  57     } @$_ ] };
  58
  59 sub _coerce_connect_info_from_arrayref {
  60     my %connect_info;
  61
  62     # make a copy
  63     $_ = [ @$_ ];
  64
  65     if (!ref $_->[0]) { # array style
  66         $connect_info{dsn}      = shift @$_;
  67         $connect_info{user}     = shift @$_ if !ref $_->[0];
  68         $connect_info{password} = shift @$_ if !ref $_->[0];
  69
  70         for my $i (0..1) {
  71             my $extra = shift @$_;
  72             last unless $extra;
  73             die "invalid connect_info" unless reftype $extra eq 'HASH';
  74
  75             %connect_info = (%connect_info, %$extra);
  76         }
  77
  78         die "invalid connect_info" if @$_;
  79     } elsif (@$_ == 1 && reftype $_->[0] eq 'HASH') {
  80         return $_->[0];
  81     } else {
  82         die "invalid connect_info";
  83     }
  84
  85     for my $key (qw/user password/) {
  86         $connect_info{$key} = ''
  87             if not defined $connect_info{$key};
  88     }
  89
  90     \%connect_info;
  91 }
  92
  93 sub _coerce_connect_info_from_str {
  94     +{ dsn => $_, user => '', password => '' }
  95 }
  96
  97 1;