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

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