- added xtra tests

xt/cleannamespaces.t

+use strict;
+use warnings;
+use Test::More;
+plan skip_all => "Test::CleanNamespaces required for testing module namespaces"
+    unless eval "use Test::CleanNamespaces; 1";
+my @modules = Test::CleanNamespaces->find_modules;
+namespaces_clean( @modules );
+done_testing;
+1;
\ No newline at end of file

xt/compile.t

+use strict;
+use warnings;
+use Test::More;
+use Perl::Version;
+my $required_module_version = '2.3.1';
+
+
+plan skip_all => "Test::Compile required for testing file compileabilty"
+     unless eval "use Test::Compile; 1";
+plan skip_all => "Test::Compile version $required_module_version required because fixed prove compatibility"
+    unless (Perl::Version->new($Test::Compile::VERSION) >= Perl::Version->new($required_module_version));
+
+my $test = Test::Compile->new();
+$test->verbose => undef;
+
+
+my @modules = $test->all_pm_files("lib");
+my @binaries = $test->all_pl_files("bin", "example_scripts");
+
+my $tests = scalar(@modules) + scalar(@binaries);
+plan tests => $tests;
+foreach my $file (@modules) {
+    ok($test->pm_file_compiles($file), "checking file $file");
+}
+foreach my $file (@binaries) {
+    ok($test->pl_file_compiles($file), "checking file $file");
+}
+
+1;
\ No newline at end of file

xt/eol.t

+use strict;
+use warnings;
+use Test::More;
+use Path::Tiny;
+plan skip_all => "Test::EOL required for testing filenames portability"
+    unless eval "use Test::EOL; 1";
+my @whitelist_dirs = path('.')->children( qr/^(?!(cpan_build$|build$|.git$))/ );
+all_perl_files_ok( @whitelist_dirs );
\ No newline at end of file

xt/fixme.t

+use strict;
+use warnings;
+use Test::More;
+BEGIN {
+    plan skip_all => "these tests are for release candidate testing\n(enable it with RELEASE_TESTING=1)"
+        unless $ENV{RELEASE_TESTING};
+}
+plan skip_all => "Test::Fixme required for testing unresolved FIXME or TODO issues"
+    unless eval "use Test::Fixme; 1";
+run_tests(
+    where          => 'lib',
+    match          => qr/# *(TODO|FIXME|BUG)\b/i,
+    filename_match => qr/\.(pm|pl)$/
+);
+1;
\ No newline at end of file

xt/no_nested_exists.t

