Test::Compile::Internal - Test whether your perl files compile.

NAME

Test::Compile::Internal - Test whether your perl files compile.

SYNOPSIS

    use Test::Compile::Internal;
    my $test = Test::Compile::Internal->new();
    $test->all_files_ok();
    $test->done_testing();

DESCRIPTION

Test::Compile::Internal is an object oriented tool for testing whether your perl files compile.

It is primarily to provide the inner workings of Test::Compile, but it can also be used directly to test a CPAN distribution.

METHODS

new()

A basic constructor, nothing special. =cut

sub new { my ($class, %self) = @_; my $self = \%self;

    $self->{test} = Test::Builder->new();

    bless ($self, $class);
    return $self;
}

all_files_ok(@dirs)

Checks all the perl files it can find for compilation errors.

If @dirs is defined then it is taken as an array of directories to be searched for perl files, otherwise it searches some default locations - see all_pm_files(@dirs) and all_pl_files(@dirs).

all_pm_files_ok(@dirs)

Checks all the perl module files it can find for compilation errors.

If @dirs is defined then it is taken as an array of directories to be searched for perl files, otherwise it searches some default locations - see all_pm_files(@dirs).

all_pl_files_ok(@dirs)

Checks all the perl program files it can find for compilation errors.

If @dirs is defined then it is taken as an array of directories to be searched for perl files, otherwise it searches some default locations - see all_pl_files(@dirs).

verbose($verbose)

An accessor to get/set the verbosity. The default value (undef) will suppress output unless the compilation fails. This is probably what you want.

If verbose is set to true, you'll get the output from 'perl -c'. If it's set to false, all diagnostic output is supressed.

all_pm_files(@dirs)

Returns a list of all the perl module files - that is any files ending in .pm in @dirs and in directories below. If @dirs is undefined, it searches blib if blib exists, or else lib.

Skips any files in CVS, .svn, or .git directories.

The order of the files returned is machine-dependent. If you want them sorted, you'll have to sort them yourself. =cut

sub all_pm_files { my ($self, @dirs) = @_;

    @dirs = @dirs ? @dirs : _pm_starting_points();

    my @pm;
    for my $file ( $self->_find_files(@dirs) ) {
        if (-f $file) {
            push @pm, $file if $file =~ /\.pm$/;
        }
    }
    return @pm;
}

all_pl_files(@dirs)

Returns a list of all the perl script files - that is, any files in @dirs that either have a .pl extension, or have no extension and have a perl shebang line.

If @dirs is undefined, it searches script if script exists, or else bin if bin exists.

Skips any files in CVS, .svn, or .git directories.

The order of the files returned is machine-dependent. If you want them sorted, you'll have to sort them yourself.

pl_file_compiles($file)

Returns true if $file compiles as a perl script.

pm_file_compiles($file)

Returns true if $file compiles as a perl module.

TEST METHODS

Test::Compile::Internal encapsulates a Test::Builder object, and provides access to some of its methods.

done_testing(): Declares that you are done testing, no more tests will be run after this point.
ok($test, $name): Your basic test. Pass if $test is true, fail if $test is false. Just like Test::Simple's ok().
plan(tests => $count): Defines how many tests you plan to run.
diag(@msgs): Prints out the given @msgs. Like print, arguments are simply appended together.; Output will be indented and marked with a # so as not to interfere with test output. A newline will be put on the end if there isn't one already.; We encourage using this rather than calling print directly.
skip($reason): Skips the current test, reporting the $reason.
skip_all($reason): Skips all the tests, using the given $reason. Exits immediately with 0.

sub skip_all { my ($self, @args) = @_; $self->{test}->skip_all(@args); }

# Run a subcommand, catching STDOUT, STDERR and return code sub _run_command { my ($self, $cmd) = @_;

    my ($stdout, $stderr);
    my $pid = IPC::Open3::open3(0, $stdout, $stderr, $cmd)
        or die "open3() failed $!";

    my $output;
    for my $handle ( $stdout, $stderr ) {
        if ( $handle ) {
            while ( my $line = <$handle> ) {
                push @$output, $line;
            }
        }
    }

    waitpid($pid, 0);
    my $success = ($? == 0 ? 1 : 0);

    return ($success, $output);
}

# Works it's way through the input array (files and/or directories), recursively # finding files sub _find_files { my ($self, @searchlist) = @_;

    my @output;
    for my $file (@searchlist) {
        if (defined($file) && -f $file) {
            push @output, $file;
        } elsif (defined($file) && -d $file) {
            local *DH;
            opendir DH, $file or next;
            my @newfiles = readdir DH;
            closedir DH;
            @newfiles = File::Spec->no_upwards(@newfiles);
            @newfiles = grep { $_ ne "CVS" && $_ ne ".svn" && $_ ne ".git" } @newfiles;
            for my $newfile (@newfiles) {
                my $filename = File::Spec->catfile($file, $newfile);
                if (-f $filename) {
                    push @output, $filename;
                } else {
                    push @searchlist, File::Spec->catdir($file, $newfile);
                }
            }
        }
    }
    return @output;
}

# Check the syntax of a perl file sub _perl_file_compiles { my ($self, $file) = @_;

    if ( ! -f $file ) {
        $self->{test}->diag("$file could not be found") if $self->verbose();
        return 0;
    }

    my @inc = ('blib/lib', @INC);
    my $taint = $self->_is_in_taint_mode($file);
    my $command = join(" ", ($^X, (map { "-I$_" } @inc), "-c$taint", $file));
    my ($compiles, $output) = $self->_run_command($command);
    if ( $output && (!defined($self->verbose()) || $self->verbose() != 0) ) {
        if ( !$compiles || $self->verbose() ) {
            for my $line ( @$output ) {
                $self->{test}->diag($line);
            }
        }
    }

    return $compiles;
}

# Where do we expect to find perl modules? sub _pm_starting_points { return 'blib' if -e 'blib'; return 'lib'; }

# Where do we expect to find perl programs? sub _pl_starting_points { return 'script' if -e 'script'; return 'bin' if -e 'bin'; }

# Extract the shebang line from a perl program sub _read_shebang { my ($self, $file) = @_;

    open(my $f, "<", $file) or die "could not open $file";
    my $line = <$f>;
    if (defined $line && $line =~ m/^#!/ ) {
        return $line;
    }
}

# Should the given file be checked with taint mode on? sub _is_in_taint_mode { my ($self, $file) = @_;

    my $shebang = $self->_read_shebang($file);
    my $taint = "";
    if ($shebang =~ /^#!\s*[\/\w]+\s+-\w*([tT])/) {
        $taint = $1;
    }
    return $taint;
}

AUTHORS

Sagar R. Shah <srshah@cpan.org>, Marcel Grünauer, <marcel@cpan.org>, Evan Giles, <egiles@cpan.org>

COPYRIGHT AND LICENSE

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.