use strict; use warnings; use B::Deparse; use PadWalker qw/closed_over peek_sub set_closed_over/; use Data::Dump qw/pp/; # ========= Tests use Test::More; # lexicals for placeholders my $a = 'A'; my @list = qw/L I S T/; my $x = 'X'; # no placeholders for underscore vars my @_table = "any_table"; my $sql = sub { "SELECT * FROM @_table WHERE a = $a AND b IN (@list) AND c = $x" }; my @stm = holderplace($sql); is_deeply( \@stm, [ "SELECT * FROM any_table WHERE a = ? AND b IN (?, ?, ?, ?) AND c = ?", [\"A", ["L", "I", "S", "T"], \"X"] ], "statement with placeholders plus bind variables" ); # change bind variables $a = 'AA'; @list = qw/LL II SS TT/; $x = 'XX'; is_deeply( \@stm, [ "SELECT * FROM any_table WHERE a = ? AND b IN (?, ?, ?, ?) AND c = ?", [\"AA", ["LL", "II", "SS", "TT"], \"XX"] ], "statement with placeholders plus changed variables" ); done_testing(); # ========== Code sub holderplace { my ($lambda)=@_; my $h_vars = closed_over($lambda); my %new_vars; my @value_refs; for my $key ( keys %$h_vars) { my $sigil = substr $key,0,1; # exclude variables starting with _ next if $key =~ m/^\Q${sigil}\E_/; if ( '$' eq $sigil ) { $new_vars{$key} = \'?'; } elsif ( '@' eq $sigil ) { $new_vars{$key} = [ join ", ", ("?") x @{$h_vars->{$key} } ]; } else { next; # Error? } } # Create Statement with placeholders set_closed_over( $lambda, \%new_vars ); my $newstr = $lambda->(); # Variable refs in order of placeholders my @var_refs = map { $h_vars->{$_} } grep { $new_vars{$_} } @{ get_vars($lambda) }; return ("$newstr", \@var_refs ); } sub get_vars { # scans output of B::Deparse to get interpolated vars in order my ($lambda)=@_; # deparse sub body my $source = B::Deparse->new('-q')->coderef2text($lambda); # returns something like: # { # use warnings; # use strict; # 'SELECT * FROM ' . join($", @_table) . ' WHERE x = ' . $a . ' AND b IN (' . join($", @list) . ') ' . $x; # } # truncate {block} and use statements $source =~ s/^{\s*(use.*?;\s*)*//s; $source =~ s/;\s*}$//s; #warn $source; my %quotes = qw"[ ] ( ) < > { } / /"; $quotes{'#'}='#'; # single quotes like q(...) my $re_q = join "|", map { "q\\$_.*?\\$quotes{$_}" } keys %quotes; #warn pp my @parts = split /\s* (?: '(?:\\'|[^'])*?' | $re_q )\s*/msx, $source; for my $part (@parts) { next unless $part =~ /^\..*\.?$/; if ( $part =~ /^\. join\(.*? (\@\w+)\)( \.)?$/) { $part = $1; # array } elsif ( $part =~ /^\. (\$\w+)( \.)?$/) { $part = $1; # scalar } } return \@parts; }