X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FReplicated.pm;h=bb6517a6b25d511849f718bedf2b523830526fdd;hb=2ce6e9a68d68fa86e3b28df61496e85c996b2c1a;hp=b0de54f03cd15e3f71f56393dca00199d61bef70;hpb=1c6a29fecdd74b402851da5678d78a200afc9e11;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index b0de54f..bb6517a 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -1,12 +1,11 @@
 package DBIx::Class::Storage::DBI::Replicated;
 
 use Moose;
+use Class::MOP;
+use Moose::Util::TypeConstraints;
 use DBIx::Class::Storage::DBI;
 use DBIx::Class::Storage::DBI::Replicated::Pool;
 use DBIx::Class::Storage::DBI::Replicated::Balancer;
-use Scalar::Util qw(blessed);
-
-extends 'DBIx::Class::Storage::DBI', 'Moose::Object';
 
 =head1 NAME
 
@@ -18,18 +17,18 @@ The Following example shows how to change an existing $schema to a replicated
 storage type, add some replicated (readonly) databases, and perform reporting
 tasks.
 
-    ## Change storage_type in your schema class
-    $schema->storage_type( ['::DBI::Replicated', {balancer=>'::Random'}] );
-    
-    ## Add some slaves.  Basically this is an array of arrayrefs, where each
-    ## arrayref is database connect information
-    
-    $schema->storage->connect_replicants(
-        [$dsn1, $user, $pass, \%opts],
-        [$dsn2, $user, $pass, \%opts],
-        [$dsn3, $user, $pass, \%opts],
-    );
-    
+  ## Change storage_type in your schema class
+  $schema->storage_type( ['::DBI::Replicated', {balancer=>'::Random'}] );
+  
+  ## Add some slaves.  Basically this is an array of arrayrefs, where each
+  ## arrayref is database connect information
+  
+  $schema->storage->connect_replicants(
+    [$dsn1, $user, $pass, \%opts],
+    [$dsn2, $user, $pass, \%opts],
+    [$dsn3, $user, $pass, \%opts],
+  );
+  
 =head1 DESCRIPTION
 
 Warning: This class is marked ALPHA.  We are using this in development and have
@@ -63,6 +62,19 @@ connects to the master.
 
 This class defines the following attributes.
 
+=head2 schema
+
+The underlying L<DBIx::Class::Schema> object this storage is attaching
+
+=cut
+
+has 'schema' => (
+    is=>'rw',
+    isa=>'DBIx::Class::Schema',
+    weak_ref=>1,
+    required=>1,
+);
+
 =head2 pool_type
 
 Contains the classname which will instantiate the L</pool> object.  Defaults 
@@ -71,12 +83,13 @@ to: L<DBIx::Class::Storage::DBI::Replicated::Pool>.
 =cut
 
 has 'pool_type' => (
-    is=>'ro',
-    isa=>'ClassName',
-    lazy_build=>1,
-    handles=>{
-        'create_pool' => 'new',
-    },
+  is=>'ro',
+  isa=>'ClassName',
+  required=>1,
+  default=>'DBIx::Class::Storage::DBI::Replicated::Pool',
+  handles=>{
+    'create_pool' => 'new',
+  },
 );
 
 =head2 pool_args
@@ -87,11 +100,11 @@ See L<DBIx::Class::Storage::Replicated::Pool> for available arguments.
 =cut
 
 has 'pool_args' => (
-    is=>'ro',
-    isa=>'HashRef',
-    lazy=>1,
-    required=>1,
-    default=>sub { {} },
+  is=>'ro',
+  isa=>'HashRef',
+  lazy=>1,
+  required=>1,
+  default=>sub { {} },
 );
 
 
@@ -102,13 +115,29 @@ choose how to spread the query load across each replicant in the pool.
 
 =cut
 
