#!/usr/bin/perl
use strict;
use warnings;

=head1 NAME

build-test-scripts - rebuild t/*.t from t/*.ttmpl

=head1 SYNOPSIS

 t/build-test-scripts

=head1 DESCRIPTION

When run from the root of the IO::Callback distribution, this script rebuilds some of the test files in F<t/> from test template files in the same directory. 

Each test template gives rise to one or more test files, with a test file generated for each possible combination of values for the C<vary> directives in the template.

=cut

use autodie;
use File::Slurp;
use File::Spec;
use Template;

our $tt =Template->new({
    START_TAG => '<<<',
    END_TAG   => '>>>',
});

my $dirhandle;
opendir $dirhandle, "t";
while ( my $f = readdir $dirhandle ) {
    next unless $f =~ m{^(.+)\.ttmpl$};
    my $base_test_name = $1;
    my $src_filename = File::Spec->catfile("t", $f);
    my $auto_warning = <<EOF;
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#
# This file was automatically built from $src_filename
#
# Do not edit this file, instead edit the template and rebuild by running
# t/build-test-scripts
#
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
EOF
    my $input = read_file $src_filename;
    $input =~ s/^((?:#!.*\n)?)/$1 . $auto_warning/e;
    build_test_scripts($base_test_name, $input, {});
}

sub build_test_scripts {
    my ($test_name, $input, $vars) = @_;

    my $vary;
    my @range;
    if ($input =~ /\svary!!(\w+)!!([,\w]+)\s/) {
        $vary = $1;
        @range = split /,/, $2;
    } elsif ($input =~ /\svary!!(\w+)\s/) {
        $vary = $1;
        @range = ('', $vary);
    } else {
        output_test_script($test_name, $input, $vars);
        return;
    }

    foreach my $value (@range) {
        my $copy = $input;
        $copy =~ s/(\s)vary!!\Q$vary\E(?:!![,\w]+)?(\s)/$1'$value'$2/g;
        if ($vary eq "taint" and $value eq "taint") {
            $copy = "#!perl -T\n" . $copy . "\nuse Test::Taint;\ntaint_checking_ok;\n\n";
        }
        my $test_name_addition = length $value ? "-$value" : "";
        build_test_scripts($test_name.$test_name_addition, $copy, { %$vars, $vary => $value });
    }
}

sub output_test_script {
    my ($test_name, $input, $vars) = @_;

    my $outfile = File::Spec->catfile("t", "$test_name.t");
    $tt->process(\$input, $vars, $outfile) or die "Template $outfile: ".$tt->error;
}