File Coverage

blib/lib/DBIx/RewriteDSN.pm

Criterion	Covered	Total	%
statement	27	52	51.9
branch	5	18	27.7
condition	3	12	25.0
subroutine	8	12	66.6
pod	3	4	75.0
total	46	98	46.9

package DBIx::RewriteDSN;

use strict;
use warnings;
our $VERSION = '0.05';

use DBI;
use File::Slurp;

my $orig_connect = \&DBI::connect;
my $filename;
my $RULES = "";

sub import {
	my ($class, %opts) = @_;
	if ($opts{-file}) {
		$filename = $opts{-file};
		$RULES .= File::Slurp::slurp($filename) . "\n";
	}
	if ($opts{-rules}) {
		$RULES .= $opts{-rules} . "\n";
	}

	if ($RULES && $ENV{DBI_REWRITE_DSN}) {
		$class->enable;
	}
}

sub enable {
	my ($class) = @_;
	no warnings 'redefine';
	*DBI::connect = \&_connect;
}

sub disable {
	my ($class) = @_;
	no warnings 'redefine';
	*DBI::connect = $orig_connect;
}

sub prepend_rules {
	my ($class, $rules) = @_;
	$RULES = $rules . "\n" . $RULES;
}


sub rewrite {
	my ($dsn) = @_;

	my $new_dsn;
	for (split /\n/, $RULES) {
		chomp;
		$_ =~ s/^\s+|\s+$//g;
		$_ or next;
		$_ =~ /^#/ and next;

		my ($match, $rewrite) = split(/\s+/, $_);
		if ($dsn =~ $match) {
			$rewrite =~ s{\\}{\\\\}g;
			$new_dsn = eval(sprintf('qq{%s}', $rewrite || "")); ## no critic
			last;
		}
	}

	if ($new_dsn && $new_dsn ne $dsn) {
		print STDERR sprintf("Rewrote '%s' to '%s'\n", $dsn, $new_dsn) if ($ENV{DBI_REWRITE_DSN} || "") eq 'verbose';
		$dsn = $new_dsn;
	} else {
		print STDERR sprintf("Didn't rewrite %s\n", $dsn) if ($ENV{DBI_REWRITE_DSN} || "") eq 'verbose';
	}

	$dsn;
}

sub _connect {
	my ($class, $dsn, @rest) = @_;
	$dsn = DBIx::RewriteDSN::rewrite($dsn);
	$orig_connect->($class, $dsn, @rest);
}


1;
__END__