+subtype 'DBIx::Class::Storage::DBI::Replicated::BalancerClassNamePart',
+  as 'ClassName';
+    
+coerce 'DBIx::Class::Storage::DBI::Replicated::BalancerClassNamePart',
+  from 'Str',
+  via {
+  	my $type = $_;
+    if($type=~m/^::/) {
+      $type = 'DBIx::Class::Storage::DBI::Replicated::Balancer'.$type;
+    }  
+    Class::MOP::load_class($type);  
+    $type;  	
+  };
+
 has 'balancer_type' => (
-    is=>'ro',
-    isa=>'ClassName',
-    lazy_build=>1,
-    handles=>{
-        'create_balancer' => 'new',
-    },
+  is=>'ro',
+  isa=>'DBIx::Class::Storage::DBI::Replicated::BalancerClassNamePart',
+  coerce=>1,
+  required=>1,
+  default=> 'DBIx::Class::Storage::DBI::Replicated::Balancer::First',
+  handles=>{
+    'create_balancer' => 'new',
+  },
 );
 
 =head2 balancer_args
@@ -119,11 +148,11 @@ See L<DBIx::Class::Storage::Replicated::Balancer> for available arguments.
 =cut
 
 has 'balancer_args' => (
-    is=>'ro',
-    isa=>'HashRef',
-    lazy=>1,
-    required=>1,
-    default=>sub { {} },
+  is=>'ro',
+  isa=>'HashRef',
+  lazy=>1,
+  required=>1,
+  default=>sub { {} },
 );
 
 =head2 pool
@@ -134,14 +163,14 @@ container class for one or more replicated databases.
 =cut
 
 has 'pool' => (
-    is=>'ro',
-    isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
-    lazy_build=>1,
-    handles=>[qw/
-        connect_replicants    
-        replicants
-        has_replicants
-    /],
+  is=>'ro',
+  isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
+  lazy_build=>1,
+  handles=>[qw/
+    connect_replicants    
+    replicants
+    has_replicants
+  /],
 );
 
 =head2 balancer
@@ -152,10 +181,10 @@ is a class that takes a pool (<DBIx::Class::Storage::DBI::Replicated::Pool>)
 =cut
 
 has 'balancer' => (
-    is=>'ro',
-    isa=>'DBIx::Class::Storage::DBI::Replicated::Balancer',
-    lazy_build=>1,
-    handles=>[qw/auto_validate_every/],
+  is=>'ro',
+  isa=>'DBIx::Class::Storage::DBI::Replicated::Balancer',
+  lazy_build=>1,
+  handles=>[qw/auto_validate_every/],
 );
 
 =head2 master
@@ -169,9 +198,9 @@ pool of databases that is allowed to handle write traffic.
 =cut
 
 has 'master' => (
-    is=> 'ro',
-    isa=>'DBIx::Class::Storage::DBI',
-    lazy_build=>1,
+  is=> 'ro',
+  isa=>'DBIx::Class::Storage::DBI',
+  lazy_build=>1,
 );
 
 =head1 ATTRIBUTES IMPLEMENTING THE DBIx::Storage::DBI INTERFACE
@@ -186,14 +215,14 @@ Defines an object that implements the read side of L<BIx::Class::Storage::DBI>.
 =cut
 
 has 'read_handler' => (
-    is=>'rw',
-    isa=>'Object',
-    lazy_build=>1,
-    handles=>[qw/
-        select
-        select_single
-        columns_info_for
-    /],    
+  is=>'rw',
+  isa=>'Object',
+  lazy_build=>1,
+  handles=>[qw/
+    select
+    select_single
+    columns_info_for
+  /],    
 );
 
 =head2 write_handler
