File Coverage

blib/lib/Filter/SQL.pm

Criterion	Covered	Total	%
statement	68	101	67.3
branch	25	56	44.6
condition			n/a
subroutine	11	16	68.7
pod	2	9	22.2
total	106	182	58.2

package Filter::SQL;

use strict;
use warnings;
use Carp;
use DBI;
use List::MoreUtils qw(uniq);
use base qw(Exporter);

use Filter::Simple;

our %EXPORT_TAGS = (
    dbh   => [ qw/dbh/ ],
    mysql => [ qw/mysql_insert_id/ ],
);
$EXPORT_TAGS{all} = [ uniq map { @$_ } values %EXPORT_TAGS ];
our @EXPORT_OK = @{$EXPORT_TAGS{all}};
our $VERSION = '0.10';

FILTER_ONLY
    code => sub {
        s{(EXEC\s+(?:\S+)|SELECT(?:\s+ROW|)(?:\s+AS\s+HASH|)|INSERT|UPDATE|DELETE|REPLACE)\s+([^;]*);}{'Filter::SQL->' . Filter::SQL::to_func($1) . quote_vars($2) . ")"}egm;
#        print STDERR $_; $_;
    };

sub to_func {
    my $op = shift;
    $op = uc $op;
    if ($op =~ /^EXEC\s+/) {
        return "sql_prepare_exec('$' ";
    } elsif ($op =~ /^SELECT(\s+ROW|)(\s+AS\s+HASH|)/) {
        my $as_hash = $2 ? '1' : 'undef';
        if ($1) {
            return "sql_selectrow($as_hash, 'SELECT ";
        } else {
            return "sql_selectall($as_hash, 'SELECT ";
        }
    } else {
        return "sql_prepare_exec('$op ";
    }
}

sub quote_vars {
    my $src = shift;
    my $ph = $Filter::Simple::placeholder;
    $src =~ s/$ph/recover_quotelike($&, $1)/egm;
    my $out;
    my @params;
    while ($src =~ /($ph)|(\$|\{)/) {
        $out .= $`;
        $src = $';
        if ($1) {
            $out .= '?';
            push @params, $1;
        } else {
            my ($var, $depth) = ($&, $& eq '$' ? 0 : 1);
            while ($src ne '') {
                if ($depth == 0) {
                    last
                        unless $src =~ /^(?:([A-Za-z0-9_]+(?:->|))|([\[\{\(]))/;
                    $src = $';
                    if ($1) {
                        $var .= $1;
                    } else {
                        $var .= $2;
                        $depth++;
                    }
                } else {
                    last unless $src =~ /([\]\}\)](?:->|))/;
                    $src = $';
                    $var .= "$`$1";
                    $depth--;
                }
            }
            $var =~ s/^{(.*)}$/$1/m;
            $out .= '?';
            push @params, $var;
        }
    }
    $out .= $src;
    join ',', "$out'", @params;
}

sub recover_quotelike {
    my ($ph, $n) = ($_[0], unpack('N', $_[1]));
    my $s = ${$Filter::Simple::components[$n]};
    $s =~ /^[\'\"]/ ? $ph : $s;
}

my $dbh;

if (defined $ENV{FILTER_SQL_DBI}) {
    $dbh = sub {
        # self rewrite and return
        $dbh = DBI->connect(
            $ENV{FILTER_SQL_DBI},
            $ENV{FILTER_SQL_DBI_USERNAME} || undef,
            $ENV{FILTER_SQL_DBI_PASSWORD} || undef,
        ) or carp DBI->errstr;
    };
}

sub dbh {
    my $klass = shift;
    if (@_) {
        $dbh = shift;
        return; # returns undef
    }
    ref $dbh eq 'CODE' ? $dbh->() : $dbh;
}

sub sql_prepare_exec {
    my ($klass, $sql, @params) = @_;
    my $pe = Filter::SQL->dbh->{PrintError};
    local Filter::SQL->dbh->{PrintError} = undef;
    my $sth = Filter::SQL->dbh->prepare($sql);
    unless ($sth) {
        carp Filter::SQL->dbh->errstr if $pe;
        return;
    }
    unless ($sth->execute(@params)) {
        carp Filter::SQL->dbh->errstr if $pe;
        return;
    }
    $sth;
}

sub sql_selectall {
    my ($klass, $as_hash, $sql, @params) = @_;
    my $pe = Filter::SQL->dbh->{PrintError};
    local Filter::SQL->dbh->{PrintError} = undef;
    my $rows = Filter::SQL->dbh->selectall_arrayref(
        $sql,
        $as_hash ? { Slice => {} } : {},
        @params,
    );
    unless ($rows) {
        carp Filter::SQL->dbh->errstr if $pe;
        return;
    }
    wantarray ? @$rows : $rows->[0];
}

sub sql_selectrow {
    my ($klass, $as_hash, $sql, @params) = @_;
    my $pe = Filter::SQL->dbh->{PrintError};
    local Filter::SQL->dbh->{PrintError} = undef;
    my $rows = Filter::SQL->dbh->selectall_arrayref(
        $sql,
        $as_hash ? { Slice => {} } : {},
        @params,
    );
    unless ($rows) {
        carp Filter::SQL->dbh->errstr if $pe;
        return;
    }
    return @$rows ? %{$rows->[0]} : ()
        if $as_hash;
    @$rows ? wantarray ? @{$rows->[0]} : $rows->[0][0] : ();
}

sub quote {
    my ($klass, $v) = @_;
    Filter::SQL->dbh->quote($v);
}

sub mysql_insert_id {
    Filter::SQL->dbh->{mysql_insertid};
};

1;

__END__