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;