@@ -203,35 +232,40 @@ Defines an object that implements the write side of L<BIx::Class::Storage::DBI>.
 =cut
 
 has 'write_handler' => (
-    is=>'ro',
-    isa=>'Object',
-    lazy_build=>1,
-    lazy_build=>1,
-    handles=>[qw/   
-        on_connect_do
-        on_disconnect_do       
-        connect_info
-        throw_exception
-        sql_maker
-        sqlt_type
-        create_ddl_dir
-        deployment_statements
-        datetime_parser
-        datetime_parser_type        
-        last_insert_id
-        insert
-        insert_bulk
-        update
-        delete
-        dbh
-        txn_do
-        txn_commit
-        txn_rollback
-        sth
-        deploy
-        schema
-        reload_row
-    /],
+  is=>'ro',
+  isa=>'Object',
+  lazy_build=>1,
+  lazy_build=>1,
+  handles=>[qw/   
+    on_connect_do
+    on_disconnect_do       
+    connect_info
+    throw_exception
+    sql_maker
+    sqlt_type
+    create_ddl_dir
+    deployment_statements
+    datetime_parser
+    datetime_parser_type        
+    last_insert_id
+    insert
+    insert_bulk
+    update
+    delete
+    dbh
+    txn_begin
+    txn_do
+    txn_commit
+    txn_rollback
+    txn_scope_guard
+    sth
+    deploy
+
+    reload_row
+    _prep_for_execute
+    configure_sqlt
+    
+  /],
 );
 
 =head1 METHODS
@@ -241,32 +275,15 @@ This class defines the following methods.
 =head2 new
 
 L<DBIx::Class::Schema> when instantiating it's storage passed itself as the
-first argument.  We need to invoke L</new> on the underlying parent class, make
-sure we properly give it a L<Moose> meta class, and then correctly instantiate
-our attributes.  Basically we pass on whatever the schema has in it's class
-data for 'storage_type_args' to our replicated storage type.
+first argument.  So we need to massage the arguments a bit so that all the
+bits get put into the correct places.
 
 =cut
 
-sub new {
-    my $class = shift @_;
-    my $schema = shift @_;
-    my $storage_type_args = shift @_;
-    my $obj = $class->SUPER::new($schema, $storage_type_args, @_);
-    
-    ## Hate to do it this way, but can't seem to get advice on the attribute working right
-    ## maybe we can do a type and coercion for it. 
-    if( $storage_type_args->{balancer_type} && $storage_type_args->{balancer_type}=~m/^::/) {
-        $storage_type_args->{balancer_type} = 'DBIx::Class::Storage::DBI::Replicated::Balancer'.$storage_type_args->{balancer_type};
-        eval "require $storage_type_args->{balancer_type}";
-    }
-    
-    return $class->meta->new_object(
-        __INSTANCE__ => $obj,
-        %$storage_type_args,
-        @_,
-    );
-}
+around 'new' => sub {
+  my ($new, $self, $schema, $storage_type_args, @args) = @_;
+  return $self->$new(schema=>$schema, %$storage_type_args, @args);
+};
 
 =head2 _build_master
 
@@ -275,17 +292,8 @@ Lazy builder for the L</master> attribute.
 =cut
 
 sub _build_master {
-    DBIx::Class::Storage::DBI->new;
-}
-
-=head2 _build_pool_type
-
-Lazy builder for the L</pool_type> attribute.
-
-=cut
-
-sub _build_pool_type {
-    return 'DBIx::Class::Storage::DBI::Replicated::Pool';
+  my $self = shift @_;
+  DBIx::Class::Storage::DBI->new($self->schema);
 }
 
 =head2 _build_pool
@@ -295,18 +303,8 @@ Lazy builder for the L</pool> attribute.
 =cut
 
 sub _build_pool {
-    my $self = shift @_;
-    $self->create_pool(%{$self->pool_args});
-}
-
-=head2 _build_balancer_type
-
-Lazy builder for the L</balancer_type> attribute.
-
-=cut
-
-sub _build_balancer_type {
-    return 'DBIx::Class::Storage::DBI::Replicated::Balancer::First';
+  my $self = shift @_;
+  $self->create_pool(%{$self->pool_args});
 }
 
 =head2 _build_balancer
