From: Moritz Bunkus <m.bunkus@linet-services.de>
Date: Thu, 6 Jun 2013 13:52:12 +0000 (+0200)
Subject: Test-Script für Relationship-Klassennamen
X-Git-Tag: release-3.1.0beta1~331^2~52
X-Git-Url: http://wagnertech.de/git?a=commitdiff_plain;h=39386e98b22b1f8a4a92e9ccf2469a3e9dfa0e7e;p=kivitendo-erp.git

Test-Script für Relationship-Klassennamen
---

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();