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

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