comment on

Here's a solution that doesn't use the callback mechanism, so it works with older versions of DBI. To use it, give it as the RootClass to DBI->connect. Since we were already using DBIx::ContextualFetch there, the code below uses that as its base, but it's not otherwise required.

package My::DatabaseRoot;

use strict;
use warnings;

use base 'DBIx::ContextualFetch';

package My::DatabaseRoot::db;
use base 'DBIx::ContextualFetch::db';

sub _rewrite {
    return $_[0] if ! defined $_[0];
    return $_[0] if $_[0] =~ m{ COMPANY \s DEBUGGING \s INFO }xms;

    my $new_req = shift @_;

    # Add a newline, if there isn't one.
    $new_req =~ s{ ([^\n]) \z }{$1\n}xms;

    $new_req .= "/* COMPANY DEBUGGING INFO\n";

    my $frame_num = 1;
    while ( my @frame_info = caller( $frame_num++ ) ) {
        $new_req .= "$frame_num. $frame_info[0]\::$frame_info[3] ($fra
+me_info[1], line $frame_info[2])\n";
    }

    $new_req .= "*/\n";

    return $new_req;
}

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

foreach my $method_name ( @methods ) {
    my $method = $method_name;
    no strict 'refs';
    *{ __PACKAGE__ . "::$method" } = sub {
        my $self = shift @_;
        my $sql  = _rewrite( shift @_ );
        return $self->${ \"SUPER::$method" }( $sql, @_ );
    };
}

package LT::DatabaseRoot::st;
use base 'DBIx::ContextualFetch::st';

1;
__END__

=pod

=head1 NAME

My::DatabaseRoot -- A class between the application and database

=head1 SYNOPSIS

    DBI->connect( $dsn, $user, $pass,
                  { RootClass => 'My::DatabaseRoot' } );

=head1 DESCRIPTION

The purpose of My::DatabaseRoot is to get between the application
and the database.  Anything we want to do with our DBI access on a
global basis can be added here.

=head1 AUTHOR

Kyle Hasselbacher

=cut
[download]

In reply to Re: Can DBI modify queries on the fly? by kyle
in thread Can DBI modify queries on the fly? by kyle

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


XP is just a number
	PerlMonks