use strict;
use warnings;
use DBI;
use Carp::Clan;
package DBIx::Printf;
our $VERSION = '0.08';
sub _printf {
my ($dbh, $fmt, $params, $in_like, $like_escape) = @_;
$fmt =~ s/\%(?:([dfst\%])|like\((.*?)\)((?i)\s+ESCAPE\s+(['"])(.*?)\4(?:\s+|$))?)/
_printf_quote({
dbh => $dbh,
params => $params,
type => $1 || 'like',
like_fmt => $2,
like_escape => $3,
like_escape_char => defined $like_escape ? $like_escape : $5,
in_like => $in_like,
})
/eg;
$fmt;
}
sub _printf_quote {
my $in = shift;
my $out;
if ($in->{type} eq '%') {
return '%';
} elsif ($in->{type} eq 'like') {
return "'"
. _printf(
$in->{dbh},
$in->{like_fmt},
$in->{params},
1,
$in->{like_escape_char},
) . "'" . ($in->{like_escape} || '');
}
return _printf_quote_simple(
$in->{dbh},
$in->{type},
$in->{params},
$in->{in_like},
$in->{like_escape_char}
);
}
sub _printf_quote_simple {
no warnings;
my ($dbh, $type, $params, $in_like, $like_escape_char) = @_;
Carp::Clan::croak "too few parameters\n" unless @$params;
my $param = shift @$params;
if ($type eq 'd') {
$param = int($param);
} elsif ($type eq 'f') {
$param = $param + 0;
} elsif ($type eq 'l') {
$param = s/[\%_]/\\$1/g;
$param = $dbh->quote($param); # be paranoiac, use DBI::db::quote
$param =~ s/^'(.*)'$/$1/s
or Carp::Clan::croak "unexpected quote char used: $param\n";
} elsif ($type eq 's') {
if ($in_like) {
my $escape_char = defined $like_escape_char ? $like_escape_char : '\\';
$param =~ s/[${escape_char}%_]/$escape_char$&/g;
}
$param = $dbh->quote($param);
if ($in_like) {
$param =~ s/^'(.*)'$/$1/s
or Carp::Clan::croak "unexpected quote char: $param\n";
}
} elsif ($type eq 't') {
# pass thru
} else {
Carp::Clan::croak "unexpected type: $type\n";
}
$param;
}
package main;
sub DBI::db::printf {
my ($dbh, $fmt, @params) = @_;
my $sql = DBIx::Printf::_printf($dbh, $fmt, \@params);
Carp::Clan::croak "too many parameters\n" if @params;
$sql;
}
1;
__END__
=head1 NAME
DBIx::Printf - A printf-style prepared statement
=head1 SYNOPSIS
use DBIx::Printf;
my $sql = $dbh->printf(
'select * from t where str=%s or int=%d or float=%f',
'string',
1,
1.1e1);
=head1 DESCRIPTION
C<DBIx::Printf> is a printf-style prepared statement. It adds a C<printf> method to DBI::db package.
=head1 METHODS
=head2 printf(stmt, [values])
Builds a SQL statement from given statement with placeholders and values. Following placeholders are supported.
%d - integer
%f - floating point
%s - string
%t - do not quote, pass thru
%like(fmt) - formats and quotes a string for like expression
=head3 %like example
Below is an example of using the %%like placeholder. Since metacharacters of supplied parameters are escaped, the example would always by a prefix search.
$dbh->printf('select * from t where name like %like(%s%%)', $name);
=head1 AUTHOR
Copyright (c) 2007 Kazuho Oku All rights reserved.
=head1 LICENSE
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
See http://www.perl.com/perl/misc/Artistic.html
=cut