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__ |