121 |
{ |
{ |
122 |
if (! unlink <$tmp/*>) |
if (! unlink <$tmp/*>) |
123 |
{ |
{ |
124 |
print "$me: cannot empty $tmp: $!\n"; |
print STDERR "$me: cannot empty $tmp: $!\n"; |
125 |
$? = 1; |
$? = 1; |
126 |
return; |
return; |
127 |
} |
} |
128 |
} |
} |
129 |
if (! rmdir $tmp) |
if (! rmdir $tmp) |
130 |
{ |
{ |
131 |
print "$me: cannot remove $tmp: $!\n"; |
print STDERR "$me: cannot remove $tmp: $!\n"; |
132 |
$? = 1; |
$? = 1; |
133 |
return; |
return; |
134 |
} |
} |
138 |
# E.g., even --version or --help. So it's best to do it unconditionally. |
# E.g., even --version or --help. So it's best to do it unconditionally. |
139 |
if (! close STDOUT) |
if (! close STDOUT) |
140 |
{ |
{ |
141 |
print "$me: closing standard output: $!\n"; |
print STDERR "$me: closing standard output: $!\n"; |
142 |
$? = 1; |
$? = 1; |
143 |
return; |
return; |
144 |
} |
} |
488 |
if $verbose; |
if $verbose; |
489 |
} |
} |
490 |
|
|
491 |
|
# handle_exec_errors ($COMMAND) |
492 |
|
# ----------------------------- |
493 |
|
# Display an error message for $COMMAND, based on the content of $? and $!. |
494 |
|
sub handle_exec_errors ($) |
495 |
|
{ |
496 |
|
my ($command) = @_; |
497 |
|
|
498 |
|
$command = (split (' ', $command))[0]; |
499 |
|
if ($!) |
500 |
|
{ |
501 |
|
error "failed to run $command: $!"; |
502 |
|
} |
503 |
|
else |
504 |
|
{ |
505 |
|
use POSIX qw (WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG); |
506 |
|
|
507 |
|
if (WIFEXITED ($?)) |
508 |
|
{ |
509 |
|
my $status = WEXITSTATUS ($?); |
510 |
|
# WIFEXITED and WEXITSTATUS can alter $!, reset it so that |
511 |
|
# error() actually propagates the command's exit status, not $!. |
512 |
|
$! = 0; |
513 |
|
error "$command failed with exit status: $status"; |
514 |
|
} |
515 |
|
elsif (WIFSIGNALED ($?)) |
516 |
|
{ |
517 |
|
my $signal = WTERMSIG ($?); |
518 |
|
# In this case we prefer to exit with status 1. |
519 |
|
$! = 1; |
520 |
|
error "$command terminated by signal: $signal"; |
521 |
|
} |
522 |
|
else |
523 |
|
{ |
524 |
|
error "$command exited abnormally"; |
525 |
|
} |
526 |
|
} |
527 |
|
} |
528 |
|
|
529 |
# xqx ($COMMAND) |
# xqx ($COMMAND) |
530 |
# -------------- |
# -------------- |
531 |
# Same as `qx' (but in scalar context), but fails on errors. |
# Same as `qx' (but in scalar context), but fails on errors. |
532 |
sub xqx ($) |
sub xqx ($) |
533 |
{ |
{ |
|
use POSIX qw (WIFEXITED WEXITSTATUS); |
|
|
|
|
534 |
my ($command) = @_; |
my ($command) = @_; |
535 |
|
|
536 |
verbose "running: $command"; |
verbose "running: $command"; |
|
my $res = `$command`; |
|
537 |
|
|
538 |
error ((split (' ', $command))[0] |
$! = 0; |
539 |
. " failed with exit status: " |
my $res = `$command`; |
540 |
. WEXITSTATUS ($?)) |
handle_exec_errors $command |
541 |
if WIFEXITED ($?) && WEXITSTATUS ($?) != 0; |
if $?; |
542 |
|
|
543 |
return $res; |
return $res; |
544 |
} |
} |
548 |
# ------------------ |
# ------------------ |
549 |
sub xsystem ($) |
sub xsystem ($) |
550 |
{ |
{ |
|
use POSIX qw (WEXITSTATUS); |
|
|
|
|
551 |
my ($command) = @_; |
my ($command) = @_; |
552 |
|
|
553 |
verbose "running: $command"; |
verbose "running: $command"; |
554 |
|
|
555 |
$! = 0; |
$! = 0; |
556 |
|
handle_exec_errors $command |
557 |
if (system $command) |
if system $command; |
|
{ |
|
|
$command = (split (' ', $command))[0]; |
|
|
if ($!) |
|
|
{ |
|
|
error "failed to run $command: $!"; |
|
|
} |
|
|
else |
|
|
{ |
|
|
error "$command failed with exit status: " . WEXITSTATUS ($?); |
|
|
} |
|
|
} |
|
558 |
} |
} |
559 |
|
|
560 |
|
|