c data when set to true.
=back
=head1 INTERACTION WITH APACHE::DBI
This module goes out of its way to make Apache::DBI do approximately
the right thing. Almost too far.
=head1 BUGS, CAVEATS, and other WHATNOT
This is a total hack. It's probably designed all wrong, but it was intended
to be dropped right in to existing applications and just work, not to be pretty.
I think I hate the interface, but I'm not sure what to do about it.
Recommendations welcome.
Note that the structure of the DBD::Multiplex module is intentionally flat, to
make it easy to subclass, on the off-chance you, say, don't like the callback
interface or want to do something more sophisticated with it. This does mean, however,
that one can perhaps inadvertently do really strange things, like call connect() on a
statement handle, etc. I don't know what this means for the state of the free
world at large, but I'll take suggestions.
=head1 AUTHOR
Schuyler D. Erle <[EMAIL PROTECTED]>
=head1 COPYRIGHT
This code is copyright (c) 2002 O'Reilly & Associates, and is distributed under the
same terms as perl itself.
=head1 SEE ALSO
L, L
=cut
package DBD::Multiplex;
use DBI ();
use strict;
use vars qw( @ISA $VERSION $err $errstr $drh @db_export );
use constant DEBUG => 1;
@ISA= "DBI::dr";
$VERSION= "0.10";
$err= 0; # holds error code for DBI::err
$errstr = ""; # holds error string for DBI::errstr
$drh= undef; # holds driver handle once initialized
@db_export = qw( prepare ping ); # Subs we want to export to compound dbh classes.
A couple subs you might want to override if subclassing...
sub post_connect
{
my ( $drh, $dbh, $user, $pass, $attr ) = @_;
if ( my $dsn = $dbh->{multi_read} ) {
# Use the default user, password, etc. if the DSN is specified as a string.
$dsn = [ $dsn, $user, $pass, $attr ] unless ref $dsn;
warn "$dbh: Creating read-only handle $dsn->[0]...\n" if $dbh->{multi_debug};
# Get the read-only handle, and stash it in the read-write handle.
$dbh->{multi_read_dbh} = DBI->connect( @$dsn ) or return;
}
return 1;
}
sub prepare_multiplexed
{
my $dbh = shift;
my $st = shift;
# If this is a SELECT statement, and we have a read-only handle, use it.
#
# Otherwise, use the read/write handle with its original prepare method.
#
if ( $st =~ /^\W*SELECT\b/io and $dbh->{multi_read_dbh} ) {
warn "$dbh->prepare: caught select, using read-only handle: $st\n" if
$dbh->{multi_debug};
return $dbh->{multi_read_dbh}->prepare( $st, @_ );
} else {
warn "$dbh->prepare: not a select, using primary handle ($dbh): $st\n" if
$dbh->{multi_debug};
return $dbh->SUPER::prepare( @_ );
}
}
DBD::Multiplex specific what-not.
sub _subclass
{
my ( $drh, $dbh ) = @_;
no strict 'refs';
# Build the original driver class name, and the mixin class name.
( my $dbd = ref($dbh) || $dbh ) =~ s/::db$//o;
( my $mixin = $drh ) =~ s/(::dr)?$/::$dbd/o;
unless ( %{"$mixin\::db::"} ) { # Been there, done it.
# Instantiate the mixin classes, if they don't already exist.
@{"$mixin\::$_\::ISA"} = "$dbd\::$_" for (qw( st db ));
# Export db handle methods.
*{"$mixin\::db::$_"} = $drh->can($_) for @db_export;
}
return "$mixin\::db";
}
Overridden DBD functions.
sub driver
{
my ($class, $attr) = @_;
return $drh if $drh;
$drh = DBI::_new_drh( $class, {
Name=> $class,
Version => $VERSION,
Err => \$err,
Errstr => \$errstr,
Attribution => "$class $VERSION by Schuyler Erle ",
%$attr
});
return $drh;
}
sub connect
{
my $drh = shift;
my ( $dsn, $user, $pass, $attr ) = @_;
my %clean_attr;
# Parse out the DSN. See if we have a "unified" style DSN.
my ( $dbi, $multi, $driver, $dbname, $master, $slave, $etc )
= split( ":", $dsn, 6 );
# If not, stuff whatever ended up in $slave onto $etc.
if ( defined($slave) and $slave =~ /[=;]/o ) {
$etc = $slave . ( defined($etc) ? ":$etc" : "" );
$slave = undef;
}
# Build the "original" master DSN.
$dsn = join(":", grep( defined($_), $dbi, $driver, $dbname, $master, $etc ));
# Apache/DBI.pm can't handle non-scalar attribute values. So hide everything.
#
if ( $INC{'Apache/DBI.pm'} and $ENV{GATEWAY_INTERFACE} ) {
$clean_attr{$_} = $attr->{$_} for grep( !/^multi_/o, keys %$attr );
} else {
%clean_attr = %$attr;
}
my $dbh = DBI-&
