Hello. I've written a DBD module to wrap other DBD handles and provide
intelligent drop-in support for asymmetrically replicated databases
(e.g., MySQL v3). First I was going to call it DBD::Switch, but then I
noticed that DBI.pm implements a DBD::Switch. So I decided to call it
DBD::Multiplex. I wrote a first draft and *then* discovered that DBI
ships with a DBD::Multiplex as well. So I can't figure out what the hell
to call this module. Suggestions?

Please find the relevant code attached. I welcome other code-related
recommendations, as well. (Please note that I haven't actually tested
the code in its current incarnation yet -- I'll write tests and make
sure they work before releasing to the CPAN.) TIA for your help.

SDE
=head1 NAME

DBD::Multiplex - Perl extension for intelligently multiplexing DBI database handles

=head1 SYNOPSIS

  use DBI;

  # Create a single multiplexed DBI handle.
  #
  my $dsn  = "DBI:Multiplex:driver:dbname:master_host";
  my $dbh  = DBI->connect( $dsn, $user1, $pass1, 
    { multi_read => [ "DBI:driver:dbname:slave_host", $user2, $pass2, ... ] }
  );

  # Create a multiplexed handle using the same username and password.
  #
  my $dbh  = DBI->connect( "DBI:Multiplex:driver:dbname,master_host",
      $user, $pass, { multi_read => "DBI:driver:dbname:slave_host" } );

  # Create a multiplexed handle using the same driver, database name, 
  # username *and* password.
  #
  my $dbh  = DBI->connect( "DBI:Multiplex:driver:dbname:master_host:slave_host",
      $user, $pass, { ... } );
    
  # Use replicated read-only database.
  #
  my $sth = $dbh->prepare( "SELECT * FROM foo" );       

  # Use master read/write database.
  #
  my $sth = $dbh->prepare( "UPDATE foo SET bar = ?" );

  # Use a callback to provide custom SQL dispatch.
  #
  my %attr = ( multi_prepare => \&my_special_prepare, ... <custom params here> ... );
  my $dbh  = DBI->connect( "DBI:Multiplex:...", $user, $pass, \%attr );

=head1 DESCRIPTION

DBD::Multiplex attempts to address the problem of clustering database servers that only
support asymmetric replication. MySQL version 3 is a notable example: Writes made to
a master server are instantly replicated by slave servers, but writes to slave servers
are essentially ignored.

DBD::Multiplex takes a "multi_read" attribute that points to a slave database.
Henceforth, SELECT statements made on the multiplexed handle are always directed to 
this
"read-only" sub-handle, while all other database traffic is directed to the master 
database.
DBD::Multplex handles behave in every other respect just as do the original DBD handles
being multplexed.

DBD::Multiplex is hence a virtually "drop-in" solution for porting existing DBI code to
an asymmetrically replicated database cluster. Although designed for use with MySQL 
v3, 
this module uses no database-specfic features, and can theoretically be used to 
multiplex
any DBD driver. Additionally, DBD::Multiplex features pluggable custom multiplexing
via callbacks.

=head1 RELATED METHODS

=over 4

=item DBI->connect( $dsn, $user, $pass, $attr )

Same as your typical DBI call, except that the DSN takes the form
"DBI:Multiplex:actual_driver:...". DBD::Multiplex also supports a unified
DSN of the form "DBI:Multiplex:driver:database:master_host:slave_host", where
the same driver, database name, username and password are used to connect
to both the master and slave database servers.

=item $dbh->prepare( $statement )

Works just like you'd expect. Transparently sends SELECT statements
to the read-only handle listed in the "multi_read" database handle
attribute, directs all other traffic to the main database handle.

=item Other Database & Statement Methods

Had better work just like they ordinarily would, or I've screwed
something up.

=back

=head1 ATTRIBUTES

The following attributes can be passed in the attribute hash in
the call to DBI->connect():

=over 4

=item multi_read ( $dsn )

multi_read should be set to the DSN of the read-only slave server,
unless you use the "unified" DSN style described above.

=item multi_read_user ( $user )

=item multi_read_pass ( $pass )

=item multi_read_attr ( { ... } )

The username, password, and attribute hash for the read-only slave
database. If either or both of these is left unset, the value passed
to the master database handle is used instead.

=item multi_connect ( CODE )

=item multi_prepare ( CODE )

multi_connect and multi_prepare can be set to references to 
subroutines that will be called after a database handle is created, 
and instead of the regular multiplexed prepare(), respectively. One
might set these callbacks, perhaps in conjunction with custom
connect() attributes, to provide sophisticated custom multiplexing.

=item multi_debug

Provides a bunch of mostly useless diagnostic 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<perl>, L<DBI>

=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 <schuyler\@oreilly.com>",
        %$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->connect( $dsn, $user, $pass, $attr ) or return;

    # Now put all of those arguments back.
    $dbh->{$_} = $attr->{$_} for grep( !exists $dbh->{$_}, keys %$attr );

    # Stash the original driver class, so we can call back to it. 
    $dbh->{multi_rw_driver}  = ref $dbh;

    # Build the slave's DSN if we were passed a unified DSN.
    $dbh->{multi_read} ||= 
        join(":", grep( defined($_), $dbi, $driver, $dbname, $slave, $etc )) 
        if $slave;

    # Build the mixin subclasses.
    my $subclass = $drh->_subclass( $dbh );
    bless( $dbh, $subclass );

    # If we've been given a post-connect callback, use it.
    # Otherwise call post_connect to instantiate the read-only handle (if any).
    #
    if ( exists $dbh->{multi_connect} and my $thunk = $dbh->{multi_connect} ) {
        $drh->$thunk( $dbh, $user, $pass, $attr ) or return;
    } else {
        $drh->post_connect( $dbh, $user, $pass, $attr ) or return;
    }

    return $dbh;
}

sub prepare
{
    my $dbh = shift;
    if ( exists $dbh->{multi_prepare} and my $thunk = $dbh->{multi_prepare} ) {
        return $dbh->$thunk( @_ );
    } else {
        return $dbh->prepare_multiplexed( @_ );
    }
}

sub ping
{
    if ( caller eq "Apache::DBI" ) {
        return 0; # Oh, god, just leave us alone...
    } else {
        my $dbh = shift;
        return $dbh->SUPER::ping( @_ );
    }
}

1;

Reply via email to