DBIx::Printf - A printf-style prepared statement

DBIx-Printf documentation Contained in the DBIx-Printf distribution.

Index

Code Index:

NAME

Top

DBIx::Printf - A printf-style prepared statement

SYNOPSIS

Top

  use DBIx::Printf;

  my $sql = $dbh->printf(
      'select * from t where str=%s or int=%d or float=%f',
      'string',
      1,
      1.1e1);

DESCRIPTION

Top

DBIx::Printf is a printf-style prepared statement. It adds a printf method to DBI::db package.

METHODS

Top

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

%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);

AUTHOR

Top

Copyright (c) 2007 Kazuho Oku All rights reserved.

LICENSE

Top

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

DBIx-Printf documentation Contained in the DBIx-Printf distribution. 
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__