@@ -317,12 +315,12 @@ the balancer knows which pool it's balancing.
 =cut
 
 sub _build_balancer {
-    my $self = shift @_;
-    $self->create_balancer(
-        pool=>$self->pool, 
-        master=>$self->master,
-        %{$self->balancer_args},
-    );
+  my $self = shift @_;
+  $self->create_balancer(
+    pool=>$self->pool, 
+    master=>$self->master,
+    %{$self->balancer_args},
+  );
 }
 
 =head2 _build_write_handler
@@ -333,7 +331,7 @@ the L</master>.
 =cut
 
 sub _build_write_handler {
-    return shift->master;
+  return shift->master;
 }
 
 =head2 _build_read_handler
@@ -344,7 +342,7 @@ the L</balancer>.
 =cut
 
 sub _build_read_handler {
-    return shift->balancer;
+  return shift->balancer;
 }
 
 =head2 around: connect_replicants
@@ -355,8 +353,8 @@ top of the args, since L<DBIx::Storage::DBI> needs it.
 =cut
 
 around 'connect_replicants' => sub {
-    my ($method, $self, @args) = @_;
-    $self->$method($self->schema, @args);
+  my ($method, $self, @args) = @_;
+  $self->$method($self->schema, @args);
 };
 
 =head2 all_storages
@@ -368,12 +366,11 @@ replicants.
 =cut
 
 sub all_storages {
-    my $self = shift @_;
-    
-    return grep {defined $_ && blessed $_} (
-       $self->master,
-       $self->replicants,
-    );
+  my $self = shift @_;
+  return grep {defined $_ && blessed $_} (
+     $self->master,
+     $self->replicants,
+  );
 }
 
 =head2 execute_reliably ($coderef, ?@args)
@@ -384,14 +381,14 @@ restores the original state.
 
 Example:
 
-    my $reliably = sub {
-        my $name = shift @_;
-        $schema->resultset('User')->create({name=>$name});
-        my $user_rs = $schema->resultset('User')->find({name=>$name}); 
-        return $user_rs;
-    };
+  my $reliably = sub {
+    my $name = shift @_;
+    $schema->resultset('User')->create({name=>$name});
+    my $user_rs = $schema->resultset('User')->find({name=>$name}); 
+    return $user_rs;
+  };
 
-    my $user_rs = $schema->storage->execute_reliably($reliably, 'John');
+  my $user_rs = $schema->storage->execute_reliably($reliably, 'John');
 
 Use this when you must be certain of your database state, such as when you just
 inserted something and need to get a resultset including it, etc.
@@ -399,77 +396,76 @@ inserted something and need to get a resultset including it, etc.
 =cut
 
 sub execute_reliably {
-    my ($self, $coderef, @args) = @_;
-    
-    unless( ref $coderef eq 'CODE') {
-        $self->throw_exception('Second argument must be a coderef');
-    }
-
-    ##Get copy of master storage
-    my $master = $self->master;
-    
-    ##Get whatever the current read hander is
-    my $current = $self->read_handler;
-    
-    ##Set the read handler to master
-    $self->read_handler($master);
-    
-    ## do whatever the caller needs
-    my @result;
-    my $want_array = wantarray;
-    
-    eval {
-        if($want_array) {
-            @result = $coderef->(@args);
-        }
-        elsif(defined $want_array) {
-            ($result[0]) = ($coderef->(@args));
-        } else {
-            $coderef->(@args);
-        }       
-    };
-    
-    ##Reset to the original state
-    $self->read_handler($current); 
-    
-    ##Exception testing has to come last, otherwise you might leave the 
-    ##read_handler set to master.
-    
-    if($@) {
-        $self->throw_exception("coderef returned an error: $@");
+  my ($self, $coderef, @args) = @_;
+  
+  unless( ref $coderef eq 'CODE') {
+    $self->throw_exception('Second argument must be a coderef');
+  }
+  
+  ##Get copy of master storage
+  my $master = $self->master;
+  
+  ##Get whatever the current read hander is
+  my $current = $self->read_handler;
+  
+  ##Set the read handler to master
+  $self->read_handler($master);
+  
+  ## do whatever the caller needs
+  my @result;
+  my $want_array = wantarray;
+  
+  eval {
+    if($want_array) {
+      @result = $coderef->(@args);
+    } elsif(defined $want_array) {
+      ($result[0]) = ($coderef->(@args));
     } else {
-        return $want_array ? @result : $result[0];
-    }
+      $coderef->(@args);
+    }       
+  };
+  
+  ##Reset to the original state
+  $self->read_handler($current); 
+  
+  ##Exception testing has to come last, otherwise you might leave the 
+  ##read_handler set to master.
+  
+  if($@) {
+    $self->throw_exception("coderef returned an error: $@");
+  } else {
+    return $want_array ? @result : $result[0];
+  }
 }
 
 =head2 set_reliable_storage
 
 Sets the current $schema to be 'reliable', that is all queries, both read and
 write are sent to the master
