Tests: Test-Case für gültige Methodennamen auf $::instance_conf
authorMoritz Bunkus <m.bunkus@linet-services.de>
Fri, 5 Jul 2013 12:54:51 +0000 (14:54 +0200)
committerMoritz Bunkus <m.bunkus@linet-services.de>
Fri, 5 Jul 2013 12:54:51 +0000 (14:54 +0200)
t/structure/instance_conf_method_names.t [new file with mode: 0755]

diff --git a/t/structure/instance_conf_method_names.t b/t/structure/instance_conf_method_names.t
new file mode 100755 (executable)
index 0000000..e442fa6
--- /dev/null
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+
+use strict;
+use lib 't';
+use File::Find;
+use File::Slurp;
+use Test::More;
+
+my %default_columns;
+
+sub read_default_columns {
+  my $content   =  read_file('SL/DB/MetaSetup/Default.pm');
+  my ($columns) =  $content =~ m{\n__PACKAGE__->meta->columns\((.+?)\n\)}s;
+  $columns      =~ s/=>.*?\},|\n//g;
+  $columns      =~ s/ +/ /g;
+  $columns      =~ s/^\s+|\s+$//g;
+
+  return map { ($_ => 1) } split m/ +/, $columns;
+}
+
+sub test_file_content {
+  my ($file)  = @_;
+  my $content = read_file($file);
+
+  while ($content =~ m{(?:INSTANCE_CONF\.|\$(?:main)?::instance_conf->)get_([a-z0-9_]+)}gi) {
+    ok($default_columns{$1}, "'get_${1}' is a valid method call on \$::instance_conf in $file");
+  }
+}
+
+%default_columns = read_default_columns();
+my @files        = glob('*.pl');
+find(sub { push(@files, $File::Find::name) if $_ =~ /\.pm$/;   }, 'SL');
+find(sub { push(@files, $File::Find::name) if $_ =~ /\.pl$/;   },  qw(bin/mozilla sql/Pg-upgrade2 scripts));
+find(sub { push(@files, $File::Find::name) if $_ =~ /\.html$/; }, 'templates/webpages');
+
+test_file_content($_) for @files;
+
+done_testing();