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