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


line stmt bran cond sub pod time code
1             package DBIx::NamedBinding;
2              
3 2     2   42039 use 5.006;
  2         10  
  2         91  
4 2     2   13 use warnings;
  2         5  
  2         63  
5 2     2   11 use strict;
  2         10  
  2         92  
6              
7 2     2   7301 use DBI;
  2         40494  
  2         229  
8             our $VERSION = '0.02';
9             our @ISA = 'DBI';
10              
11             package DBIx::NamedBinding::db;
12 2     2   412 BEGIN { our @ISA = ('DBI::db') }
13              
14             sub prepare {
15 9     9   3175 my ($dbh, $statement, @args) = @_;
16 9         55 my @parameters = $statement =~ m/ : (\w+) \b /gx; # get param names
17 9         61 my $position = 1;
18 9         40 my $param_pos = { map { $_ => $position++ } @parameters };
  1         8  
19 9         34 $statement =~ s/ : \w+ \b /?/gx; # replace names w/ ?'s
20 9 50       93 my $sth = $dbh->SUPER::prepare($statement, @args)
21             or return;
22 9         11855 $sth->{private_namedbinding_pos} = $param_pos;
23 9         58 return $sth;
24             }
25              
26             package DBIx::NamedBinding::st;
27 2     2   581 BEGIN { our @ISA = ('DBI::st') }
28              
29             sub bind_param {
30 1     1   4 my ($sth, $param, $value, $attr) = @_;
31 1 50 33     665 return $sth->set_err($DBI::stderr, "Missing named binding parameter", undef, "bind_param")
32             if !defined $param || !$param;
33 0 0       0 return $sth->set_err($DBI::stderr, "Invalid named binding parameter", undef, "bind_param")
34             if $param =~ /\W/;
35 0         0 my $param_pos = $sth->{private_namedbinding_pos};
36 0 0       0 if ($param !~ /^\d+\Z/) {
37 0 0       0 return $sth->set_err($DBI::stderr, "Named binding identifier '$param' was not used in preparing this statement handle",
38             undef, "bind_param")
39             if ! exists $param_pos->{$param};
40 0         0 $param = $param_pos->{$param};
41             }
42 0         0 $sth->SUPER::bind_param($param, $value, $attr);
43             }
44              
45             sub execute {
46 8     8   160 my ($sth, @params) = @_;
47             # I want to optionally handle named parameters via the execute method too
48 8         230802 $sth->SUPER::execute(@params);
49             }
50              
51             1;
52              
53             __END__