t/structure/instance_conf_method_names.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use lib 't';
   5 use File::Find;
   6 use File::Slurp;
   7 use Test::More;
   8
   9 my %default_columns;
  10 my %compatibility_functions = map { ($_ => 1) } qw(address);
  11
  12 sub read_default_columns {
  13   my $content   =  read_file('SL/DB/MetaSetup/Default.pm');
  14   my ($columns) =  $content =~ m{\n__PACKAGE__->meta->columns\((.+?)\n\)}s;
  15   $columns      =~ s/=>.*?\},|\n//g;
  16   $columns      =~ s/ +/ /g;
  17   $columns      =~ s/^\s+|\s+$//g;
  18
  19   return map { ($_ => 1) } split m/ +/, $columns;
  20 }
  21
  22 sub test_file_content {
  23   my ($file)  = @_;
  24   my $content = read_file($file);
  25
  26   while ($content =~ m{(?:INSTANCE_CONF\.|\$(?:main)?::instance_conf->)get_([a-z0-9_]+)}gi) {
  27     ok($default_columns{$1} || $compatibility_functions{$1}, "'get_${1}' is a valid method call on \$::instance_conf in $file");
  28   }
  29 }
  30
  31 %default_columns = read_default_columns();
  32 my @files        = glob('*.pl');
  33 find(sub { push(@files, $File::Find::name) if $_ =~ /\.pm$/;   }, 'SL');
  34 find(sub { push(@files, $File::Find::name) if $_ =~ /\.pl$/;   },  qw(bin/mozilla sql/Pg-upgrade2 scripts));
  35 find(sub { push(@files, $File::Find::name) if $_ =~ /\.html$/; }, 'templates/webpages');
  36
  37 test_file_content($_) for @files;
  38
  39 done_testing();