lib/Catalyst/Model/DBIC/Schema/Types.pm

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