From 39386e98b22b1f8a4a92e9ccf2469a3e9dfa0e7e Mon Sep 17 00:00:00 2001
From: Moritz Bunkus <m.bunkus@linet-services.de>
Date: Thu, 6 Jun 2013 15:52:12 +0200
Subject: [PATCH] =?utf8?q?Test-Script=20f=C3=BCr=20Relationship-Klassennam?=
 =?utf8?q?en?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

---
 t/rdbo_relationship_consistency.t | 38 +++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)
 create mode 100644 t/rdbo_relationship_consistency.t

diff --git a/t/rdbo_relationship_consistency.t b/t/rdbo_relationship_consistency.t
new file mode 100644
index 000000000..db35e809e
--- /dev/null
+++ b/t/rdbo_relationship_consistency.t
@@ -0,0 +1,38 @@
+use Test::More;
+use Test::Exception;
+
+use strict;
+
+use lib 't';
+use utf8;
+
+use Data::Dumper;
+use Support::TestSetup;
+use File::Slurp;
+use IO::Dir;
+
+my %dir;
+tie %dir, 'IO::Dir', 'SL/DB';
+my @pms = grep { m/\.pm$/ } keys %dir;
+
+foreach my $pm (sort @pms) {
+  my $content = read_file("SL/DB/${pm}");
+  next unless $content =~ m/__PACKAGE__->meta->add_relationships?\((.+?)\);/s;
+  my $code = $1;
+
+  my @not_existing;
+  while ($code =~ m/\b(?:map_)?class\s*=>\s*['"]SL::DB::(.+?)['"]/g) {
+    push @not_existing, $1 unless -f "SL/DB/${1}.pm";
+  }
+
+  if (@not_existing) {
+    fail("$pm: Non-existing relationship model(s) " . join(' ', @not_existing));
+  } else {
+    pass("$pm: all relationship model(s) exist");
+  }
+}
+
+# print Dumper(\@pms);
+
+
+done_testing();
-- 
2.20.1