/usr/share/perl5/Catalyst/Model/DBIC/Schema/Types.pm is in libcatalyst-model-dbic-schema-perl 0.65-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | package # hide from PAUSE
Catalyst::Model::DBIC::Schema::Types;
use MooseX::Types -declare => [qw/
ConnectInfo ConnectInfos Replicants SchemaClass CreateOption
Schema LoadedClass
/];
use Carp::Clan '^Catalyst::Model::DBIC::Schema';
use MooseX::Types::Moose qw/ArrayRef HashRef CodeRef Str ClassName/;
use MooseX::Types::LoadableClass qw/LoadableClass/;
use Scalar::Util 'reftype';
use List::MoreUtils 'all';
use Module::Runtime;
use namespace::clean -except => 'meta';
# So I restored the custom Type LoadedClass because 'LoadableClass' doesn't really
# exactly do the same thing, which busted the Replication trait. Please don't
# "clean this up" -JNAP
subtype LoadedClass,
as ClassName;
coerce LoadedClass,
from Str, # N.B. deliberate paranoia against $_ clobbering below
via { my $classname = $_; Module::Runtime::use_module($classname); $classname };
subtype SchemaClass,
as LoadableClass,
where { $_->isa('DBIx::Class::Schema') };
class_type Schema, { class => 'DBIx::Class::Schema' };
subtype ConnectInfo,
as HashRef,
where { exists $_->{dsn} || exists $_->{dbh_maker} },
message { 'Does not look like a valid connect_info' };
coerce ConnectInfo,
from Str,
via(\&_coerce_connect_info_from_str),
from ArrayRef,
via(\&_coerce_connect_info_from_arrayref),
from CodeRef,
via { +{ dbh_maker => $_ } },
;
# { connect_info => [ ... ] } coercion would be nice, but no chained coercions
# yet.
# Also no coercion from base type (yet,) but in Moose git already.
# from HashRef,
# via { $_->{connect_info} },
subtype ConnectInfos,
as ArrayRef[ConnectInfo],
message { "Not a valid array of connect_info's" };
coerce ConnectInfos,
from Str,
via { [ _coerce_connect_info_from_str() ] },
from CodeRef,
via { [ +{ dbh_maker => $_ } ] },
from HashRef,
via { [ $_ ] },
from ArrayRef,
via { [ map {
!ref $_ ? _coerce_connect_info_from_str()
: reftype $_ eq 'HASH' ? $_
: reftype $_ eq 'CODE' ? +{ dbh_maker => $_ }
: reftype $_ eq 'ARRAY' ? _coerce_connect_info_from_arrayref()
: croak 'invalid connect_info'
} @$_ ] };
# Helper stuff
subtype CreateOption,
as Str,
where { /^(?:static|dynamic)\z/ },
message { "Invalid create option, must be one of 'static' or 'dynamic'" };
sub _coerce_connect_info_from_arrayref {
my %connect_info;
# make a copy
$_ = [ @$_ ];
my $slurp_hashes = sub {
for my $i (0..1) {
my $extra = shift @$_;
last unless $extra;
croak "invalid connect_info"
unless ref $extra && reftype $extra eq 'HASH';
%connect_info = (%connect_info, %$extra);
}
};
if (!ref $_->[0]) { # array style
$connect_info{dsn} = shift @$_;
$connect_info{user} = shift @$_ if !ref $_->[0];
$connect_info{password} = shift @$_ if !ref $_->[0];
$slurp_hashes->();
croak "invalid connect_info" if @$_;
} elsif (ref $_->[0] && reftype $_->[0] eq 'CODE') {
$connect_info{dbh_maker} = shift @$_;
$slurp_hashes->();
croak "invalid connect_info" if @$_;
} elsif (@$_ == 1 && ref $_->[0] && reftype $_->[0] eq 'HASH') {
return $_->[0];
} else {
croak "invalid connect_info";
}
unless ($connect_info{dbh_maker}) {
for my $key (qw/user password/) {
$connect_info{$key} = ''
if not defined $connect_info{$key};
}
}
\%connect_info;
}
sub _coerce_connect_info_from_str {
+{ dsn => $_, user => '', password => '' }
}
1;
|