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,
  21     via { Class::MOP::load_class($_); $_ };
  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 ArrayRef,
  61     via { [ map {
  62         !ref $_ ? _coerce_connect_info_from_str()
  63             : reftype $_ eq 'HASH' ? $_
  64             : reftype $_ eq 'CODE' ? +{ dbh_maker => $_ }
  65             : reftype $_ eq 'ARRAY' ? _coerce_connect_info_from_arrayref()
  66             : croak 'invalid connect_info'
  67     } @$_ ] };
  68
  69 # Helper stuff
  70
  71 subtype CreateOption,
  72     as Str,
  73     where { /^(?:static|dynamic)\z/ },
  74     message { "Invalid create option, must be one of 'static' or 'dynamic'" };
  75
  76 sub _coerce_connect_info_from_arrayref {
  77     my %connect_info;
  78
  79     # make a copy
  80     $_ = [ @$_ ];
  81
  82     my $slurp_hashes = sub {
  83         for my $i (0..1) {
  84             my $extra = shift @$_;
  85             last unless $extra;
  86             croak "invalid connect_info"
  87                 unless ref $extra && reftype $extra eq 'HASH';
  88
  89             %connect_info = (%connect_info, %$extra);
  90         }
  91     };
  92
  93     if (!ref $_->[0]) { # array style
  94         $connect_info{dsn}      = shift @$_;
  95         $connect_info{user}     = shift @$_ if !ref $_->[0];
  96         $connect_info{password} = shift @$_ if !ref $_->[0];
  97
  98         $slurp_hashes->();
  99
 100         croak "invalid connect_info" if @$_;
 101     } elsif (ref $_->[0] && reftype $_->[0] eq 'CODE') {
 102         $connect_info{dbh_maker} = shift @$_;
 103
 104         $slurp_hashes->();
 105
 106         croak "invalid connect_info" if @$_;
 107     } elsif (@$_ == 1 && ref $_->[0] && reftype $_->[0] eq 'HASH') {
 108         return $_->[0];
 109     } else {
 110         croak "invalid connect_info";
 111     }
 112
 113     unless ($connect_info{dbh_maker}) {
 114         for my $key (qw/user password/) {
 115             $connect_info{$key} = ''
 116                 if not defined $connect_info{$key};
 117         }
 118     }
 119
 120     \%connect_info;
 121 }
 122
 123 sub _coerce_connect_info_from_str {
 124     +{ dsn => $_, user => '', password => '' }
 125 }
 126
 127 1;