Revision control
Copy as Markdown
# Copyright (C) 2017 The Qt Company Ltd.
# SPDX-License-Identifier: LicenseRef-Qt-Commercial OR GPL-3.0-only WITH Qt-GPL-exception-1.0
package QtQA::AnyEvent::Util;
use strict;
use warnings;
use AnyEvent;
use AnyEvent::Util qw();
use English qw( -no_match_vars );
use base 'Exporter';
our @EXPORT_OK = qw(run_cmd);
# extension of AnyEvent::Util::run_cmd
sub run_cmd
{
my ($cmd, %options) = @_;
my $timeout = delete $options{ timeout };
my $cwd = delete $options{ cwd };
my $on_prepare = delete $options{ on_prepare };
my $retry = delete $options{ retry };
my $croak = delete $options{ 'croak' };
if ($cwd) {
my $orig_on_prepare = $on_prepare;
$on_prepare = sub {
chdir( $cwd ) || warn __PACKAGE__ . "::run_cmd: chdir to $cwd: $!";
if ($orig_on_prepare) {
$orig_on_prepare->( @_ )
};
};
}
if ($on_prepare) {
$options{ on_prepare } = $on_prepare;
}
# We need to know the pid, but note the caller might have asked for it too.
my $pid;
my $pid_ref = delete( $options{ '$$' } ) || \$pid;
$options{ '$$' } = $pid_ref;
my $inner_cv;
my $timer;
my $outer_cv = AE::cv();
my $run;
my $end = sub {
my ($status) = @_;
undef $timer; # cancel any timer in progress
undef $run; # $run refers to itself recursively creating a cycle, break it
if ($status && $croak) {
local $LIST_SEPARATOR = '] [';
$outer_cv->croak( "command [@{ $cmd }] exited with status $status" );
} else {
$outer_cv->send( $status );
}
};
my $attempt = 0;
$run = sub {
$inner_cv = AnyEvent::Util::run_cmd( $cmd, %options );
if ($timeout) {
my $timeout_cv = $inner_cv;
$timer = AE::timer( $timeout, 0, sub {
if (!$timeout_cv->ready()) {
# timer expired and process is not yet finished
local $LIST_SEPARATOR = '] [';
warn "command [@{ $cmd }] timed out after $timeout seconds\n";
kill( 15, $$pid_ref );
$inner_cv->send( -1 );
}
undef $timer;
});
}
$inner_cv->cb(
sub {
my $status = shift->recv();
if ($status == 0) {
$end->( $status );
} elsif (!$retry || ++$attempt > 5) {
$end->( $status );
} else {
my $sleep = 2**$attempt;
local $LIST_SEPARATOR = '] [';
warn "command [@{ $cmd }] exited with status $status [retry in $sleep]\n";
my $retry_timer;
$retry_timer = AE::timer( $sleep, 0, sub {
undef $retry_timer;
$run->();
});
}
}
);
};
$run->();
return $outer_cv;
}
=head1 NAME
QtQA::AnyEvent::Util - extensions of AnyEvent::Util methods
=head1 METHODS
Methods are not exported by default.
=over
=item $cv = run_cmd $cmd, key => value...
Extended version of L<AnyEvent::Util>::run_cmd, supporting the following additional options:
=over
=item timeout => $seconds
Maximum permitted runtime of the command; if the command has not completed within this time,
it is killed (signal 15) and $cv receives a value of -1.
=item cwd => $path
Working directory used for the subprocess.
=item retry => $boolean
If true, the command will be repeated a few times (with delays) if it exits with a non-zero
exit code. Suitable for commands which may be subject to intermittent errors (e.g. ssh over
a flaky network connection).
=item croak => $boolean
If true, $cv will croak when the command fails.
=back
=back
=cut
1;