File Coverage

blib/lib/DBIx/NamedBinding.pm

Criterion	Covered	Total	%
statement	27	33	81.8
branch	2	10	20.0
condition	1	3	33.3
subroutine	9	9	100.0
pod			n/a
total	39	55	70.9

package DBIx::NamedBinding;

use 5.006;
use warnings;
use strict;

use DBI;
our $VERSION = '0.02';
our @ISA     = 'DBI';

package DBIx::NamedBinding::db;
BEGIN { our @ISA = ('DBI::db') }

sub prepare {
    my ($dbh, $statement, @args) = @_;
    my @parameters = $statement =~ m/ : (\w+) \b /gx;   # get param names
    my $position = 1;
    my $param_pos = { map { $_ => $position++ } @parameters };
    $statement =~ s/ : \w+ \b /?/gx;                    # replace names w/ ?'s
    my $sth = $dbh->SUPER::prepare($statement, @args)
        or return;
    $sth->{private_namedbinding_pos} = $param_pos;
    return $sth;
}

package DBIx::NamedBinding::st;
BEGIN { our @ISA = ('DBI::st') }

sub bind_param {
    my ($sth, $param, $value, $attr) = @_;
    return $sth->set_err($DBI::stderr, "Missing named binding parameter", undef, "bind_param")
        if !defined $param || !$param;
    return $sth->set_err($DBI::stderr, "Invalid named binding parameter", undef, "bind_param")
        if $param =~ /\W/;
    my $param_pos = $sth->{private_namedbinding_pos};
    if ($param !~ /^\d+\Z/) {
        return $sth->set_err($DBI::stderr, "Named binding identifier '$param' was not used in preparing this statement handle",
            undef, "bind_param")
            if ! exists $param_pos->{$param};
        $param = $param_pos->{$param};
    }
    $sth->SUPER::bind_param($param, $value, $attr);
}

sub execute {
    my ($sth, @params) = @_;
    # I want to optionally handle named parameters via the execute method too
    $sth->SUPER::execute(@params);
}

1;

__END__