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