t/rdbo_consistency.t

   1 use Test::More;
   2 use Test::Exception;
   3
   4 use strict;
   5
   6 use lib 't';
   7 use utf8;
   8
   9 use Data::Dumper;
  10 use File::Basename;
  11 use File::Slurp;
  12 use IO::Dir;
  13 use SL::Util qw(snakify);
  14
  15 sub find_pms {
  16   my %dir;
  17   tie %dir, 'IO::Dir', $_[0];
  18   return sort grep { m/\.pm$/ } keys %dir;
  19 }
  20
  21 my %no_db_ok          = map { ($_ => 1) } qw();
  22 my %no_metasetup_ok   = map { ($_ => 1) } qw(Object.pm VC.pm);
  23 my @dbs               = find_pms('SL/DB');
  24 my @metasetups        = find_pms('SL/DB/MetaSetup');
  25 my %metasetup_content = map { ($_ => scalar(read_file("SL/DB/MetaSetup/$_"))) } @metasetups;
  26 my %db_content        = map { ($_ => scalar(read_file("SL/DB/$_")))           } @dbs;
  27 my $all_content       = read_file('SL/DB/Helper/ALL.pm');
  28 my $mapping_content   = read_file('SL/DB/Helper/Mappings.pm');
  29
  30 sub test_db_has_metasetup {
  31   foreach my $pm (@metasetups) {
  32     my $base = basename($pm);
  33     is(-f "SL/DB/MetaSetup/${base}" ? 1 : 0, $no_metasetup_ok{$base} ? 0 : 1, "$pm has entry in SL/DB/MetaSetup");
  34   }
  35 }
  36
  37 sub test_metasetup_has_db {
  38   foreach my $pm (@metasetups) {
  39     my $base = basename($pm);
  40     is(-f "SL/DB/${base}" ? 1 : 0, $no_db_ok{$base} ? 0 : 1, "$pm has entry in SL/DB");
  41   }
  42 }
  43
  44 sub test_db_included_in_all {
  45   foreach my $pm (@dbs) {
  46     my $base = basename($pm, '.pm');
  47     ok($all_content =~ m/\nuse\s+SL::DB::${base};/, "$pm has entry in SL::DB::Helper::ALL");
  48   }
  49 }
  50
  51 sub test_use_in_all_exists_as_db {
  52   foreach my $package (map { m/^use\s+(.+?);/; $1 } grep { '^use SL::DB::' } split m/\n/, $all_content) {
  53     next unless $package;
  54     next unless $package =~ m/^SL::DB::(.+)/;
  55     my $file = $1;
  56     $file    =~ s{::}{/}g;
  57     ok(-f "SL/DB/${file}.pm", "'use $package' has entry in SL/DB");
  58   }
  59 }
  60
  61 sub test_metasetup_has_table_to_class_mapping {
  62   my ($package_name_mapping) = $mapping_content =~ m/my\s*\%kivitendo_package_names\s*=\s*\((.+?)\n\)/s;
  63   ok($package_name_mapping, "found kivitendo_package_names in SL/DB/Helper/Mappings.pm");
  64   return unless $package_name_mapping;
  65
  66   foreach my $pm (@metasetups) {
  67     my ($table) = $metasetup_content{$pm} =~ m{\n__PACKAGE__->meta->table\('(.+?)'\)};
  68     ok($table, "$pm has table setup");
  69     next unless $table;
  70
  71     my ($schema) = $metasetup_content{$pm} =~ m{\n__PACKAGE__->meta->schema\('(.*?)'\)};
  72     $table       = "${schema}.${table}" if $schema;
  73     ok(!$schema || ($schema =~ m{^(?:auth|tax)$}), "$pm has either no schema or a known one");
  74
  75     my $model               = basename($pm, '.pm');
  76     my $snaked_model        = snakify($model);
  77     my $maps_table_to_class = $package_name_mapping =~ m{\b'?\Q${table}\E'?\s*=>\s*\'(?:${snaked_model}|${model})\'};
  78     ok($maps_table_to_class, "$pm has mapping from table ${table} to class ${snaked_model} or ${model} in \%kivitendo_package_names");
  79   }
  80 }
  81
  82 sub test_db_contains_meta_initialize {
  83   foreach my $pm (grep { !m{^(?:Object|VC)\.pm$} } @dbs) {
  84     ok($db_content{$pm} =~ m/\n__PACKAGE__->meta->initialize;/, "$pm contains __PACKAGE__->meta->initialize;");
  85   }
  86 }
  87
  88 test_db_has_metasetup();
  89 test_metasetup_has_db();
  90 test_db_included_in_all();
  91 test_use_in_all_exists_as_db();
  92 test_metasetup_has_table_to_class_mapping();
  93 test_db_contains_meta_initialize();
  94
  95 done_testing();