+#search all modules as file paths
+use strict;
+use warnings;
+use File::Find;
+use Path::Tiny;
+use Test::More;
+
+my @modules;
+sub wanted {
+    $File::Find::name =~ m#SLUB/LZA/.+\.pm$# && -f $_ && push @modules, $File::Find::name;
+}
+find(\&wanted, "lib/");
+
+# allowed:    exists $foo->{$bar}
+# allowed:    exists $foo->{$bar} and exists $foo->{$bar}->{$baz}
+# forbidden:  exists $foo->{$bar}->{$baz}
+#my $rx_exists=qr{(?!(&&|and) *)(?<=exists)};
+#my $rx_hash_or_hashref=qr/(\$[a-z_]+)((->)?{[^}]*})((->)?{[^}]*})/;
+#my $regex_match=qr/$rx_exists $rx_hash_or_hashref/;
+use diagnostics;
+foreach my $module (@modules) {
+    my @lines = path($module)->lines;
+    my $errors = 0;
+    for (my $i=0; $i<=$#lines; $i++) {
+        next unless $lines[$i]=~m/exists/;
+        my $reversed_line = reverse scalar $lines[$i];
+        # aus  "exists $foo->{bar}->{baz}"
+        # wird "}zab{>-}rab{>-oof$ stsixe"
+        # aus  "exists $foo->{bar} and exists $foo->{bar}->{baz}"
+        # wird "}zab{>-}rab{>-oof$ stsixe dna }rab{>-oof$ stsixe"
+        # damit haben wir mit Trenner ' dna ' folgende Teilstrings:
+        # "}zab{>-}rab{>-oof$ stsixe" und
+        #        "}rab{>-oof$ stsixe"
+        # Damit können wir nach Teilstrings suchen
+        # my $ref = qr/\}[^{]*{/;
+        # m/($ref>-)($ref>-){1,}[a-z]*\$/ würde auf den Hashref matchen, in $1 hätten wir Treffer für n-ten Hashref-teil, in $2 Treffer für Rest
+        # was wir fordern, ist, dass lookahead der Rest mit ' dna ' verbunden ist:
+        # m/($ref>-)($ref>-){1,}([a-z]*\$)(?= dna $2$3)/g
+        my $rx_ref = qr/\}[^{]*{/;
+        no warnings;
+        if ($reversed_line=~m/($rx_ref(?:>-)?)($rx_ref(?:>-)?){1,}([a-z]*\$ stsixe)(?! dna $2$3)/g) {
+            use warnings;
+            #print "line=$lines[$i]\n";
+            my $lineno = $i + 1;
+            $errors++;
+            my $match1 = reverse scalar $1;
+            my $match2 = reverse scalar $2;
+            my $match3 = reverse scalar $3;
+            fail("module $module uses 'exists' on nested hash or hashrefs, but this is dangerous,
+             because values will be generated, see 'perldoc -f exists' for details.
+             Here the problematic code:
+             ---------- snip ---------
+             $match3$match2$match1
+             ---------- snap ---------
+              (line $lineno)
+             better use pattern like this:
+             ---------- snip ---------
+             $match3$match2 and $match3$match2$match1
+             ---------- snap ---------
+
+");
+
+        }
+    }
+    if ($errors == 0) {
+        pass("module $module");
+    }
+}
+
+done_testing();
+1;

xt/no_use_v5xxx.t

+use strict;
+use warnings;
+use Test::More;
+use File::Find;
+use Path::Tiny;
+
+
+#search all modules as file paths
+my @modules;
+sub wanted {
+    $File::Find::name=~ m#SLUB/LZA/.+\.pm$# && -f $_ && push @modules, $File::Find::name;
+}
+find(\&wanted, "lib/");
+
+foreach my $module (@modules) {
+    my $content = path( $module )->slurp;
+    if ($content =~ m/^use v(5\.\d\d);/m) {
+        fail("module $module has 'use v$1;', you should use 'use feature qw(...);' instead.");
+    } else {
+        pass("module $module is fine.");
+    }
+}
+
+done_testing();
+1;

xt/nodiagnostics.t

+use strict;
+use warnings;
+use Test::More;
+use File::Find;
+use Path::Tiny;
+
+
+#search all modules as file paths
+my @modules;
+sub wanted {
+    $File::Find::name=~ m#SLUB/LZA/.+\.(pm|t)$# && -f $_ && push @modules, $File::Find::name;
+}
+find(\&wanted, "lib/", "t/");
+
+foreach my $module (@modules) {
+    my $content = path( $module )->slurp;
+    if ($content =~ m/^use diagnostics;/m) {
+        fail("module $module has 'use diagnostics;', but should only be used for debugging. It could be enabled via 'perl -Mdiagnostics=-traceonly my_script.pl'");
+    } else {
+        pass("module $module is fine.");
+    }
+}
+done_testing();
+1;

xt/portability.t

+use strict;
+use warnings;
+use Test::More;
+use Path::Tiny;
+
+plan skip_all => "Test::Portability::Files required for testing filenames portability"
+    unless eval "use Test::Portability::Files; 1";
+
+#options(all_tests => 1); # to be hyper-strict
+options(
+    #test_mac_length       => 1,
+    test_space            => 1,
+    test_symlink          => 1,
+    test_special_chars    => 1,
+    test_windows_reserved => 1,
+    test_case             => 1,
+);
+my $manifestfile;
+BEGIN{
+    # prepare, because we want to check only *.t an *.pm and *.pl files
+    use File::Find;
+    my $module_base_dir = path(__FILE__)->parent->parent;
+
+    my $lib_dir = $module_base_dir->child("lib");
+    my $t_dir = $module_base_dir->child("t");
+    $manifestfile = $module_base_dir->child("MANIFEST")->absolute();
+    if ($manifestfile->is_file) {
+        $manifestfile->remove();
+    }
+
+    sub wanted {
+        m/.*\.(p[ml]|t)$/ &&
+            -f _ &&
+            $manifestfile->append($File::Find::name) &&
+            $manifestfile->append("\n");
+    }
+    find(\&wanted, $lib_dir->stringify, $t_dir->stringify);
+
+}
+# tests
+run_tests();
+
+#clean up
+if ($manifestfile->is_file) {
+    $manifestfile->remove();
+
+}
+1;
\ No newline at end of file

xt/unused_subroutines.t

+use strict;
+use warnings;
+use Test::More;
+use File::Find;
+use Path::Tiny;
+use List::Util;
+
+BEGIN {
+    plan skip_all => "these tests are for release candidate testing\n(enable it with RELEASE_TESTING=1)"
+        unless $ENV{RELEASE_TESTING};
+}
+# only finds first depth of derived classes!
+
+#search all modules as file paths
+my @modules;
+my @binaries;
+
+# find all Perl-Module paths
+sub wantedpm {
+    $File::Find::name=~ m#SLUB/LZA/.+\.pm$# && -f $_ && push @modules, $File::Find::name;
+}
+
+# find all Perl-Script paths
+sub wantedpl {
+    $File::Find::name=~ m#\.pl$# && -f $_ && push @binaries, $File::Find::name;
+}
+
+sub _find_used_modules {
+    my $module_or_binary = shift;
+    my @content = path( $module_or_binary )->lines({chomp=>1});
+    my @used_modules;
+    foreach my $line (@content) {
+        if ( $line =~ m/use ([A-Za-z0-9:]+)\b/ ) {
+            push @used_modules, $1;
+        } elsif ($line =~ m/with ['"]([A-Za-z0-9:]+)["'];/) {
+            push @used_modules, $1;
+        }
+    }
+    my $contents = join("", @content);
+    if ($contents =~ m/with qw\s*[(]([A-Za-z0-9: ]+)[)];/m) {
+        my @found_modules = grep {length($_) > 1} split(/ +/, $1);
+        push @used_modules, @found_modules;
+    }
+    return @used_modules;
+}
+
+# maps Module-Paths to Module-namespace
+sub modulepath_to_moduleuse { # maps lib/Foo/Bar/Baz.pm to Foo::Bar::Baz
+    my $module_path = shift;
+    my $module = $module_path;
+    $module =~ s#lib/##;
+    $module =~ s#\.pm$##;
+    $module =~ s#/#::#g;
+    return $module;
+}
+
+# find all subs which are exported by a Module-path
+sub get_exported_subs {
+    my $module_path = shift;
+    my $module = modulepath_to_moduleuse($module_path);
+    my $code_string = "use $module; return grep {defined &{\"${module}::\$_\"} } keys \%${module}::;";
+    no strict 'refs';
+    my @modules = eval "\@${module}::EXPORT;";
+    my @exported = grep {$_=~m/^[a-z_]/} eval $code_string;
+    use strict 'refs';
+    if (scalar @exported == 0) {
+        return @exported
+    };
+    return @modules;
+}
+
+find(\&wantedpm, "lib/");
+find(\&wantedpl, "bin");
+
+
+my %subs;
+# MODULE -> delivers METHOD -> USED BY -> with COUNT
+my %required; # special case for moose roles
+# ROLE -> sub -> count
+my %has_exported; # to check if module has used Export.pm
+
+# first find all subs
+# read each module and search for a sub definition, build hash %subs
+foreach my $module (@modules) {
+    if (List::Util::any {m/use Exporter/} path( $module )->lines({chomp=>1}) ) {
+        $has_exported{ $module } = 1;
+    }
+    my @content = grep {/^\s*sub\s+/} path( $module )->lines({chomp=>1});
+    foreach my $line (@content) {
+        if ($line=~ m/^\s*sub\s+([_A-Za-z0-9:]+)/) {
+            my $sub = $1;
+            if (defined $sub && length $sub > 1) {
+                my $use = modulepath_to_moduleuse($module);
+                $subs{$use}{$sub}=undef;
+            }
+        }
+    }
+}
+
+# find required (Moose)
+foreach my $module (@modules) {
+    my $content = path( $module )->slurp;
+    if (
+        ($content=~m/use Moose/) &&
+            ($content=~m#requires\s*\(([^\)]*)\)#mx)
+             ) {
+        my $requires = $1;
+        #p($requires);
+        my @subs = split /,/, $requires;
+        @subs = grep {defined $_ && length $_ > 0} map {
+            s/\s*//g;
+            s/'//g;
+            $_;
+        } @subs;
+        foreach my $require (@subs) {
+            $required{modulepath_to_moduleuse($module)}{$require}++;
+        }
+    }
+}
+# second find which modules are used
+foreach my $module_or_binary (@modules, @binaries) {
+    # find all used modules
+    my @used_modules = _find_used_modules( $module_or_binary);
+    push @used_modules, modulepath_to_moduleuse($module_or_binary); # check itself
+    my @content = path( $module_or_binary )->lines({chomp=>1});
+    foreach my $line (@content) {
+        foreach my $um (@used_modules) {
+            foreach my $sub (keys %{$subs{$um}}) {
+                if ($line =~ m/$sub/) {
+#                    print STDERR "um=$um, sub=$sub, module=$module_or_binary line=$line\n";
+                    $subs{$um}{$sub}{$module_or_binary}++; # add self used
+                }
+            }
+        }
+    }
+}
+# check also if parent obj class uses required
+foreach my $module_or_binary (@modules) {
+    # find all used modules
+    my @used_modules = _find_used_modules($module_or_binary);
+    foreach my $parent (@used_modules) {
+        next unless exists $required{ $parent};
+        foreach my $sub (keys %{$required{$parent}}) {
+            #warn "found parent class $parent of $module_or_binary with sub $sub\n";
+            if ($sub =~ m/^_build/) {
+                # workaround, build methods only visibly used in parent
+            }
+            $subs{modulepath_to_moduleuse($module_or_binary)}{$sub}{$module_or_binary}++;
+        }
+    }
+}
+# now print unused modules
+foreach my $module (sort @modules) {
+    my $use = modulepath_to_moduleuse($module);
+    if ($use =~ m/SLUB::LZA::Rosetta::API$/) {
+        pass "module '$module', because 1:1 API mapping";
+        next;
+    }
+    my $res=1;
+    my @exported_subs = get_exported_subs( $module);
+    my $is_exported = exists $has_exported{ $module };
+    foreach my $sub (sort keys %{$subs{$use}}) {
+        if ($sub =~ m/DEMOLISH/) { next;} # perlish subroutines
+        if ($sub =~ m/BUILD/) { next;} # moose-ish subroutines
+        if ($sub =~ m/get_dotgraph/) {next;} # needed for doc/, make fsm.svg to control FSM in Eventcallback
+        my $all_used = 0;
+        # reduce all exported matches
+        foreach my $where_used_path (sort keys %{ $subs{$use}{$sub} }) {
+            my $where_used = modulepath_to_moduleuse($where_used_path);
+            if ($where_used  eq $use) {
+                $all_used--; # reduce by one because self-match 'sub foo…'
+                my $test_if_exported = $is_exported && (List::Util::any {$_ eq $sub} @exported_subs);
+                if ($test_if_exported) {
+                    $all_used--;
+                } # reduce by one because exported via Exporter-module
+            }
+            $all_used+= $subs{$use}{$sub}{$where_used_path};
+        }
+        if ($all_used <1) {
+            $res = undef;
+            fail "module '$module', subroutine '$sub' unused or module not imported via 'use $use;'";
+            #print "-------------------\n";
+            #use Data::Printer; p( $subs{$use}{$sub} );
+            #print "module '$module' has exported: ", ($is_exported?"yes":"no"), "\n";
+            #print "module '$module' has ff. functions (outside callable): \n\t", join("\n\t", @exported_subs), "\n";
+
+        }
+    }    if ($res) {
+        pass "module '$module', all subroutines used";
+    }
+}
+done_testing();
+1;