18 |
|
|
19 |
package Autom4te::General; |
package Autom4te::General; |
20 |
|
|
21 |
|
=head1 NAME |
22 |
|
|
23 |
|
Autom4te::General - general support functions for Autoconf and Automake |
24 |
|
|
25 |
|
=head1 SYNOPSIS |
26 |
|
|
27 |
|
use Autom4te::General |
28 |
|
|
29 |
|
=head1 DESCRIPTION |
30 |
|
|
31 |
|
This perl module provides various general purpose support functions |
32 |
|
used in several executables of the Autoconf and Automake packages. |
33 |
|
|
34 |
|
=cut |
35 |
|
|
36 |
use 5.005_03; |
use 5.005_03; |
37 |
use Exporter; |
use Exporter; |
38 |
use File::Basename; |
use File::Basename; |
52 |
|
|
53 |
# Functions we define and export. |
# Functions we define and export. |
54 |
my @export_subs = |
my @export_subs = |
55 |
qw (&backname &catfile &canonpath &debug &error |
qw (&catfile &canonpath &contents &debug &error |
56 |
&file_name_is_absolute &find_configure_ac &find_file |
&file_name_is_absolute &find_configure_ac &find_file |
57 |
&getopt &mktmpdir &mtime |
&getopt &mktmpdir &mtime |
58 |
&uniq &update_file &up_to_date_p &verbose &xsystem &xqx); |
&uniq &update_file &up_to_date_p &verbose &xsystem &xqx); |
63 |
|
|
64 |
@EXPORT = (@export_vars, @export_subs, @export_forward_subs); |
@EXPORT = (@export_vars, @export_subs, @export_forward_subs); |
65 |
|
|
66 |
|
|
67 |
# Variable we share with the main package. Be sure to have a single |
# Variable we share with the main package. Be sure to have a single |
68 |
# copy of them: using `my' together with multiple inclusion of this |
# copy of them: using `my' together with multiple inclusion of this |
69 |
# package would introduce several copies. |
# package would introduce several copies. |
70 |
|
|
71 |
|
=head2 Global Variables |
72 |
|
|
73 |
|
=over 4 |
74 |
|
|
75 |
|
=item C<$debug> |
76 |
|
|
77 |
|
Set this variable to 1 if debug messages should be enabled. Debug |
78 |
|
messages are meant for developpers only, or when tracking down an |
79 |
|
incorrect execution. |
80 |
|
|
81 |
|
=cut |
82 |
|
|
83 |
use vars qw ($debug); |
use vars qw ($debug); |
84 |
$debug = 0; |
$debug = 0; |
85 |
|
|
86 |
# Recreate all the files, or consider all the output files are obsolete. |
=item C<$force> |
87 |
|
|
88 |
|
Set this variable to 1 to recreate all the files, or to consider all |
89 |
|
the output files are obsolete. |
90 |
|
|
91 |
|
=cut |
92 |
|
|
93 |
use vars qw ($force); |
use vars qw ($force); |
94 |
$force = undef; |
$force = undef; |
95 |
|
|
96 |
|
=item C<$help> |
97 |
|
|
98 |
|
Set to the help message associated to the option C<--help>. |
99 |
|
|
100 |
|
=cut |
101 |
|
|
102 |
use vars qw ($help); |
use vars qw ($help); |
103 |
$help = undef; |
$help = undef; |
104 |
|
|
105 |
|
=item C<$me> |
106 |
|
|
107 |
|
The name of this application, as should be used in diagostic messages. |
108 |
|
|
109 |
|
=cut |
110 |
|
|
111 |
use vars qw ($me); |
use vars qw ($me); |
112 |
$me = basename ($0); |
$me = basename ($0); |
113 |
|
|
114 |
|
=item C<$tmp> |
115 |
|
|
116 |
|
The name of the temporary directory created by C<mktmpdir>. Left |
117 |
|
C<undef> otherwise. |
118 |
|
|
119 |
|
=cut |
120 |
|
|
121 |
# Our tmp dir. |
# Our tmp dir. |
122 |
use vars qw ($tmp); |
use vars qw ($tmp); |
123 |
$tmp = undef; |
$tmp = undef; |
124 |
|
|
125 |
|
=item C<$verbose> |
126 |
|
|
127 |
|
Enable verbosity messages. These messages are meant for ordinary |
128 |
|
users, and typically make explicit the steps being performed. |
129 |
|
|
130 |
|
=cut |
131 |
|
|
132 |
use vars qw ($verbose); |
use vars qw ($verbose); |
133 |
$verbose = 0; |
$verbose = 0; |
134 |
|
|
135 |
|
=item C<$version> |
136 |
|
|
137 |
|
Set to the version message associated to the option C<--version>. |
138 |
|
|
139 |
|
=cut |
140 |
|
|
141 |
use vars qw ($version); |
use vars qw ($version); |
142 |
$version = undef; |
$version = undef; |
143 |
|
|
144 |
|
=back |
145 |
|
|
146 |
|
=cut |
147 |
|
|
148 |
|
|
149 |
## ------------ ## |
## ------------ ## |
150 |
## Prototypes. ## |
## Prototypes. ## |
157 |
## END. ## |
## END. ## |
158 |
## ----- ## |
## ----- ## |
159 |
|
|
160 |
|
=head2 Functions |
161 |
|
|
162 |
|
=over 4 |
163 |
|
|
164 |
|
=item C<END> |
165 |
|
|
166 |
|
Filter Perl's exit codes, delete any temporary directory (unless |
167 |
|
C<$debug>), and exit nonzero whenever closing C<STDOUT> fails. |
168 |
|
|
169 |
|
=cut |
170 |
|
|
171 |
# END |
# END |
172 |
# --- |
# --- |
|
# Filter Perl's exit codes, delete any temporary directory, and exit |
|
|
# nonzero whenever closing STDOUT fails. |
|
173 |
sub END |
sub END |
174 |
{ |
{ |
175 |
# $? contains the exit status we will return. |
# $? contains the exit status we will return. |
228 |
## Functions. ## |
## Functions. ## |
229 |
## ----------- ## |
## ----------- ## |
230 |
|
|
231 |
|
=item C<catfile ()> |
232 |
|
|
233 |
# $BACKPATH |
Wrapper around C<File::Spec->catfile>. Concatenate one or more |
234 |
# &backname ($REL-DIR) |
directory names and a filename to form a complete path ending with a |
235 |
# -------------------- |
filename. |
|
# If I `cd $REL-DIR', then to come back, I should `cd $BACKPATH'. |
|
|
# For instance `src/foo' => `../..'. |
|
|
# Works with non strictly increasing paths, i.e., `src/../lib' => `..'. |
|
|
sub backname ($) |
|
|
{ |
|
|
my ($file) = @_; |
|
|
my $underscore = $_; |
|
|
my @res; |
|
|
|
|
|
foreach (split (/\//, $file)) |
|
|
{ |
|
|
next if $_ eq '.' || $_ eq ''; |
|
|
if ($_ eq '..') |
|
|
{ |
|
|
pop @res; |
|
|
} |
|
|
else |
|
|
{ |
|
|
push (@res, '..'); |
|
|
} |
|
|
} |
|
|
|
|
|
$_ = $underscore; |
|
|
return canonpath (catfile (@res)) |
|
|
} |
|
236 |
|
|
237 |
|
=cut |
238 |
|
|
239 |
# $FILE |
# $FILE |
240 |
# &catfile (@COMPONENT) |
# &catfile (@COMPONENT) |
246 |
} |
} |
247 |
|
|
248 |
|
|
249 |
|
=item C<canonpath ()> |
250 |
|
|
251 |
|
Wrapper around C<File::Spec->canonpath>. No physical check on the |
252 |
|
filesystem, but a logical cleanup of a path. On UNIX eliminates |
253 |
|
successive slashes and successive "/.". |
254 |
|
|
255 |
|
$cpath = canonpath ($path) ; |
256 |
|
|
257 |
|
=cut |
258 |
|
|
259 |
# $FILE |
# $FILE |
260 |
# &canonpath ($FILE) |
# &canonpath ($FILE) |
261 |
# ------------------ |
# ------------------ |
266 |
} |
} |
267 |
|
|
268 |
|
|
269 |
|
=item C<contents ($filename)> |
270 |
|
|
271 |
|
Return the contents of c<$filename>. Exit with diagnostic on failure. |
272 |
|
|
273 |
|
=cut |
274 |
|
|
275 |
|
# &contents ($FILENAME) |
276 |
|
# --------------------- |
277 |
|
# Swallow the contents of file $FILENAME. |
278 |
|
sub contents ($) |
279 |
|
{ |
280 |
|
my ($file) = @_; |
281 |
|
verbose "reading $file"; |
282 |
|
local $/; # Turn on slurp-mode. |
283 |
|
my $f = new Autom4te::XFile "< $file"; |
284 |
|
my $contents = $f->getline; |
285 |
|
$f->close; |
286 |
|
return $contents; |
287 |
|
} |
288 |
|
|
289 |
|
|
290 |
|
=item C<debug (@message)> |
291 |
|
|
292 |
|
If the debug mode is enabled (C<$debug> and C<$verbose>), report the |
293 |
|
C<@message> on C<STDERR>, signed with the name of the program. |
294 |
|
|
295 |
|
=cut |
296 |
|
|
297 |
# &debug(@MESSAGE) |
# &debug(@MESSAGE) |
298 |
# ---------------- |
# ---------------- |
299 |
# Messages displayed only if $DEBUG and $VERBOSE. |
# Messages displayed only if $DEBUG and $VERBOSE. |
304 |
} |
} |
305 |
|
|
306 |
|
|
307 |
|
=item C<error (@message)> |
308 |
|
|
309 |
|
Report the C<@message> on C<STDERR>, signed with the name of the |
310 |
|
program, and exit with failure. If the debug mode is enabled |
311 |
|
(C<$debug>), then in addition dump the call stack. |
312 |
|
|
313 |
|
=cut |
314 |
|
|
315 |
# &error (@MESSAGE) |
# &error (@MESSAGE) |
316 |
# ----------------- |
# ----------------- |
317 |
# Same as die or confess, depending on $debug. |
# Same as die or confess, depending on $debug. |
328 |
} |
} |
329 |
|
|
330 |
|
|
331 |
|
=item C<file_name_is_absolute ($filename)> |
332 |
|
|
333 |
|
Wrapper around C<File::Spec->file_name_is_absolute>. Return true iff |
334 |
|
C<$filename> is absolute. |
335 |
|
|
336 |
|
=cut |
337 |
|
|
338 |
# $BOOLEAN |
# $BOOLEAN |
339 |
# &file_name_is_absolute ($FILE) |
# &file_name_is_absolute ($FILE) |
340 |
# ------------------------------ |
# ------------------------------ |
345 |
} |
} |
346 |
|
|
347 |
|
|
348 |
|
=item C<find_configure_ac ([$directory = C<.>])> |
349 |
|
|
350 |
|
Look for C<configure.ac> or C<configure.in> in the C<$directory> and |
351 |
|
return the one which should be used. Report ambiguities to the user, |
352 |
|
but prefer C<configure.ac>. |
353 |
|
|
354 |
|
=cut |
355 |
|
|
356 |
# $CONFIGURE_AC |
# $CONFIGURE_AC |
357 |
# &find_configure_ac ([$DIRECTORY = `.']) |
# &find_configure_ac ([$DIRECTORY = `.']) |
358 |
# --------------------------------------- |
# --------------------------------------- |
380 |
} |
} |
381 |
|
|
382 |
|
|
383 |
|
=item C<find_file ($filename, @include)> |
384 |
|
|
385 |
|
Return the first path for a C<$filename> in the C<include>s. |
386 |
|
|
387 |
|
We match exactly the behavior of GNU M4: first look in the current |
388 |
|
directory (which includes the case of absolute file names), and, if |
389 |
|
the file is not absolute, just fail. Otherwise, look in C<@include>. |
390 |
|
|
391 |
|
If the file is flagged as optional (ends with C<?>), then return undef |
392 |
|
if absent, otherwise exit with error. |
393 |
|
|
394 |
|
=cut |
395 |
|
|
396 |
# $FILENAME |
# $FILENAME |
397 |
# find_file ($FILENAME, @INCLUDE) |
# find_file ($FILENAME, @INCLUDE) |
398 |
# ------------------------------- |
# ------------------------------- |
|
# We match exactly the behavior of GNU M4: first look in the current |
|
|
# directory (which includes the case of absolute file names), and, if |
|
|
# the file is not absolute, just fail. Otherwise, look in @INCLUDE. |
|
|
# |
|
|
# If the file is flagged as optional (ends with `?'), then return undef |
|
|
# if absent. |
|
399 |
sub find_file ($@) |
sub find_file ($@) |
400 |
{ |
{ |
401 |
my ($filename, @include) = @_; |
my ($filename, @include) = @_; |
427 |
} |
} |
428 |
|
|
429 |
|
|
430 |
|
=item C<getopt (%option)> |
431 |
|
|
432 |
|
Wrapper around C<Getopt::Long>. In addition to the user C<option>s, |
433 |
|
support C<-h>/C<--help>, C<-V>/C<--version>, C<-v>/C<--verbose>, |
434 |
|
C<-d>/C<--debug>, C<-f>/C<--force>. Conform to the GNU Coding |
435 |
|
Standards for error messages. Try to work around a weird behavior |
436 |
|
from C<Getopt::Long> to preserve C<-> as an C<@ARGV> instead of |
437 |
|
rejecting it as a broken option. |
438 |
|
|
439 |
|
=cut |
440 |
|
|
441 |
# getopt (%OPTION) |
# getopt (%OPTION) |
442 |
# ---------------- |
# ---------------- |
443 |
# Handle the %OPTION, plus all the common options. |
# Handle the %OPTION, plus all the common options. |
452 |
my $stdin = grep /^-$/, @ARGV; |
my $stdin = grep /^-$/, @ARGV; |
453 |
@ARGV = grep !/^-$/, @ARGV; |
@ARGV = grep !/^-$/, @ARGV; |
454 |
%option = ("h|help" => sub { print $help; exit 0 }, |
%option = ("h|help" => sub { print $help; exit 0 }, |
455 |
"V|version" => sub { print $version; exit 0 }, |
"V|version" => sub { print $version; exit 0 }, |
456 |
|
|
457 |
"v|verbose" => \$verbose, |
"v|verbose" => \$verbose, |
458 |
"d|debug" => \$debug, |
"d|debug" => \$debug, |
459 |
'f|force' => \$force, |
'f|force' => \$force, |
460 |
|
|
461 |
# User options last, so that they have precedence. |
# User options last, so that they have precedence. |
476 |
} |
} |
477 |
|
|
478 |
|
|
479 |
|
=item C<mktmpdir ($signature)> |
480 |
|
|
481 |
|
Create a temporary directory which name is based on C<$signature>. |
482 |
|
Store its name in C<$tmp>. C<END> is in charge of removing it, unless |
483 |
|
C<$debug>. |
484 |
|
|
485 |
|
=cut |
486 |
|
|
487 |
# mktmpdir ($SIGNATURE) |
# mktmpdir ($SIGNATURE) |
488 |
# --------------------- |
# --------------------- |
|
# Create a temporary directory which name is based on $SIGNATURE. |
|
489 |
sub mktmpdir ($) |
sub mktmpdir ($) |
490 |
{ |
{ |
491 |
my ($signature) = @_; |
my ($signature) = @_; |
493 |
|
|
494 |
# If mktemp supports dirs, use it. |
# If mktemp supports dirs, use it. |
495 |
$tmp = `(umask 077 && |
$tmp = `(umask 077 && |
496 |
mktemp -d -q "$TMPDIR/${signature}XXXXXX") 2>/dev/null`; |
mktemp -d -q "$TMPDIR/${signature}XXXXXX") 2>/dev/null`; |
497 |
chomp $tmp; |
chomp $tmp; |
498 |
|
|
499 |
if (!$tmp || ! -d $tmp) |
if (!$tmp || ! -d $tmp) |
508 |
} |
} |
509 |
|
|
510 |
|
|
511 |
|
=item C<mtime ($file)> |
512 |
|
|
513 |
|
Return the mtime of C<$file>. Missing files, or C<-> standing for |
514 |
|
C<STDIN> or C<STDOUT> are ``obsolete'', i.e., as old as possible. |
515 |
|
|
516 |
|
=cut |
517 |
|
|
518 |
# $MTIME |
# $MTIME |
519 |
# MTIME ($FILE) |
# MTIME ($FILE) |
520 |
# ------------- |
# ------------- |
|
# Return the mtime of $FILE. Missing files, or `-' standing for STDIN |
|
|
# or STDOUT are ``obsolete'', i.e., as old as possible. |
|
521 |
sub mtime ($) |
sub mtime ($) |
522 |
{ |
{ |
523 |
my ($file) = @_; |
my ($file) = @_; |
532 |
} |
} |
533 |
|
|
534 |
|
|
535 |
|
=item C<uniq (@list)> |
536 |
|
|
537 |
|
Return C<@list> with no duplicates, keeping only the first |
538 |
|
occurrences. |
539 |
|
|
540 |
|
=cut |
541 |
|
|
542 |
# @RES |
# @RES |
543 |
# uniq (@LIST) |
# uniq (@LIST) |
544 |
# ------------ |
# ------------ |
|
# Return LIST with no duplicates. |
|
545 |
sub uniq (@) |
sub uniq (@) |
546 |
{ |
{ |
547 |
my @res = (); |
my @res = (); |
558 |
} |
} |
559 |
|
|
560 |
|
|
561 |
|
=item C<up_to_date_p ($file, @dep)> |
562 |
|
|
563 |
|
Is C<$file> more recent than C<@dep>? |
564 |
|
|
565 |
|
=cut |
566 |
|
|
567 |
# $BOOLEAN |
# $BOOLEAN |
568 |
# &up_to_date_p ($FILE, @DEPS) |
# &up_to_date_p ($FILE, @DEP) |
569 |
# ---------------------------- |
# --------------------------- |
|
# Is $FILE more recent than @DEPS? |
|
570 |
sub up_to_date_p ($@) |
sub up_to_date_p ($@) |
571 |
{ |
{ |
572 |
my ($file, @dep) = @_; |
my ($file, @dep) = @_; |
586 |
} |
} |
587 |
|
|
588 |
|
|
589 |
|
=item C<update_file ($from, $to)> |
590 |
|
|
591 |
|
Rename C<$from> as C<$to>, preserving C<$to> timestamp if it has not |
592 |
|
changed. Recognize C<$to> = C<-> standing for C<STDIN>. C<$from> is |
593 |
|
always removed/renamed. |
594 |
|
|
595 |
|
=cut |
596 |
|
|
597 |
# &update_file ($FROM, $TO) |
# &update_file ($FROM, $TO) |
598 |
# ------------------------- |
# ------------------------- |
|
# Rename $FROM as $TO, preserving $TO timestamp if it has not changed. |
|
|
# Recognize `$TO = -' standing for stdin. $FROM is always removed/renamed. |
|
599 |
sub update_file ($$) |
sub update_file ($$) |
600 |
{ |
{ |
601 |
my ($from, $to) = @_; |
my ($from, $to) = @_; |
644 |
} |
} |
645 |
|
|
646 |
|
|
647 |
|
=item C<verbose (@message)> |
648 |
|
|
649 |
|
If the verbose mode is enabled (C<$verbose>), report the C<@message> |
650 |
|
on C<STDERR>, signed with the name of the program. These messages are |
651 |
|
meant for ordinary users, and typically make explicit the steps being |
652 |
|
performed. |
653 |
|
|
654 |
|
=cut |
655 |
|
|
656 |
# verbose(@MESSAGE) |
# verbose(@MESSAGE) |
657 |
# ----------------- |
# ----------------- |
658 |
sub verbose (@) |
sub verbose (@) |
661 |
if $verbose; |
if $verbose; |
662 |
} |
} |
663 |
|
|
664 |
|
|
665 |
|
=item C<handle_exec_errors ($command)> |
666 |
|
|
667 |
|
Display an error message for C<$command>, based on the content of |
668 |
|
C<$?> and C<$!>. |
669 |
|
|
670 |
|
=cut |
671 |
|
|
672 |
|
|
673 |
# handle_exec_errors ($COMMAND) |
# handle_exec_errors ($COMMAND) |
674 |
# ----------------------------- |
# ----------------------------- |
|
# Display an error message for $COMMAND, based on the content of $? and $!. |
|
675 |
sub handle_exec_errors ($) |
sub handle_exec_errors ($) |
676 |
{ |
{ |
677 |
my ($command) = @_; |
my ($command) = @_; |
707 |
} |
} |
708 |
} |
} |
709 |
|
|
710 |
|
|
711 |
|
=item C<xqx ($command)> |
712 |
|
|
713 |
|
Same as C<qx> (but in scalar context), but fails on errors. |
714 |
|
|
715 |
|
=cut |
716 |
|
|
717 |
# xqx ($COMMAND) |
# xqx ($COMMAND) |
718 |
# -------------- |
# -------------- |
|
# Same as `qx' (but in scalar context), but fails on errors. |
|
719 |
sub xqx ($) |
sub xqx ($) |
720 |
{ |
{ |
721 |
my ($command) = @_; |
my ($command) = @_; |
731 |
} |
} |
732 |
|
|
733 |
|
|
734 |
|
=item C<xqx ($command)> |
735 |
|
|
736 |
|
Same as C<xsystem>, but fails on errors, and reports the C<$command> |
737 |
|
in verbose mode. |
738 |
|
|
739 |
|
=cut |
740 |
|
|
741 |
# xsystem ($COMMAND) |
# xsystem ($COMMAND) |
742 |
# ------------------ |
# ------------------ |
743 |
sub xsystem ($) |
sub xsystem ($) |
751 |
if system $command; |
if system $command; |
752 |
} |
} |
753 |
|
|
754 |
|
=back |
755 |
|
|
756 |
|
=head1 SEE ALSO |
757 |
|
|
758 |
|
L<Autom4te::XFile> |
759 |
|
|
760 |
|
=head1 HISTORY |
761 |
|
|
762 |
|
Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt> and Akim |
763 |
|
Demaille E<lt>F<akim@freefriends.org>E<gt>. |
764 |
|
|
765 |
|
=cut |
766 |
|
|
767 |
|
|
768 |
|
|
769 |
1; # for require |
1; # for require |
770 |
|
|