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

   1 package Catalyst::Model::DBIC::Schema::Types;
   2
   3 use MooseX::Types
   4     -declare => [qw/ConnectInfo ConnectInfos Replicants SchemaClass/];
   5
   6 use Carp::Clan '^Catalyst::Model::DBIC::Schema::';
   7 use MooseX::Types::Moose qw/ArrayRef HashRef Str ClassName/;
   8 use Scalar::Util 'reftype';
   9 use List::MoreUtils 'all';
  10
  11 use namespace::clean -except => 'meta';
  12
  13 subtype SchemaClass,
  14     as ClassName;
  15
  16 coerce SchemaClass,
  17     from Str,
  18     via { Class::MOP::load_class($_); $_ };
  19
  20 subtype ConnectInfo,
  21     as HashRef,
  22     where { exists $_->{dsn} },
  23     message { 'Does not look like a valid connect_info' };
  24
  25 coerce ConnectInfo,
  26     from Str,
  27     via { +{ dsn => $_ } },
  28     from ArrayRef,
  29     via \&_coerce_connect_info_from_arrayref;
  30
  31 # { connect_info => [ ... ] } coercion would be nice, but no chained coercions
  32 # yet.
  33 # Also no coercion from base type (yet,) but in Moose git already.
  34 #    from HashRef,
  35 #    via { $_->{connect_info} },
  36
  37 subtype ConnectInfos,
  38     as ArrayRef[ConnectInfo],
  39     message { "Not a valid array of connect_info's" };
  40
  41 coerce ConnectInfos,
  42     from Str,
  43     via  { [ { dsn => $_ } ] },
  44     from ArrayRef[Str],
  45     via { [ map +{ dsn => $_ }, @$_ ] },
  46     from ArrayRef[ArrayRef],
  47     via { [ map \&_coerce_connect_info_from_arrayref, @$_ ] };
  48
  49 sub _coerce_connect_info_from_arrayref {
  50     my %connect_info;
  51
  52     if (!ref $_->[0]) { # array style
  53         $connect_info{dsn}      = shift @$_;
  54         $connect_info{user}     = shift @$_ if !ref $_->[0];
  55         $connect_info{password} = shift @$_ if !ref $_->[0];
  56
  57         for my $i (0..1) {
  58             my $extra = shift @$_;
  59             last unless $extra;
  60             die "invalid connect_info" unless reftype $extra eq 'HASH';
  61
  62             %connect_info = (%connect_info, %$extra);
  63         }
  64
  65         die "invalid connect_info" if @$_;
  66     } elsif (@$_ == 1 && reftype $_->[0] eq 'HASH') {
  67         return $_->[0];
  68     } else {
  69         die "invalid connect_info";
  70     }
  71
  72     \%connect_info;
  73 }
  74
  75 1;