t/rdbo_relationship_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 Support::TestSetup;
  11 use File::Slurp;
  12 use IO::Dir;
  13
  14 my %dir;
  15 tie %dir, 'IO::Dir', 'SL/DB';
  16 my @pms = grep { m/\.pm$/ } keys %dir;
  17
  18 foreach my $pm (sort @pms) {
  19   my $content = read_file("SL/DB/${pm}");
  20   next unless $content =~ m/__PACKAGE__->meta->add_relationships?\((.+?)\);/s;
  21   my $code = $1;
  22
  23   my @not_existing;
  24   while ($code =~ m/\b(?:map_)?class\s*=>\s*['"]SL::DB::(.+?)['"]/g) {
  25     push @not_existing, $1 unless -f "SL/DB/${1}.pm";
  26   }
  27
  28   if (@not_existing) {
  29     fail("$pm: Non-existing relationship model(s) " . join(' ', @not_existing));
  30   } else {
  31     pass("$pm: all relationship model(s) exist");
  32   }
  33 }
  34
  35 # print Dumper(\@pms);
  36
  37
  38 done_testing();