-    
+  
 =cut
 
 sub set_reliable_storage {
-    my $self = shift @_;
-    my $schema = $self->schema;
-    my $write_handler = $self->schema->storage->write_handler;
-    
-    $schema->storage->read_handler($write_handler);
+  my $self = shift @_;
+  my $schema = $self->schema;
+  my $write_handler = $self->schema->storage->write_handler;
+  
+  $schema->storage->read_handler($write_handler);
 }
 
 =head2 set_balanced_storage
 
 Sets the current $schema to be use the </balancer> for all reads, while all
 writea are sent to the master only
-    
+  
 =cut
 
 sub set_balanced_storage {
-    my $self = shift @_;
-    my $schema = $self->schema;
-    my $write_handler = $self->schema->storage->balancer;
-    
-    $schema->storage->read_handler($write_handler);
+  my $self = shift @_;
+  my $schema = $self->schema;
+  my $write_handler = $self->schema->storage->balancer;
+  
+  $schema->storage->read_handler($write_handler);
 }
 
 =head2 around: txn_do ($coderef)
@@ -481,8 +477,8 @@ L</execute_reliably> method.
 =cut
 
 around 'txn_do' => sub {
-    my($txn_do, $self, $coderef, @args) = @_;
-    $self->execute_reliably(sub {$self->$txn_do($coderef, @args)}); 
+  my($txn_do, $self, $coderef, @args) = @_;
+  $self->execute_reliably(sub {$self->$txn_do($coderef, @args)}); 
 };
 
 =head2 reload_row ($row)
@@ -493,10 +489,10 @@ the master storage.
 =cut
 
 around 'reload_row' => sub {
-    my ($reload_row, $self, $row) = @_;
-    return $self->execute_reliably(sub {
-        return $self->$reload_row(shift);
-    }, $row);
+  my ($reload_row, $self, $row) = @_;
+  return $self->execute_reliably(sub {
+    return $self->$reload_row(shift);
+  }, $row);
 };
 
 =head2 connected
@@ -506,11 +502,10 @@ Check that the master and at least one of the replicants is connected.
 =cut
 
 sub connected {
-    my $self = shift @_;
-    
-    return
-       $self->master->connected &&
-       $self->pool->connected_replicants;
+  my $self = shift @_;
+  return
+    $self->master->connected &&
+    $self->pool->connected_replicants;
 }
 
 =head2 ensure_connected
@@ -520,10 +515,10 @@ Make sure all the storages are connected.
 =cut
 
 sub ensure_connected {
-    my $self = shift @_;
-    foreach my $source ($self->all_storages) {
-        $source->ensure_connected(@_);
-    }
+  my $self = shift @_;
+  foreach my $source ($self->all_storages) {
+    $source->ensure_connected(@_);
+  }
 }
 
 =head2 limit_dialect
