simcop2387/docker-perl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages 2 Wiki Activity

Now using IPC::Run instead of Capture tiny
Some checks failed
ci/woodpecker/push/generate-perl Pipeline was successful
Details
ci/woodpecker/push/base-os Pipeline was successful
Details
ci/woodpecker/push/build-perls Pipeline failed
Details

Browse source
This commit is contained in:
Automation Pipeline 2023-10-07 10:37:36 -04:00
parent 7075769a59
commit e49cd5e723
1 changed files with 79 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

96
build.pl
View file

@ -9,9 +9,10 @@ use IO::Async::Function;
use IO::Async::Loop::Epoll; use IO::Async::Loop::Epoll;
use Getopt::Long; use Getopt::Long;
use Future; use Future;
use Capture::Tiny qw(tee_merged);
use Path::Tiny; use Path::Tiny;
use IPC::Run;
use Time::HiRes qw/time/;
use Syntax::Keyword::Try;
my @bases = qw/bullseye-backports bookworm-backports/; my @bases = qw/bullseye-backports bookworm-backports/;
my @options = ("main", "main-threaded", "main-longdouble", "main-quadmath", "main-debugging", "main-longdouble-threaded", "main-quadmath-threaded", "main-debugging-threaded", "main-debugging-longdouble-threaded", "main-debugging-quadmath-threaded", "main-debugging-longdouble", "main-debugging-quadmath"); my @options = ("main", "main-threaded", "main-longdouble", "main-quadmath", "main-debugging", "main-longdouble-threaded", "main-quadmath-threaded", "main-debugging-threaded", "main-debugging-longdouble-threaded", "main-debugging-quadmath-threaded", "main-debugging-longdouble", "main-debugging-quadmath");
@ -24,9 +25,69 @@ GetOptions('verbose' => \$verbose,
'workers=i' => \$max_workers, 'workers=i' => \$max_workers,
); );
my $loop = IO::Async::Loop::Epoll->new(); my $loop = IO::Async::Loop::Epoll->new();
sub get_ts {
my $t = time();
return sprintf "%0.04f", $t;
}
sub process_lines {
my ($disp_prefix, $lines) = @_;
my $output = "";
while ($$lines =~ /\n/m) {
my $ts = get_ts();
$$lines =~ s/^(.*?)\n//m;
my $raw_line = $1;
my $log_line = $ts.": ".$raw_line;
my $disp_line = $disp_prefix." - ".$ts.": ".$raw_line;
print "out: ", $disp_line, "\n";
$output .= $log_line;
}
return $output;
}
sub run_cmd {
my ($cmd,$disp_prefix,$log_file,$input) = @_;
my ($output, $error, $raw_out, $raw_err);
try {
print "Running command $disp_prefix ".$cmd->[0], "\n";
my $handle = IPC::Run::start $cmd, \$input, \$raw_out, \$raw_err; # no timeout here, that's part of the ::Function
print "started, $handle\n";
print "pumpable? ", $handle->pumpable?"yes":"no", "\n";
while ($handle->pumpable) {
$handle->pump();
print "pumping $disp_prefix\n";
$output .= process_lines($disp_prefix, \$raw_out);
$error .= process_lines($disp_prefix."[ERR]", \$raw_err);
}
# Nothing we do here is a fatal error.
finish $handle;
my $return = $?;
print "Finished $disp_prefix\n";
return ($output, $error, $return);
} catch {
my $e = $@;
print "$disp_prefix: $e\n";
}
}
my $builder = IO::Async::Function->new( my $builder = IO::Async::Function->new(
code => sub { code => sub {
my ( $version, $options, $os_base ) = @_; my ( $version, $options, $os_base ) = @_;
@ -35,18 +96,19 @@ my $builder = IO::Async::Function->new(
my $tags = ["$version-$options-$os_base", "$expanded_version-$options-$os_base"]; my $tags = ["$version-$options-$os_base", "$expanded_version-$options-$os_base"];
my ($output, $return) = tee_merged sub { my ($output, $error, $retval) = run_cmd(["ls"], $tags->[0], "", "");
my $workdir = path("output/perls")->child("$expanded_version-$options-$os_base"); # my ($output, $return) = tee_merged sub {
# my $workdir = path("output/perls")->child("$expanded_version-$options-$os_base");
if ($workdir->exists()) { #
# if ($workdir->exists()) {
chdir($workdir); #
#print "$workdir\n"; # chdir($workdir);
#system("ls"); # #print "$workdir\n";
} else { # #system("ls");
print "Failed to find $workdir\n"; # } else {
} # print "Failed to find $workdir\n";
}; # }
# };
return $output; return $output;
}, },
@ -88,11 +150,11 @@ while (1) {
$loop->delay_future(after => 1)->get(); $loop->delay_future(after => 1)->get();
if (@pending < 1) { if (@pending < 1) {
break; last;
} }
} }
my @result = $full_future->get(); my @result = $full_future->get();
use Data::Dumper; use Data::Dumper;
print Dumper(\@result); #print Dumper(\@result);