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