From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sun, 30 Aug 2009 06:51:14 +0000 (+0000)
Subject: Minor cleanup and test enhancement
X-Git-Tag: v0.08111~47^2~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6b5e61afda80696f56615aa1b66e6f65539c5be0;p=dbsrgits%2FDBIx-Class.git

Minor cleanup and test enhancement
---

diff --git a/Makefile.PL b/Makefile.PL
index 21c53cd..18261f5 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 abb2533..6026cd4 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<Catalyst> based applications, allowing the
 following config (L<Config::General> style):
 
@@ -126,7 +132,8 @@ following config (L<Config::General> style):
   </Model::DB>
 
 The C<dsn>/C<user>/C<password> combination can be substituted by the
-C<dbh_maker> key whose value is a coderef that returns the C<$dbh>.
+C<dbh_maker> key whose value is a coderef that returns a connected
+L<DBI database handle|DBI/connect>
 
 =back
 
@@ -418,9 +425,15 @@ sub connect_info {
     @args = ();
     if (my $code = delete $attrs{dbh_maker}) {
       @args = $code;
-      if (delete @attrs{qw/dsn user password/}) {
-        warn 'dsn/user/password ignored when dbh_maker coderef used in ' .
-             'connect_info';
+
+      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 {
diff --git a/t/storage/base.t b/t/storage/base.t
index 138465d..2a4dd6a 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 => 21;
-
 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
 
 is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite',
@@ -148,12 +147,15 @@ 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/,
   },
 };
 
@@ -164,10 +166,15 @@ for my $type (keys %$invocations) {
   local $Data::Dumper::Sortkeys = 1;
   my $arg_dump = Dumper ($invocations->{$type}{args});
 
-  $storage->connect_info ($invocations->{$type}{args});
+  my $do = sub {  };
 
-  is ($arg_dump, Dumper ($invocations->{$type}{args}), "$type didn't modify passed arguments");
+  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");
@@ -179,4 +186,6 @@ for my $type (keys %$invocations) {
   );
 }
 
+done_testing;
+
 1;