@@ -533,10 +528,10 @@ Set the limit_dialect for all existing storages
 =cut
 
 sub limit_dialect {
-    my $self = shift @_;
-    foreach my $source ($self->all_storages) {
-        $source->limit_dialect(@_);
-    }
+  my $self = shift @_;
+  foreach my $source ($self->all_storages) {
+    $source->limit_dialect(@_);
+  }
 }
 
 =head2 quote_char
@@ -546,10 +541,10 @@ Set the quote_char for all existing storages
 =cut
 
 sub quote_char {
-    my $self = shift @_;
-    foreach my $source ($self->all_storages) {
-        $source->quote_char(@_);
-    }
+  my $self = shift @_;
+  foreach my $source ($self->all_storages) {
+    $source->quote_char(@_);
+  }
 }
 
 =head2 name_sep
@@ -559,10 +554,10 @@ Set the name_sep for all existing storages
 =cut
 
 sub name_sep {
-    my $self = shift @_;
-    foreach my $source ($self->all_storages) {
-        $source->name_sep(@_);
-    }
+  my $self = shift @_;
+  foreach my $source ($self->all_storages) {
+    $source->name_sep(@_);
+  }
 }
 
 =head2 set_schema
@@ -572,10 +567,10 @@ Set the schema object for all existing storages
 =cut
 
 sub set_schema {
-    my $self = shift @_;
-    foreach my $source ($self->all_storages) {
-        $source->set_schema(@_);
-    }
+  my $self = shift @_;
+  foreach my $source ($self->all_storages) {
+    $source->set_schema(@_);
+  }
 }
 
 =head2 debug
@@ -585,10 +580,10 @@ set a debug flag across all storages
 =cut
 
 sub debug {
-    my $self = shift @_;
-    foreach my $source ($self->all_storages) {
-        $source->debug(@_);
-    }
+  my $self = shift @_;
+  foreach my $source ($self->all_storages) {
+    $source->debug(@_);
+  }
 }
 
 =head2 debugobj
@@ -598,10 +593,10 @@ set a debug object across all storages
 =cut
 
 sub debugobj {
-    my $self = shift @_;
-    foreach my $source ($self->all_storages) {
-        $source->debugobj(@_);
-    }
+  my $self = shift @_;
+  foreach my $source ($self->all_storages) {
+    $source->debugobj(@_);
+  }
 }
 
 =head2 debugfh
@@ -611,10 +606,10 @@ set a debugfh object across all storages
 =cut
 
 sub debugfh {
-    my $self = shift @_;
-    foreach my $source ($self->all_storages) {
-        $source->debugfh(@_);
-    }
+  my $self = shift @_;
+  foreach my $source ($self->all_storages) {
+    $source->debugfh(@_);
+  }
 }
 
 =head2 debugcb
@@ -624,10 +619,10 @@ set a debug callback across all storages
 =cut
 
 sub debugcb {
-    my $self = shift @_;
-    foreach my $source ($self->all_storages) {
-        $source->debugcb(@_);
-    }
+  my $self = shift @_;
+  foreach my $source ($self->all_storages) {
+    $source->debugcb(@_);
+  }
 }
 
 =head2 disconnect
@@ -637,20 +632,20 @@ disconnect everything
 =cut
 
 sub disconnect {
-    my $self = shift @_;
-    foreach my $source ($self->all_storages) {
-        $source->disconnect(@_);
-    }
+  my $self = shift @_;
+  foreach my $source ($self->all_storages) {
+    $source->disconnect(@_);
+  }
 }
 
 =head1 AUTHOR
 
-    John Napiorkowski <john.napiorkowski@takkle.com>
+  John Napiorkowski <john.napiorkowski@takkle.com>
 
 Based on code originated by:
 
-    Norbert Csongrádi <bert@cpan.org>
-    Peter Siklósi <einon@einon.hu>
+  Norbert Csongrádi <bert@cpan.org>
+  Peter Siklósi <einon@einon.hu>
 
 =head1 LICENSE