Revision control
++ # 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;