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 LoadedClass CreateOption
   6 /];
   7
   8 use Carp::Clan '^Catalyst::Model::DBIC::Schema';
   9 use MooseX::Types::Moose qw/ArrayRef HashRef Str ClassName/;
  10 use Scalar::Util 'reftype';
  11 use List::MoreUtils 'all';
  12
  13 use namespace::clean -except => 'meta';
  14
  15 class_type 'DBIx::Class::Schema';
  16
  17 subtype LoadedClass,
  18     as ClassName;
  19
  20 coerce LoadedClass,
  21     from Str,
  22     via { Class::MOP::load_class($_); $_ };
  23
  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,
  31     via(\&_coerce_connect_info_from_str),
  32     from ArrayRef,
  33     via(\&_coerce_connect_info_from_arrayref);
  34
  35 # { connect_info => [ ... ] } coercion would be nice, but no chained coercions
  36 # yet.
  37 # Also no coercion from base type (yet,) but in Moose git already.
  38 #    from HashRef,
  39 #    via { $_->{connect_info} },
  40
  41 subtype ConnectInfos,
  42     as ArrayRef[ConnectInfo],
  43     message { "Not a valid array of connect_info's" };
  44
  45 coerce ConnectInfos,
  46     from Str,
  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     } @$_ ] };
  55
  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
  63 sub _coerce_connect_info_from_arrayref {
  64     my %connect_info;
  65
  66     # make a copy
  67     $_ = [ @$_ ];
  68
  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;
  77             die "invalid connect_info" unless reftype $extra eq 'HASH';
  78
  79             %connect_info = (%connect_info, %$extra);
  80         }
  81
  82         die "invalid connect_info" if @$_;
  83     } elsif (@$_ == 1 && reftype $_->[0] eq 'HASH') {
  84         return $_->[0];
  85     } else {
  86         die "invalid connect_info";
  87     }
  88
  89     for my $key (qw/user password/) {
  90         $connect_info{$key} = ''
  91             if not defined $connect_info{$key};
  92     }
  93
  94     \%connect_info;
  95 }
  96
  97 sub _coerce_connect_info_from_str {
  98     +{ dsn => $_, user => '', password => '' }
  99 }
 100
 101 1;