File Coverage

blib/lib/Types/DBI.pm

Criterion	Covered	Total	%
statement	18	18	100.0
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	24	24	100.0

use 5.008001;
use strict;
use warnings;

package Types::DBI;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.001';

use DBI ();
use Type::Library -base;
use Types::Standard qw( InstanceOf ArrayRef Str );

our @EXPORT = 'Dbh';

my $meta = __PACKAGE__->meta;

my $dbh = $meta->add_type(
	name                 => 'Dbh',
	parent               => InstanceOf['DBI::db'],
	constraint_generator => sub {
		my @allowed = @_;
		return sub {
			my $type = $_->get_info(17);
			!!grep($_ eq $type, @allowed);
		};
	},
	coercion_generator   => sub {
		my $parent  = shift;
		my $child   = shift;
		my @allowed = @_;
		'Type::Coercion'->new(
			type_constraint   => $child,
			type_coercion_map => [@{ $parent->coercion->type_coercion_map }],
		)->freeze;
	},
	inline_generator     => sub {
		my @allowed = @_;
		return sub {
			return (
				undef,
				sprintf(
					'%s->get_info(17) eq %s',
					$_[1],
					B::perlstring($allowed[0]),
				),
			);
		} if @allowed == 1;
		return sub {
			return (
				undef,
				sprintf(
					'do { my $t = %s->get_info(17); %s }',
					$_[1],
					join(' or ', map { my $x = B::perlstring($_); "\$t eq $x" } @allowed),
				),
			);
		};
	},
);

my $sth = $meta->add_type(
	name   => 'Sth',
	parent => InstanceOf['DBI::st'],
);

$dbh->coercion->add_type_coercions(
	Str       ,=> q{ 'DBI'->connect($_, '', '', { RaiseError => 1 }) },
	ArrayRef  ,=> q{ 'DBI'->connect(@$_) },
);

$_->coercion->freeze for $dbh, $sth;

1;

__END__