From c382a62f8cbed3dc2535d02701de5141ebb8e11c Mon Sep 17 00:00:00 2001 From: Chad Granum Date: Tue, 28 Nov 2023 20:10:30 -0800 Subject: [PATCH] Remove some garbage --- lib/App/Yath/Command/collector.pm | 144 ------------- scripts/yath-stage | 330 ------------------------------ 2 files changed, 474 deletions(-) delete mode 100644 lib/App/Yath/Command/collector.pm delete mode 100755 scripts/yath-stage diff --git a/lib/App/Yath/Command/collector.pm b/lib/App/Yath/Command/collector.pm deleted file mode 100644 index b5d757967..000000000 --- a/lib/App/Yath/Command/collector.pm +++ /dev/null @@ -1,144 +0,0 @@ -package App::Yath::Command::collector; -use strict; -use warnings; - -our $VERSION = '2.000000'; - -use parent 'App::Yath::Command'; -use Test2::Harness::Util::HashBase; - -use Test2::Harness::Collector; -use Test2::Harness::IPC::Protocol; -use Test2::Harness::Collector::Auditor; -use Test2::Harness::Collector::IOParser::Stream; - -use Test2::Harness::Util qw/mod2file/; -use Test2::Harness::IPC::Util qw/start_process ipc_connect/; -use Test2::Harness::Util::JSON qw/decode_json encode_json/; - -use Time::HiRes qw/time/; - -use Getopt::Yath; -include_options('App::Yath::Options::Yath'); - -sub args_include_tests { 0 } - -sub group { 'internal' } - -sub summary { "Run a test" } - -warn "fixme"; -sub description { - return <<" EOT"; - fixme - EOT -} - -my $warned = 0; -sub run { - my $self = shift; - my $settings = $self->settings; - - $0 = 'yath-collector'; - - my ($json) = @{$self->{+ARGS}}; - my $data = decode_json($json); - - warn "Make run an object"; - my $run = $data->{run} or die "No run provided"; - - my $job = $data->{job} or die "No job provided"; - my $jclass = $job->{job_class} // 'Test2::Harnes::Job'; - require(mod2file($jclass)); - $job = $jclass->new($job); - - my $inst_ipc_data = $run->{instance_ipc}; - my ($inst_ipc, $inst_con); - my ($agg_ipc, $agg_con) = ipc_connect($run->{aggregator_ipc}); - - my $handler; - if ($inst_ipc_data) { - if ($agg_con) { - $handler = sub { - for my $e (@_) { - $agg_con->send_message($e); - - warn "Forward important events like timeout and bailout to instance" unless $warned++; - next; - ($inst_ipc, $inst_con) = ipc_connect($inst_ipc_data) unless $inst_con; - } - }; - } - else { - $handler = sub { - for my $e (@_) { - print STDOUT encode_json($e), "\n"; - - warn "Forward important events like timeout and bailout to instance" unless $warned++; - next; - ($inst_ipc, $inst_con) = ipc_connect($inst_ipc_data) unless $inst_con; - } - }; - } - } - else { - if ($agg_con) { - $handler = sub { $agg_con->send_message($_) for @_ }; - } - else { - $handler = \*STDOUT; - } - } - - my $auditor = Test2::Harness::Collector::Auditor->new(%$job); - my $parser = Test2::Harness::Collector::IOParser::Stream->new(%$job, type => 'test'); - - my $collector = Test2::Harness::Collector->new( - %$job, - parser => $parser, - auditor => $auditor, - output => $handler, - ); - - warn "FIXME"; - $ENV{T2_FORMATTER} = 'Stream'; - - open(our $stderr, '>&', \*STDERR) or die "Could not clone STDERR"; - - $SIG{__WARN__} = sub { print $stderr @_ }; - - my $exit = 0; - my $ok = eval { - $collector->setup_child(); - - my $pid = start_process($job->launch_command($run)); - - $exit = $collector->process($pid); - - 1; - }; - my $err = $@; - - if (!$ok) { - print $stderr $err; - print STDERR "Test2 Harness Collector Error: $err"; - exit(255); - } - - return $exit; -} - -1; -__END__ - - my $auditor = Test2::Harness::Collector::Auditor->new(run_id => 'FAKE', job_id => 'FAKE', job_try => 0, file => 't/fake.t'); - - my $renderer = App::Yath::Renderer::Default->new; - $renderer->start(); - - my $collector = Test2::Harness::Collector->new( - run_id => 'FAKE', job_id => 'FAKE', job_try => 0, - parser => Test2::Harness::Collector::IOParser::Stream->new(type => 'test', name => 't/fake.t', job_id => 'FAKE', run_id => 'FAKE', job_try => 0), - auditor => $auditor, - output => sub { $renderer->render_event($_) for @_ }, - diff --git a/scripts/yath-stage b/scripts/yath-stage deleted file mode 100755 index c6c6add43..000000000 --- a/scripts/yath-stage +++ /dev/null @@ -1,330 +0,0 @@ -#!/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. -my ($OK, $ERR); -BEGIN { - local $.; - return if $^C; - - package App::Yath::Script; - - my %seen; - @INC = grep { !$seen{$_}++ } @INC; - - 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 %SCAN; - - 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); - %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 '-c' || $arg eq '--color') { - $ENV{YATH_COLOR} = 1; - } - elsif ($arg eq '--no-color') { - $ENV{YATH_COLOR} = 0; - } - - 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 =~ m/--(no-)?scan-([^=\{]+)$/) { - my $val = $1 ? 0 : 1; - $SCAN{$2} = $val; - 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 Getopt::Yath::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 = Getopt::Yath::Settings->new( - yath => { - orig_tmp => $ORIG_TMP, - orig_tmp_perms => $ORIG_TMP_PERMS, - orig_sig => \%ORIG_SIG, - orig_argv => \@ORIG_ARGV, - orig_inc => \@ORIG_INC, - script => $SCRIPT, - script_version => $App::Yath::VERSION, - dev_libs => \@DEVLIBS, - start => Time::HiRes::time(), - cwd => Cwd::getcwd(), - scan_options => \%SCAN, - %mixin, - }, - ); - - my $app = App::Yath->new( - argv => \@ARGV, - config => \%CONFIG, - settings => $settings, - ); - - $OK = eval { $app->generate_run_sub('App::Yath::Script::run'); 1 }; - $ERR = $@; - - # ==END TESTABLE CODE CREATE_APP== -} - -die $ERR unless $OK; - -# 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. -For usage instructions and examples, -see L. - -=head1 SOURCE - -The source code repository for Test2-Harness can be found at -F. - -=head1 MAINTAINERS - -=over 4 - -=item Chad Granum Eexodist@cpan.orgE - -=back - -=head1 AUTHORS - -=over 4 - -=item Chad Granum Eexodist@cpan.orgE - -=back - -=head1 COPYRIGHT - -Copyright 2020 Chad Granum Eexodist7@gmail.comE. - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -See F - -=cut