37 |
|
|
38 |
# Functions we define and export. |
# Functions we define and export. |
39 |
my @export_subs = |
my @export_subs = |
40 |
qw (&backname &catfile &canonpath &debug |
qw (&backname &catfile &canonpath &debug &error |
41 |
&file_name_is_absolute &find_configure_ac &find_file |
&file_name_is_absolute &find_configure_ac &find_file |
42 |
&getopt &mktmpdir &mtime |
&getopt &mktmpdir &mtime |
43 |
&uniq &update_file &up_to_date_p &verbose &xsystem); |
&uniq &update_file &up_to_date_p &verbose &xsystem &xqx); |
44 |
|
|
45 |
# Functions we forward (coming from modules we use). |
# Functions we forward (coming from modules we use). |
46 |
my @export_forward_subs = |
my @export_forward_subs = |
185 |
} |
} |
186 |
|
|
187 |
|
|
188 |
|
# &error (@MESSAGE) |
189 |
|
# ----------------- |
190 |
|
# Same as die or confess, depending on $debug. |
191 |
|
sub error (@) |
192 |
|
{ |
193 |
|
if ($debug) |
194 |
|
{ |
195 |
|
confess "$me: ", @_, "\n"; |
196 |
|
} |
197 |
|
else |
198 |
|
{ |
199 |
|
die "$me: ", @_, "\n"; |
200 |
|
} |
201 |
|
} |
202 |
|
|
203 |
|
|
204 |
# $BOOLEAN |
# $BOOLEAN |
205 |
# &file_name_is_absolute ($FILE) |
# &file_name_is_absolute ($FILE) |
206 |
# ------------------------------ |
# ------------------------------ |
260 |
|
|
261 |
if (file_name_is_absolute ($filename)) |
if (file_name_is_absolute ($filename)) |
262 |
{ |
{ |
263 |
die "$me: no such file or directory: $filename\n" |
error "no such file or directory: $filename" |
264 |
unless $optional; |
unless $optional; |
265 |
return undef; |
return undef; |
266 |
} |
} |
271 |
if -e catfile ($path, $filename); |
if -e catfile ($path, $filename); |
272 |
} |
} |
273 |
|
|
274 |
die "$me: no such file or directory: $filename\n" |
error "no such file or directory: $filename" |
275 |
unless $optional; |
unless $optional; |
276 |
|
|
277 |
return undef; |
return undef; |
424 |
} |
} |
425 |
$in->close; |
$in->close; |
426 |
unlink ($from) |
unlink ($from) |
427 |
or die "$me: cannot not remove $from: $!\n"; |
or die "cannot not remove $from: $!"; |
428 |
return; |
return; |
429 |
} |
} |
430 |
|
|
433 |
# File didn't change, so don't update its mod time. |
# File didn't change, so don't update its mod time. |
434 |
print STDERR "$me: `$to' is unchanged\n"; |
print STDERR "$me: `$to' is unchanged\n"; |
435 |
unlink ($from) |
unlink ($from) |
436 |
or die "$me: cannot not remove $from: $!\n"; |
or error "cannot not remove $from: $!"; |
437 |
return |
return |
438 |
} |
} |
439 |
|
|
441 |
{ |
{ |
442 |
# Back up and install the new one. |
# Back up and install the new one. |
443 |
move ("$to", "$to$SIMPLE_BACKUP_SUFFIX") |
move ("$to", "$to$SIMPLE_BACKUP_SUFFIX") |
444 |
or die "$me: cannot not backup $to: $!\n"; |
or error "cannot not backup $to: $!"; |
445 |
move ("$from", "$to") |
move ("$from", "$to") |
446 |
or die "$me: cannot not rename $from as $to: $!\n"; |
or error "cannot not rename $from as $to: $!"; |
447 |
print STDERR "$me: `$to' is updated\n"; |
print STDERR "$me: `$to' is updated\n"; |
448 |
} |
} |
449 |
else |
else |
450 |
{ |
{ |
451 |
move ("$from", "$to") |
move ("$from", "$to") |
452 |
or die "$me: cannot not rename $from as $to: $!\n"; |
or error "cannot not rename $from as $to: $!"; |
453 |
print STDERR "$me: `$to' is created\n"; |
print STDERR "$me: `$to' is created\n"; |
454 |
} |
} |
455 |
} |
} |
464 |
} |
} |
465 |
|
|
466 |
|
|
467 |
|
# xqx ($COMMAND) |
468 |
|
# -------------- |
469 |
|
# Same as `qx' (but in scalar context), but fails on errors. |
470 |
|
sub xqx ($) |
471 |
|
{ |
472 |
|
use POSIX qw (WIFEXITED WEXITSTATUS); |
473 |
|
|
474 |
|
my ($command) = @_; |
475 |
|
|
476 |
|
verbose "running: $command"; |
477 |
|
my $res = `$command`; |
478 |
|
|
479 |
|
error ((split (' ', $command))[0] |
480 |
|
. " failed with exit status: " |
481 |
|
. WEXITSTATUS ($?)) |
482 |
|
if WIFEXITED ($?) && WEXITSTATUS ($?) != 0; |
483 |
|
|
484 |
|
return $res; |
485 |
|
} |
486 |
|
|
487 |
|
|
488 |
# xsystem ($COMMAND) |
# xsystem ($COMMAND) |
489 |
# ------------------ |
# ------------------ |
490 |
sub xsystem ($) |
sub xsystem ($) |
491 |
{ |
{ |
492 |
|
use POSIX qw (WEXITSTATUS); |
493 |
|
|
494 |
my ($command) = @_; |
my ($command) = @_; |
495 |
|
|
496 |
verbose "running: $command"; |
verbose "running: $command"; |
497 |
|
|
498 |
(system $command) == 0 |
(system $command) == 0 |
499 |
or croak ("$me: " |
or error ((split (' ', $command))[0] |
|
. (split (' ', $command))[0] |
|
500 |
. " failed with exit status: " |
. " failed with exit status: " |
501 |
. ($? >> 8) |
. WEXITSTATUS ($?)); |
|
. "\n"); |
|
502 |
} |
} |
503 |
|
|
504 |
|
|