From: Jess Robinson <castaway@desert-island.me.uk>
Date: Tue, 12 Aug 2008 13:14:10 +0000 (+0000)
Subject: Add saner warning when non-source classes encountered in schema subdir by load_classes.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=89271e5650822407f65f7bda524b31ac042b5fa1;p=dbsrgits%2FDBIx-Class-Historic.git

Add saner warning when non-source classes encountered in schema subdir by load_classes.
Also skip the broken ones.
---

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 3e9d93e..cd1306a 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -328,8 +328,13 @@ sub load_classes {
         }
         $class->ensure_class_loaded($comp_class);
 
-        $comp = $comp_class->source_name || $comp;
-#  $DB::single = 1;
+        my $snsub = $comp_class->can('source_name');
+        if(! $snsub ) {
+          warn "Failed to load $comp_class. Can't find source_name method. Is $comp_class really a full DBIC result class? Fix it, move it elsewhere, or make your load_classes call more specific.";
+          next;
+        }
+        $comp = $snsub->($comp_class) || $comp;
+
         push(@to_register, [ $comp, $comp_class ]);
       }
     }
diff --git a/t/102load_classes.t b/t/102load_classes.t
new file mode 100644
index 0000000..e7e82f4
--- /dev/null
+++ b/t/102load_classes.t
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+unshift(@INC, './t/lib');
+
+plan tests => 4;
+
+my $warnings;
+eval {
+    local $SIG{__WARN__} = sub { $warnings .= shift };
+    package DBICTest::Schema;
+    use base qw/DBIx::Class::Schema/;
+    __PACKAGE__->load_classes;
+};
+ok(!$@, 'Loaded all loadable classes') or diag $@;
+like($warnings, qr/Failed to load DBICTest::Schema::NoSuchClass. Can't find source_name method. Is DBICTest::Schema::NoSuchClass really a full DBIC result class?/, 'Warned about broken result class');
+
+my $source_a = DBICTest::Schema->source('Artist');
+isa_ok($source_a, 'DBIx::Class::ResultSource::Table');
+my $rset_a   = DBICTest::Schema->resultset('Artist');
+isa_ok($rset_a, 'DBIx::Class::ResultSet');
+
diff --git a/t/lib/DBICTest/Schema/NoSuchClass.pm b/t/lib/DBICTest/Schema/NoSuchClass.pm
new file mode 100644
index 0000000..2730b3a
--- /dev/null
+++ b/t/lib/DBICTest/Schema/NoSuchClass.pm
@@ -0,0 +1,6 @@
+package DBICTest::Schema::NoSuchClass;
+
+## This is purposefully not a real DBIC class
+## Used in t/102load_classes.t
+
+1;