From: Roman F <romanf@cpan.org>
Date: Mon, 13 Jun 2011 14:41:30 +0000 (-0400)
Subject: Now warns instead of dying when accessor name matches existing method name
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=77c7c7a80470ad453f8d144026ec338f2c31e28a;p=dbsrgits%2FDBIx-Class-Schema-ResultSetAccessors.git

Now warns instead of dying when accessor name matches existing method name
---

diff --git a/Changes b/Changes
index 171e2aa..07fda90 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,8 @@
 Revision history for Perl module DBIx::Class::Schema::ResultSetAccessors
 
+0.03 Mon Jun 13
+    - Now instead of throwing an error and dying when a resultset accessor with the same name exists
+      it simply warns the user.
+
 0.01 Wed Jun  8 10:28:25 2011
     - original skeleton created with ExtUtils::ModuleMaker::TT
diff --git a/Makefile.PL b/Makefile.PL
index f119ae6..f475309 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -11,7 +11,7 @@ requires 'Lingua::EN::Inflect::Phrase' => 0;
 requires 'Sub::Name' => 0;
 
 test_requires 'Test::More' => '0.94';
-test_requires 'Test::Exception';
+test_requires 'Test::Warn';
 
 if ($Module::Install::AUTHOR) {
     system("pod2text lib/DBIx/Class/Schema/ResultSetAccessors.pm > README");
diff --git a/lib/DBIx/Class/Schema/ResultSetAccessors.pm b/lib/DBIx/Class/Schema/ResultSetAccessors.pm
index 639fb68..fb7dfa4 100644
--- a/lib/DBIx/Class/Schema/ResultSetAccessors.pm
+++ b/lib/DBIx/Class/Schema/ResultSetAccessors.pm
@@ -3,11 +3,12 @@ package DBIx::Class::Schema::ResultSetAccessors;
 use strict;
 use warnings;
 
+use DBIx::Class::Carp qw(carp);
 use String::CamelCase;
 use Lingua::EN::Inflect::Phrase;
 use Sub::Name 'subname';
 
-our $VERSION = 0.001002;
+our $VERSION = 0.001003;
 
 sub register_source {
     my $self    = shift;
@@ -21,7 +22,7 @@ sub register_source {
              : $self->resultset_accessor_name($moniker);
 
     if ($schema->can($accessor_name)) {
-        $self->throw_exception(
+        carp(
             "Can't create ResultSet accessor '$accessor_name'. " .
             "Schema method with the same name already exists. " .
             "Try overloading the name via resultset_accessor_map."
diff --git a/t/basic.t b/t/basic.t
index 268e549..a755891 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -6,7 +6,7 @@ use warnings;
 use lib qw(t/lib);
 
 use Test::More;
-use Test::Exception;
+use Test::Warn;
 
 BEGIN {
     use_ok('MyApp1::Schema');
@@ -24,12 +24,22 @@ isa_ok $schema1->cds, 'MyApp1::Schema::ResultSet::CD'; # custom ResultSet
 can_ok $schema1, qw/source_resultset/;
 isa_ok $schema1->source_resultset, 'DBIx::Class::ResultSet';
 
-throws_ok {
+# test the warnings
+warning_like { warn_same_name() } qr/Schema method with the same name already exists/,
+    'Schema method with the same name already exists';
+
+sub warn_same_name {
     # must use required, because for some reason throws_ok cannot catch
     # erros with "use"
     require MyApp2::Schema;
-    MyApp2::Schema->connect('dbi:SQLite:dbname=:memory:', '', '');
-} qr/Schema method with the same name already exists/,
-    'Schema method with the same name already exists';
+    
+    # eval'ing this, otherwise an odd error is thrown
+    # "Can't call method "_count_select" on an undefined value"
+    # I presume it's due to the store not having the actual schema installed
+    # as we are connecting to an empty database
+    eval {
+        my $schema = MyApp2::Schema->connect('dbi:SQLite:dbname=:memory:', '', '');
+    };
+}
 
 done_testing;