From: Peter Rabbitson Date: Sun, 30 Aug 2009 07:01:40 +0000 (+0000) Subject: Merge 'trunk' into 'sybase' X-Git-Tag: v0.08112~14^2~39 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=67e9c1149519bc8205932c135883740076640cce;hp=7357c7bc904dffcc917657c98e4bdef93d253117;p=dbsrgits%2FDBIx-Class.git Merge 'trunk' into 'sybase' r7425@Thesaurus (orig r7422): ribasushi | 2009-08-29 08:55:12 +0200 Make podcoverage happy r7426@Thesaurus (orig r7423): ribasushi | 2009-08-29 09:06:07 +0200 Reduce the number of heavy dbh_do calls r7439@Thesaurus (orig r7436): ribasushi | 2009-08-30 08:54:10 +0200 r7435@Thesaurus (orig r7432): caelum | 2009-08-30 02:53:21 +0200 new branch r7436@Thesaurus (orig r7433): caelum | 2009-08-30 03:14:36 +0200 add dbh_maker option to connect_info hash r7437@Thesaurus (orig r7434): ribasushi | 2009-08-30 08:51:14 +0200 Minor cleanup and test enhancement r7438@Thesaurus (orig r7435): ribasushi | 2009-08-30 08:53:59 +0200 Changes --- diff --git a/Changes b/Changes index cc2a415..07cc546 100644 --- a/Changes +++ b/Changes @@ -11,6 +11,8 @@ Revision history for DBIx::Class when needed - Support for interpolated variables with proper quoting when connecting to an older Sybase and/or via FreeTDS + - The hashref to connection_info now accepts a 'dbh_maker' + coderef, allowing better intergration with Catalyst - Fixed a complex prefetch + regular join regression introduced in 0.08108 - SQLT related fixes: diff --git a/Makefile.PL b/Makefile.PL index d1dcf06..b6d7cf6 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -14,7 +14,7 @@ test_requires 'Test::Builder' => 0.33; test_requires 'Test::Deep' => 0; test_requires 'Test::Exception' => 0; test_requires 'Test::More' => 0.92; -test_requires 'Test::Warn' => 0.11; +test_requires 'Test::Warn' => 0.21; test_requires 'File::Temp' => 0.22; diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index eb923d1..b2a92ef 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -112,6 +112,12 @@ mixed together: %extra_attributes, }]; + $connect_info_args = [{ + dbh_maker => sub { DBI->connect (...) }, + %dbi_attributes, + %extra_attributes, + }]; + This is particularly useful for L based applications, allowing the following config (L style): @@ -125,6 +131,10 @@ following config (L style): +The C/C/C combination can be substituted by the +C key whose value is a coderef that returns a connected +L + =back Please note that the L docs recommend that you always explicitly @@ -337,6 +347,12 @@ L # Connect via subref ->connect_info([ sub { DBI->connect(...) } ]); + # Connect via subref in hashref + ->connect_info([{ + dbh_maker => sub { DBI->connect(...) }, + on_connect_do => 'alter session ...', + }]); + # A bit more complicated ->connect_info( [ @@ -407,8 +423,21 @@ sub connect_info { elsif (ref $args[0] eq 'HASH') { # single hashref (i.e. Catalyst config) %attrs = %{$args[0]}; @args = (); - for (qw/password user dsn/) { - unshift @args, delete $attrs{$_}; + if (my $code = delete $attrs{dbh_maker}) { + @args = $code; + + my @ignored = grep { delete $attrs{$_} } (qw/dsn user password/); + if (@ignored) { + carp sprintf ( + 'Attribute(s) %s in connect_info were ignored, as they can not be applied ' + . "to the result of 'dbh_maker'", + + join (', ', map { "'$_'" } (@ignored) ), + ); + } + } + else { + @args = delete @attrs{qw/dsn user password/}; } } else { # otherwise assume dsn/user/password + \%attrs + \%extra_attrs @@ -1238,7 +1267,7 @@ sub _dbh_execute { sub _execute { my $self = shift; - $self->dbh_do('_dbh_execute', @_) + $self->dbh_do('_dbh_execute', @_); # retry over disconnects } sub insert { @@ -2018,7 +2047,7 @@ sub _dbh_sth { sub sth { my ($self, $sql) = @_; - $self->dbh_do('_dbh_sth', $sql); + $self->dbh_do('_dbh_sth', $sql); # retry over disconnects } sub _dbh_columns_info_for { @@ -2080,7 +2109,7 @@ sub _dbh_columns_info_for { sub columns_info_for { my ($self, $table) = @_; - $self->dbh_do('_dbh_columns_info_for', $table); + $self->_dbh_columns_info_for ($self->_get_dbh, $table); } =head2 last_insert_id @@ -2106,7 +2135,7 @@ EOE sub last_insert_id { my $self = shift; - $self->dbh_do('_dbh_last_insert_id', @_); + $self->_dbh_last_insert_id ($self->_dbh, @_); } =head2 _native_data_type diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm index 9314396..2a7b529 100644 --- a/lib/DBIx/Class/Storage/DBI/Pg.pm +++ b/lib/DBIx/Class/Storage/DBI/Pg.pm @@ -19,20 +19,24 @@ sub with_deferred_fk_checks { $sub->(); } -sub _dbh_last_insert_id { - my ($self, $dbh, $seq) = @_; - $dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq}); -} - sub last_insert_id { my ($self,$source,$col) = @_; my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col)); $self->throw_exception("could not fetch primary key for " . $source->name . ", could not " . "get autoinc sequence for $col (check that table and column specifications are correct " . "and in the correct case)") unless defined $seq; - $self->dbh_do('_dbh_last_insert_id', $seq); + + $self->_dbh_last_insert_id ($self->_dbh, $seq); } +# there seems to be absolutely no reason to have this as a separate method, +# but leaving intact in case someone is already overriding it +sub _dbh_last_insert_id { + my ($self, $dbh, $seq) = @_; + $dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq}); +} + + sub _get_pg_search_path { my ($self,$dbh) = @_; # cache the search path as ['schema','schema',...] in the storage diff --git a/t/03podcoverage.t b/t/03podcoverage.t index a2eaa47..6fd81ac 100644 --- a/t/03podcoverage.t +++ b/t/03podcoverage.t @@ -125,6 +125,7 @@ my $exceptions = { 'DBIx::Class::Storage::DBI::Pg' => { skip => 1 }, 'DBIx::Class::Storage::DBI::SQLite' => { skip => 1 }, 'DBIx::Class::Storage::DBI::mysql' => { skip => 1 }, + 'DBIx::Class::Storage::DBI::AutoCast' => { skip => 1 }, 'DBIx::Class::SQLAHacks' => { skip => 1 }, 'DBIx::Class::SQLAHacks::MySQL' => { skip => 1 }, 'DBIx::Class::SQLAHacks::MSSQL' => { skip => 1 }, diff --git a/t/storage/base.t b/t/storage/base.t index c8a0bba..c0bde46 100644 --- a/t/storage/base.t +++ b/t/storage/base.t @@ -1,7 +1,8 @@ use strict; -use warnings; +use warnings; use Test::More; +use Test::Warn; use lib qw(t/lib); use DBICTest; use Data::Dumper; @@ -33,8 +34,6 @@ use Data::Dumper; } } -plan tests => 17; - my $schema = DBICTest->init_schema( sqlite_use_file => 1 ); is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite', @@ -145,6 +144,19 @@ my $invocations = { }, ], }, + 'connect_info ([ \%attr_with_coderef ])' => { + args => [ { + dbh_maker => $coderef, + dsn => 'blah', + user => 'bleh', + on_connect_do => [qw/a b c/], + on_disconnect_do => [qw/d e f/], + } ], + dbi_connect_info => [ + $coderef + ], + warn => qr/Attribute\(s\) 'dsn', 'user' in connect_info were ignored/, + }, }; for my $type (keys %$invocations) { @@ -154,11 +166,14 @@ for my $type (keys %$invocations) { local $Data::Dumper::Sortkeys = 1; my $arg_dump = Dumper ($invocations->{$type}{args}); - $storage->connect_info ($invocations->{$type}{args}); + warnings_exist ( + sub { $storage->connect_info ($invocations->{$type}{args}) }, + $invocations->{$type}{warn} || (), + 'Warned about ignored attributes', + ); is ($arg_dump, Dumper ($invocations->{$type}{args}), "$type didn't modify passed arguments"); - is_deeply ($storage->_dbi_connect_info, $invocations->{$type}{dbi_connect_info}, "$type produced correct _dbi_connect_info"); ok ( (not $storage->auto_savepoint and not $storage->unsafe), "$type correctly ignored extra hashref"); @@ -169,4 +184,6 @@ for my $type (keys %$invocations) { ); } +done_testing; + 1;