#!/usr/bin/perl -w

use strict;
use Test::More 'no_plan';

# Change these values together
# For some reason I didn't manage to use variables here
use lib '../lib';
use MyProject;
our $project = 'MyProject';
our $lib_dir  = '../lib';

# All methods of all modules should be listed here.  This
# list can actually be generated by another script, but it
# will defeat the whole purpose of this meditation. :)
my %methods =
               (
                 'ModuleA' => 
                              [
                                'method_foo',
                                'method_bar',
                                'blah',
                              ],
                 'ModuleB' =>
                              [
                                'do_things',
                                'enjoy',
                              ],
               );

# Firstly, I want to see that I haven't delete any of
# the useful staff.
foreach my $module (sort keys %methods) {
    foreach my $method (sort @{$methods{$module}}) {
        # NOTE: I only check modules which belong to the
        #       project.  External stuff is not tested.
        my $project_module = $project . '::' . $module;
        can_ok($project_module, $method) or
            diag("PROBLEM: method $project_module->$method is missing"
+);
    }
}

# Secondly, I want to see that my tests are realistic, i.e.
# that nothing is missing from the %methods.  This will
# push me either to update the test or remove the leftover
# from the code.  
check_module_tests($project);

# It's been a long time since my last recursive function, 
# btw. :)
sub check_module_tests {
    my $target = shift;

    my $path_to_target = $lib_dir . '/' . $project;
    if ($target eq $project) {
        $path_to_target = $path_to_target .  '.pm';
    }
    else {
        $path_to_target = $path_to_target . '/' . join('/', split('::'
+,$target))
    }

    # Read module
    open (MODULE, "<$path_to_target") or die "$!";
    my @module_lines = <MODULE>;
    close(MODULE);

    # Look for subs
    my @subs = grep(/^sub\s+/, @module_lines);
    # Check that our test suite is complete with all subs
    foreach my $sub (sort @subs) {
        chomp($sub);
        $sub =~ s/^sub\s+(.*?)\{.*$/$1/;
        $sub =~ s/\s+//g;
        my $ok_flag = 0;
        foreach my $test_sub (@{$methods{$target}}) {
            if ($test_sub eq $sub) {
                $ok_flag++;
            }
        }
        is ($ok_flag, 1, "No. of occurances of $sub in test suite") or
            diag('PROBLEM: ' . $target . '->' . $sub . ' is not in tes
+t suite');
    }

    # Look for modules
    my @uses = grep(/^use\s+${project}/, @module_lines);
    # Recursively test each module
    foreach my $use (sort @uses) {
        chomp($use);
        $use =~ s/^use\s+${project}::(.*?);/$1/;
        if (defined($methods{$use})) {
            check_module_tests($use);
        }
        # Don't complain about subs of modules which are not
        # in %methods themselves - that's obvious. :)
        else {
            fail ("Is module $use in test suite?");
            diag ("PROBLEM: $target uses $use, but $use is not in test
+ suite");
        }
    }
}
[download]