[Bast-commits] r7446 - in
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage: . DBI DBI/Replicated
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Mon Aug 31 02:36:11 GMT 2009
Author: caelum
Date: 2009-08-31 02:36:08 +0000 (Mon, 31 Aug 2009)
New Revision: 7446
Modified:
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
Log:
support coderef connect_infos for repicated storage
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2009-08-30 20:04:17 UTC (rev 7445)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2009-08-31 02:36:08 UTC (rev 7446)
@@ -5,6 +5,7 @@
use DBIx::Class::Storage::DBI::Replicated::Replicant;
use List::Util 'sum';
use Scalar::Util 'reftype';
+use DBI ();
use Carp::Clan qw/^DBIx::Class/;
use MooseX::Types::Moose qw/Num Int ClassName HashRef/;
@@ -158,16 +159,32 @@
$connect_info = [ $connect_info ]
if reftype $connect_info ne 'ARRAY';
- croak "coderef replicant connect_info not supported"
- if ref $connect_info->[0] && reftype $connect_info->[0] eq 'CODE';
-
my $replicant = $self->connect_replicant($schema, $connect_info);
- my $key = $connect_info->[0];
- $key = $key->{dsn} if ref $key && reftype $key eq 'HASH';
- ($key) = ($key =~ m/^dbi\:.+\:(.+)$/);
+ my $connect_coderef =
+ (reftype($connect_info->[0])||'') eq 'CODE' ? $connect_info->[0]
+ : (reftype($connect_info->[0])||'') eq 'HASH' &&
+ $connect_info->[0]->{dbh_maker};
- $self->set_replicant( $key => $replicant);
+ my $dsn;
+ if (not $connect_coderef) {
+ $dsn = $connect_info->[0];
+ $dsn = $dsn->{dsn} if (reftype($dsn)||'') eq 'HASH';
+ }
+ else {
+# yes this is evil, but it only usually happens once
+ no warnings 'redefine';
+ my $connect = \&DBI::connect;
+ local *DBI::connect = sub {
+ $dsn = $_[1];
+ goto $connect;
+ };
+ $connect_coderef->();
+ }
+ $replicant->dsn($dsn);
+ my ($key) = ($dsn =~ m/^dbi\:.+\:(.+)$/i);
+
+ $self->set_replicant($key => $replicant);
push @newly_created, $replicant;
}
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm 2009-08-30 20:04:17 UTC (rev 7445)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm 2009-08-31 02:36:08 UTC (rev 7446)
@@ -3,7 +3,7 @@
use Moose::Role;
requires qw/_query_start/;
with 'DBIx::Class::Storage::DBI::Replicated::WithDSN';
-use MooseX::Types::Moose 'Bool';
+use MooseX::Types::Moose qw/Bool Str/;
use namespace::clean -except => 'meta';
@@ -52,6 +52,11 @@
default=>1,
);
+has dsn => (
+ is => 'rw',
+ isa => Str,
+);
+
=head1 METHODS
This class defines the following methods.
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm 2009-08-30 20:04:17 UTC (rev 7445)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm 2009-08-31 02:36:08 UTC (rev 7446)
@@ -1,6 +1,7 @@
package DBIx::Class::Storage::DBI::Replicated::WithDSN;
use Moose::Role;
+use Scalar::Util 'reftype';
requires qw/_query_start/;
use namespace::clean -except => 'meta';
@@ -30,11 +31,22 @@
around '_query_start' => sub {
my ($method, $self, $sql, @bind) = @_;
- my $dsn = $self->_dbi_connect_info->[0];
+
+ my $dsn = eval { $self->dsn } || $self->_dbi_connect_info->[0];
+
my($op, $rest) = (($sql=~m/^(\w+)(.+)$/),'NOP', 'NO SQL');
my $storage_type = $self->can('active') ? 'REPLICANT' : 'MASTER';
- $self->$method("$op [DSN_$storage_type=$dsn]$rest", @bind);
+ my $query = do {
+ if ((reftype($dsn)||'') ne 'CODE') {
+ "$op [DSN_$storage_type=$dsn]$rest";
+ }
+ else {
+ "$op [$storage_type]$rest";
+ }
+ };
+
+ $self->$method($query, @bind);
};
=head1 ALSO SEE
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated.pm 2009-08-30 20:04:17 UTC (rev 7445)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Replicated.pm 2009-08-31 02:36:08 UTC (rev 7446)
@@ -518,8 +518,15 @@
# delete them
splice @$r, $i+1, ($#{$r} - $i), ();
+# make sure master/replicants opts don't clash
+ my %master_opts = %{ $self->_master_connect_info_opts };
+ if (exists $opts{dbh_maker}) {
+ delete @master_opts{qw/dsn user password/};
+ }
+ delete $master_opts{dbh_maker};
+
# merge with master
- %opts = %{ merge(\%opts, $self->_master_connect_info_opts) };
+ %opts = %{ merge(\%opts, \%master_opts) };
# update
$r->[$i] = \%opts;
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2009-08-30 20:04:17 UTC (rev 7445)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2009-08-31 02:36:08 UTC (rev 7446)
@@ -876,10 +876,18 @@
if ($self->_dbh) { # we are connected
$driver = $self->_dbh->{Driver}{Name};
} else {
- # try to use dsn to not require being connected, the driver may still
- # force a connection in _rebless to determine version
- ($driver) = $self->_dbi_connect_info->[0] =~ /dbi:([^:]+):/i;
- $started_unconnected = 1;
+ # if connect_info is a CODEREF, we have no choice but to connect
+ if (ref $self->_dbi_connect_info->[0] &&
+ Scalar::Util::reftype($self->_dbi_connect_info->[0]) eq 'CODE') {
+ $self->_populate_dbh;
+ $driver = $self->_dbh->{Driver}{Name};
+ }
+ else {
+ # try to use dsn to not require being connected, the driver may still
+ # force a connection in _rebless to determine version
+ ($driver) = $self->_dbi_connect_info->[0] =~ /dbi:([^:]+):/i;
+ $started_unconnected = 1;
+ }
}
my $storage_class = "DBIx::Class::Storage::DBI::${driver}";
More information about the Bast-commits
mailing list