Re: Can DBI modify queries on the fly?

[kyle]

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