File Coverage

blib/lib/TestML1/Setup.pm

Criterion	Covered	Total	%
statement	20	68	29.4
branch	1	30	3.3
condition	0	21	0.0
subroutine	7	10	70.0
pod	0	3	0.0
total	28	132	21.2

package TestML1::Setup;

use TestML1::Base;

use TestML1();
BEGIN {
    for (qw( YAML::XS IO::All Template::Toolkit::Simple )) {
        if (not $ENV{PERL_ZILD_TEST_000_COMPILE_MODULES}) {
            eval "use $_; 1" or die "TestML1::Setup requires $_:\n$@";
        }
    }
}
use File::Basename;
use Cwd 'abs_path';
use Exporter 'import';

our @EXPORT = qw( setup );

use constant DEFAULT_TESTML_CONF => './t/testml.yaml';

sub setup {
    my ($testml_conf) = @_;
    $testml_conf ||=
        $ARGV[0] ||
        DEFAULT_TESTML_CONF;
    die "TestML1 conf file '$testml_conf' not found"
      unless -f $testml_conf;
    die "TestML1 conf file must be .yaml"
        unless $testml_conf =~ /\.ya?ml$/;
    # File paths are relative to the yaml file location
    my $base = File::Basename::dirname($testml_conf);
    my $conf = YAML::XS::LoadFile($testml_conf);
    my $source = $conf->{source_testml_dir}
        or die "`testml_setup` requires 'source_testml_dir' key in '$testml_conf'";
    my $target = $conf->{local_testml_dir}
        or die "`testml_setup` requires 'local_testml_dir' key in '$testml_conf'";
    my $tests = $conf->{test_file_dir} || '.';
    $source = abs_path("$base/$source");
    $target = abs_path("$base/$target");
    $tests = abs_path("$base/$tests");
    die "'$source' directory does not exist"
        unless -e $source;
    mkdir $target unless -d $target;
    mkdir $tests unless -d $tests;
    my $template = $conf->{test_file_template} || '';
    my $skip = $conf->{exclude_testml_files} || [];
    my $files = $conf->{include_testml_files} ||
        [map $_->filename, grep {"$_" =~ /\.tml$/} io($source)->all_files];
    for my $file (sort @$files) {
        next if grep {$_ eq $file} @$skip;
        my $s = "$source/$file";
        my $t = "$target/$file";
        if (not -f $t or io($s)->all ne io($t)->all) {
            print "Copying ${\ relative_path($s)} to ${\ relative_path($t)}\n";
            io($t)->print(io($s)->all);
        }
        if ($template) {
            (my $test = $file) =~ s/\.tml$/.t/;
            $test = $conf->{test_file_prefix} . $test
                if $conf->{test_file_prefix};
            $test = abs_path "$tests/$test";
            my ($volume, $directories, $file) =
                File::Spec->splitpath(relative_path($t, $base));
            my $path = [
                grep $_, File::Spec->splitdir($directories), $file
            ];
            my $hash = {
                testml_setup_comment => testml_setup_comment($testml_conf),
                file => relative_path($t, $base),
                path => $path,
            };
            my $code = tt->data($hash)->render(\$template);
            if (not -f $test or $code ne io($test)->all) {
                my $action = -f $test ? 'Updating' : 'Creating';
                print "$action test file '${\ relative_path($test)}'\n";
                io($test)->print($code);
            }
        }
    }
}

sub relative_path {
    my ($path, $base) = @_;
    $base ||= '.';
    $base = abs_path($base);
    File::Spec->abs2rel($path, $base);
}

sub testml_setup_comment {
    my ($testml_conf) = @_;
    <<"...";
# DO NOT EDIT
#
# This file was generated by TestML1::Setup ($TestML1::VERSION)
#
#   > perl -MTestML1::Setup -e setup $testml_conf
...
}

1;