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