File Coverage

blib/lib/Test/DirectoryLayout.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	8	10	80.0
condition			n/a
subroutine	7	7	100.0
pod	3	3	100.0
total	53	55	96.3

package Test::DirectoryLayout;
$Test::DirectoryLayout::VERSION = '0.002';    # TRIAL

#ABSTRACT: Test directory layout for standard compliance

use strict;
use warnings;

use base qw(Test::Builder::Module);
our @EXPORT = qw(directory_layout_ok get_allowed_dirs set_allowed_dirs);

my @diags;
my $CLASS  = __PACKAGE__;
my $Tester = $CLASS->builder;

{
    my @allowed_dirs = qw(bin blib lib config doc t);

    sub get_allowed_dirs {
        return \@allowed_dirs;
    }

    sub set_allowed_dirs {
        my ($dirs) = @_;
        @allowed_dirs = @$dirs;
    }
}

sub directory_layout_ok {
    my ($dir) = @_;
    $dir = '.' unless $dir;

    # clean up diagnostics from prior tests
    undef @diags;

    my $description    = 'directory layout';
    my $directories_ok = _directories_ok($dir);

    $Tester->ok( $directories_ok, $description );
    unless ($directories_ok) {
        unshift @diags, "Found the following problems:";
        $Tester->diag( join( "\n  ", @diags ) );
    }

    return $directories_ok;
}

sub _directories_ok {
    my ($dir) = @_;

    my $ok           = 1;
    my $allowed_dirs = get_allowed_dirs;

    opendir( my $dh, $dir ) || die "Can't opendir $dir: $!";
    my @dirs = grep { !/^\./ && -d "$dir/$_" } readdir($dh);
    closedir $dh;
    for my $dir (@dirs) {
        my $allowed = grep ( /^$dir$/, @$allowed_dirs );
        unless ($allowed) {
            $ok = 0;
            push @diags, qq{Directory '$dir' is not allowed};
        }
    }
    return $ok;
}

1;

__END__