From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

SATOH / SQL-NamedPlaceholder-0.10 / lib / SQL / NamedPlaceholder.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
—
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109

              
package SQL::NamedPlaceholder;
use strict;
use warnings;
use Exporter::Lite;
use Scalar::Util qw(reftype);
use Carp;
our $VERSION = '0.10';
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{:([A-Za-z_][A-Za-z0-9_]*)}{
                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__
=encoding utf8
=head1 NAME
SQL::NamedPlaceholder - extension of placeholder
=head1 SYNOPSIS
  use SQL::NamedPlaceholder qw(bind_named);
  my ($sql, $bind) = bind_named(q[
      SELECT *
      FROM entry
      WHERE
          user_id = :user_id
  ], {
      user_id => $user_id
  });
  $dbh->prepare_cached($sql)->execute(@$bind);
=head1 DESCRIPTION
SQL::NamedPlaceholder is extension of placeholder. This enable more readable and robust code.
=head1 FUNCTION
=over 4
=item ($sql, $bind) = bind_named($sql, $hash);
The $sql parameter is SQL string which contains named placeholders. The $hash parameter is map of bind parameters.
The returned $sql is new SQL string which contains normal placeholders ('?'), and $bind is array reference of bind parameters.
=back
=head1 SYNTAX
=over 4
=item :foobar
Replace as placeholder which uses value from $hash->{foobar}.
=item foobar = ?, foobar > ?, foobar < ?, foobar <> ?, etc.
This is same as 'foobar = :foobar'.
=back
=head1 AUTHOR
cho45 E<lt>cho45@lowreal.netE<gt>
=head1 SEE ALSO
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut