use strict;
use warnings;

use DBI;

my $dbh = DBI->connect( 'DBI:mysql:database=xxx', 'xxx', 'xxx',
                        { RaiseError => 1 } );

my $callback = sub {
    return if $_[1] =~ m{ \n-- \s* \S+ .* \n \z }xms;

    my $drh         = shift @_;
    my $new_req     = shift @_;
    my $method_name = $_;

    $new_req =~ s{ ([^\n]) \z }{$1\n}xms;

    my $frame_num = 1;
    while ( my @frame_info = caller( $frame_num++ ) ) {
        $new_req .= "-- $frame_info[3] ($frame_info[1], line $frame_in
+fo[2])\n";
    }

    undef $_;
    return $drh->can( $method_name )->( $drh, $new_req, @_ );
};

my @methods = qw(
    do
    prepare
    prepare_cached
    selectrow_array
    selectrow_arrayref
    selectrow_hashref
    selectall_arrayref
    selectall_hashref
    selectcol_arrayref
);

foreach my $method ( @methods ) {
    $dbh->{Callbacks}{$method} = $callback;
}

junker();

sub junker {
    for ( 1 .. 1_000_000 ) {
        my @junk = $dbh->selectrow_array( 'SELECT 1' );
    }
}
__END__
mysql> show processlist;
+----+------+-----------+-------+---------+------+-----------+--------
+------------------------------------------------+
| Id | User | Host      | db    | Command | Time | State     | Info   
+                                                |
+----+------+-----------+-------+---------+------+-----------+--------
+------------------------------------------------+
| 36 | root | localhost | xxxxx | Query   |    0 | NULL      | show pr
+ocesslist                                       |
| 51 | root | localhost | xxxxx | Query   |    0 | executing | SELECT 
+1
-- main::junker (/home/kyle/junk.pl, line 45) |
+----+------+-----------+-------+---------+------+-----------+--------
+------------------------------------------------+
2 rows in set (0.00 sec)
[download]