From 9443fef35c0b8627d3690526de7df7eb49ff1ca0 Mon Sep 17 00:00:00 2001
From: Moritz Bunkus <m.bunkus@linet-services.de>
Date: Wed, 3 Jul 2013 11:18:30 +0200
Subject: [PATCH] =?utf8?q?Test=20f=C3=BCr=20Konsistenz=20SL/DB/*.pm=20<=3D?=
 =?utf8?q?>=20SL/DB/MetaSetup/*.pm=20sowie=20die=20Helfer=20ALL=20und=20Ma?=
 =?utf8?q?ppings?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

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

diff --git a/t/rdbo_consistency.t b/t/rdbo_consistency.t
new file mode 100644
index 000000000..7b5cedb3e
--- /dev/null
+++ b/t/rdbo_consistency.t
@@ -0,0 +1,86 @@
+use Test::More;
+use Test::Exception;
+
+use strict;
+
+use lib 't';
+use utf8;
+
+use Data::Dumper;
+use File::Basename;
+use File::Slurp;
+use IO::Dir;
+use SL::Util qw(snakify);
+
+sub find_pms {
+  my %dir;
+  tie %dir, 'IO::Dir', $_[0];
+  return sort grep { m/\.pm$/ } keys %dir;
+}
+
+my %no_db_ok          = map { ($_ => 1) } qw();
+my %no_metasetup_ok   = map { ($_ => 1) } qw(Object.pm VC.pm);
+my @dbs               = find_pms('SL/DB');
+my @metasetups        = find_pms('SL/DB/MetaSetup');
+my %metasetup_content = map { ($_ => scalar(read_file("SL/DB/MetaSetup/$_"))) } @metasetups;
+my $all_content       = read_file('SL/DB/Helper/ALL.pm');
+my $mapping_content   = read_file('SL/DB/Helper/Mappings.pm');
+
+sub test_db_has_metasetup {
+  foreach my $pm (@metasetups) {
+    my $base = basename($pm);
+    is(-f "SL/DB/MetaSetup/${base}" ? 1 : 0, $no_metasetup_ok{$base} ? 0 : 1, "$pm has entry in SL/DB/MetaSetup");
+  }
+}
+
+sub test_metasetup_has_db {
+  foreach my $pm (@metasetups) {
+    my $base = basename($pm);
+    is(-f "SL/DB/${base}" ? 1 : 0, $no_db_ok{$base} ? 0 : 1, "$pm has entry in SL/DB");
+  }
+}
+
+sub test_db_included_in_all {
+  foreach my $pm (@dbs) {
+    my $base = basename($pm, '.pm');
+    ok($all_content =~ m/\nuse\s+SL::DB::${base};/, "$pm has entry in SL::DB::Helper::ALL");
+  }
+}
+
+sub test_use_in_all_exists_as_db {
+  foreach my $package (map { m/^use\s+(.+?);/; $1 } grep { '^use SL::DB::' } split m/\n/, $all_content) {
+    next unless $package =~ m/^SL::DB::(.+)/;
+    my $file = $1;
+    $file    =~ s{::}{/}g;
+    ok(-f "SL/DB/${file}.pm", "'use $package' has entry in SL/DB");
+  }
+}
+
+sub test_metasetup_has_table_to_class_mapping {
+  my ($package_name_mapping) = $mapping_content =~ m/my\s*\%kivitendo_package_names\s*=\s*\((.+?)\n\)/s;
+  ok($package_name_mapping, "found kivitendo_package_names in SL/DB/Helper/Mappings.pm");
+  return unless $package_name_mapping;
+
+  foreach my $pm (@metasetups) {
+    my ($table) = $metasetup_content{$pm} =~ m{\n__PACKAGE__->meta->table\('(.+?)'\)};
+    ok($table, "$pm has table setup");
+    next unless $table;
+
+    my ($schema) = $metasetup_content{$pm} =~ m{\n__PACKAGE__->meta->schema\('(.*?)'\)};
+    $table       = "${schema}.${table}" if $schema;
+    ok(!$schema || ($schema =~ m{^(?:auth|tax)$}), "$pm has either no schema or a known one");
+
+    my $model               = basename($pm, '.pm');
+    my $snaked_model        = snakify($model);
+    my $maps_table_to_class = $package_name_mapping =~ m{\b'?\Q${table}\E'?\s*=>\s*\'(?:${snaked_model}|${model})\'};
+    ok($maps_table_to_class, "$pm has mapping from table ${table} to class ${snaked_model} or ${model} in \%kivitendo_package_names");
+  }
+}
+
+test_db_has_metasetup();
+test_metasetup_has_db();
+test_db_included_in_all();
+test_use_in_all_exists_as_db();
+test_metasetup_has_table_to_class_mapping();
+
+done_testing();
-- 
2.20.1