File Coverage

blib/lib/SQL/NamedPlaceholder.pm

Criterion	Covered	Total	%
statement	34	36	94.4
branch	11	12	91.6
condition	2	2	100.0
subroutine	6	6	100.0
pod	1	1	100.0
total	54	57	94.7

package SQL::NamedPlaceholder;

use strict;
use warnings;
use Exporter::Lite;
use Scalar::Util qw(reftype);

use Carp;

our $VERSION = '0.04';
our @EXPORT_OK = qw(bind_named);

sub bind_named {
	my ($sql, $hash) = @_;
	$sql or croak 'my ($sql, $bind) = bind_named($sql, $hash) requires $sql';
	(reftype($hash) || '') eq 'HASH' or croak 'must specify HASH as bind values';

	# replace question marks as placeholder. e.g. [`hoge` = ?] to [`hoge` = :hoge]
	$sql =~ s{(([`"]?)(\S+?)\2\s*(=|<=?|>=?|<>|!=|<=>)\s*)\?}{$1:$3}g;

	my $bind = [];

	$sql =~ s{:(\w+)}{
		croak("'$1' does not exist in bind hash") if !exists $hash->{$1};
		my $type = ref($hash->{$1});
		if ($type eq 'ARRAY') {
			if (@{ $hash->{$1} }) {
				push @$bind, @{ $hash->{$1} };
				join ', ', map { '?' } @{ $hash->{$1} };
			} else {
				push @$bind, undef;
				'?';
			}
		} else {
			push @$bind, $hash->{$1};
			'?';
		}
	}eg;

	wantarray ? ($sql, $bind) : [$sql, $bind];
}

1;
__END__