#!/usr/bin/perl
# Do not use warnings/strict, we want to avoid contamination of the

# '-D' and '--dev-lib' MUST be handled well in advance of loading ANYTHING.
# These will get re-processed later, but they MUST come even before App::Yath
# is loaded.
BEGIN {
    local $.;
    return if $^C;

    package App::Yath::Script;
    our $VERSION = '1.000156';

    my $ORIG_TMP;
    my $ORIG_TMP_PERMS;
    my %ORIG_SIG = map { defined($SIG{$_}) ? ($_ => "$SIG{$_}") : ()} keys %SIG;
    my @ORIG_ARGV = @ARGV;
    my @ORIG_INC = @INC;
    my @DEVLIBS;
    my %CONFIG;
    my $NO_PLUGINS;

    our $SCRIPT;

    # ==START TESTABLE CODE FIND_CONFIG_FILES==

    my ($config_file, $user_config_file);

    # Would be nice if we could use File::Spec, but we cannot load ANYTHING yet.
    my %no_stat = (mswin32 => 1, vms => 1, riscos => 1, os2 => 1, cygwin => 1);
    my %seen;
    my $dir = './';
    for (1 .. 100) {    # If we are more than 100 deep we have other problems
        if ($no_stat{lc($^O)}) {
            opendir(my $dh, $dir) or die "$!";
            my $key = join ':' => sort readdir($dh);
            last if $seen{$key}++;
        }
        else {
            my ($dev, $ino) = stat $dir;
            last if $seen{$dev}{$ino}++;
        }

        $config_file      //= "${dir}.yath.rc"      if -f "${dir}.yath.rc";
        $user_config_file //= "${dir}.yath.user.rc" if -f "${dir}.yath.user.rc";

        last if $config_file && $user_config_file;

        $dir .= "../";
    }

    # ==END TESTABLE CODE FIND_CONFIG_FILES==
    # ==START TESTABLE CODE PARSE_CONFIG_FILES==

    my (@CONFIG_ARGS, @TO_CLEAN);
    for my $file ($config_file, $user_config_file) {
        next unless $file && -f $file;

        my $cmd;
        open(my $fh, '<', $file) or die "Could not open config file '$file' for reading: $!";
        while (my $line = <$fh>) {
            chomp($line);
            $cmd = $1 and next if $line =~ m/^\[(.*)\]$/;
            $line =~ s/;.*$//g;
            $line =~ s/^\s*//g;
            $line =~ s/\s*$//g;
            next unless length($line);

            my ($key, $eq, $val);
            if ($line =~ m/^(-\S)((?:rel|glob|relglob)\(.*\))$/) {   # Handle things like -Irel(...)
                $key = $1;
                $eq  = '';
                $val = $2;
            }
            else {
                ($key, $eq, $val) = split /(=|\s+)/, $line, 2;  # Covers most cases
            }

            my $is_pre;
            if ($key =~ m/^-D/ || $key eq '--dev-lib') {
                $eq = '=' if $val;
                $is_pre = 1;
            }

            if ($key eq '--no-scan-plugins') {
                $is_pre = 1;
            }

            my $need_to_clean;
            if ($val && $val =~ s/(^|=)\s*rel\(\s*//) {
                die "Syntax error in $file line $.: Expected ')'\n" unless $val =~ s/\s*\)$//;
                my $path = $file;
                $path =~ s{[^/]*$}{}g;
                $val           = "${path}${val}";
                $need_to_clean = 1;
            }

            my @all;

            if ($val && $val =~ s/(^|=)\s*(rel)?glob\(\s*//) {
                my $rel = $2;

                die "Syntax error in $file line $.: Expected ')'\n" unless $val =~ s/\s*\)$//;

                my $path = '';
                if ($rel) {
                    $path = $file;
                    $path =~ s{[^/]*$}{}g;
                }

                # Avoid loading File::Glob in this process...
                my $out = `$^X -e 'print join "\\n" => glob("${path}${val}")'`;
                my @vals = split /\n/, $out;
                @all = map {[$key, $eq, $_, 1]} @vals;
            }
            else {
                @all = ([$key, $eq, $val, $need_to_clean]);
            }

            for my $set (@all) {
                my ($key, $eq, $val, $need_to_clean) = @$set;
                $eq //= '';

                my @parts = $eq eq '=' ? ("${key}${eq}${val}") : (grep { defined $_ } $key, $val);

                if ($is_pre) {
                    push @CONFIG_ARGS => @parts;
                }
                else {
                    $cmd //= '~';
                    push @{$CONFIG{$cmd}} => @parts;
                    push @TO_CLEAN => [$cmd, $#{$CONFIG{$cmd}}, $key, $eq, $val] if $need_to_clean;
                }
            }
        }
        close($fh);
    }

    unshift @ARGV => @CONFIG_ARGS;

    # ==END TESTABLE CODE PARSE_CONFIG_FILES==
    # ==START TESTABLE CODE PRE_PARSE_D_ARGS==

    my (@libs, %done, @args, $maybe_exec);
    while (@ARGV) {
        my $arg = shift @ARGV;

        if ($arg eq '--' || $arg eq '::') {
            push @args => $arg;
            last;
        }

        if ($arg eq '--no-dev-lib') {
            @libs = ();
            %done = ();
            next;
        }

        if ($arg =~ m{^(?:(?:-D=?|--dev-lib=)(.*)|--dev-lib)$}) {
            my @add = $1 ? ($1) : ();
            unless (@add) {
                @add        = ('lib', 'blib/lib', 'blib/arch');
                $maybe_exec = $arg;
            }

            push @libs => grep { !$done{$_}++ } @add;
            next;
        }

        if ($arg eq '--no-scan-plugins') {
            $NO_PLUGINS = 1;
            next;
        }

        push @args => $arg;
    }
    @ARGV = (@args, @ARGV);

    unshift @INC => @libs;
    unshift @DEVLIBS => @libs;

    # ==END TESTABLE CODE PRE_PARSE_D_ARGS==
    # ==START TESTABLE CODE EXEC==

    # Now it is safe/ok to load things.
    require Cwd;
    require File::Spec;

    $ORIG_TMP = File::Spec->tmpdir();
    $ORIG_TMP_PERMS = ((stat($ORIG_TMP))[2] & 07777);
    $SCRIPT = Cwd::realpath(__FILE__) // File::Spec->rel2abs(__FILE__);

    if ($maybe_exec && -e 'scripts/yath') {
        my $script = Cwd::realpath('scripts/yath') // File::Spec->rel2abs('scripts/yath');

        if ($SCRIPT ne $script) {
            warn "\n** $maybe_exec was used, and scripts/yath is present, using exec to switch to it. **\n\n";
            exec($script, @ORIG_ARGV);
            die("Should not see this, exec failed!");
        }
    }

    # ==END TESTABLE CODE EXEC==
    # ==START TESTABLE CODE CLEANUP_PATHS==

    if (@libs || @TO_CLEAN) {
        for (my $i = 0; $i < @libs; $i++) {
            $DEVLIBS[$i] = $INC[$i] = Cwd::realpath($INC[$i]) // File::Spec->rel2abs($INC[$i]);
        }

        for my $clean (@TO_CLEAN) {
            my ($cmd, $idx, $key, $eq, $val) = @$clean;
            $val = Cwd::realpath($val) // File::Spec->rel2abs($val);

            if ($eq eq '=') {
                $CONFIG{$cmd}->[$idx] = "${key}${eq}${val}";
            }
            else {
                $CONFIG{$cmd}->[$idx] = $val;
            }
        }
    }

    # ==END TESTABLE CODE CLEANUP_PATHS==
    # ==START TESTABLE CODE CREATE_APP==

    require App::Yath;
    require Time::HiRes;
    require Test2::Harness::Settings;

    my %mixin = (config_file => '', user_config_file => '');
    $mixin{config_file}      = Cwd::realpath($config_file)      // File::Spec->rel2abs($config_file)      if $config_file;
    $mixin{user_config_file} = Cwd::realpath($user_config_file) // File::Spec->rel2abs($user_config_file) if $user_config_file;

    my $settings = Test2::Harness::Settings->new(
        harness => {
            orig_tmp         => $ORIG_TMP,
            orig_tmp_perms   => $ORIG_TMP_PERMS,
            orig_sig         => \%ORIG_SIG,
            orig_argv        => \@ORIG_ARGV,
            orig_inc         => \@ORIG_INC,
            script           => $SCRIPT,
            no_scan_plugins  => $NO_PLUGINS,
            dev_libs         => \@DEVLIBS,
            start            => Time::HiRes::time(),
            version          => $App::Yath::VERSION,
            cwd              => Cwd::getcwd(),
            %mixin,
        },
    );

    my $app = App::Yath->new(
        argv    => \@ARGV,
        config  => \%CONFIG,
        settings => $settings,
    );

    $app->generate_run_sub('App::Yath::Script::run');

    # ==END TESTABLE CODE CREATE_APP==
}

# Reset these if we got this far.
$? = 0;
$@ = '';

exit(App::Yath::Script::run());

__END__

=pod

=encoding UTF-8

=head1 NAME

yath - Primary Command Line Interface (CLI) for Test2::Harness

=head1 DESCRIPTION

This is the primary command line interface for App::Yath/Test2::Harness. Yath
is essentially a shell around the components of L<Test2::Harness>.
For usage instructions and examples,
see L<App::Yath>.

=head1 SOURCE

The source code repository for Test2-Harness can be found at
F<http://github.com/Test-More/Test2-Harness/>.

=head1 MAINTAINERS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 AUTHORS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 COPYRIGHT

Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>.

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

See F<http://dev.perl.org/licenses/>

=cut