/[autoconf]/autoconf/lib/Autom4te/General.pm
ViewVC logotype

Diff of /autoconf/lib/Autom4te/General.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.26 by adl, Sun May 25 11:02:21 2003 UTC revision 1.27 by akim, Mon Jun 2 06:55:04 2003 UTC
# Line 18  Line 18 
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;
# Line 37  my @export_vars = Line 52  my @export_vars =
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);
# Line 48  my @export_forward_subs = Line 63  my @export_forward_subs =
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.  ##
# Line 86  sub verbose (@); Line 157  sub verbose (@);
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.
# Line 149  sub END Line 228  sub END
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)
# Line 190  sub catfile (@) Line 246  sub catfile (@)
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  # ------------------  # ------------------
# Line 200  sub canonpath ($) Line 266  sub canonpath ($)
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.
# Line 210  sub debug (@) Line 304  sub debug (@)
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.
# Line 226  sub error (@) Line 328  sub error (@)
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  # ------------------------------  # ------------------------------
# Line 236  sub file_name_is_absolute ($) Line 345  sub file_name_is_absolute ($)
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  # ---------------------------------------  # ---------------------------------------
# Line 263  sub find_configure_ac (;$) Line 380  sub find_configure_ac (;$)
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) = @_;
# Line 303  sub find_file ($@) Line 427  sub find_file ($@)
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.
# Line 317  sub getopt (%) Line 452  sub getopt (%)
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.
# Line 341  sub getopt (%) Line 476  sub getopt (%)
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) = @_;
# Line 351  sub mktmpdir ($) Line 493  sub mktmpdir ($)
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)
# Line 366  sub mktmpdir ($) Line 508  sub mktmpdir ($)
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) = @_;
# Line 385  sub mtime ($) Line 532  sub mtime ($)
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 = ();
# Line 405  sub uniq (@) Line 558  sub uniq (@)
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) = @_;
# Line 428  sub up_to_date_p ($@) Line 586  sub up_to_date_p ($@)
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) = @_;
# Line 480  sub update_file ($$) Line 644  sub update_file ($$)
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 (@)
# Line 488  sub verbose (@) Line 661  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) = @_;
# Line 526  sub handle_exec_errors ($) Line 707  sub handle_exec_errors ($)
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) = @_;
# Line 544  sub xqx ($) Line 731  sub xqx ($)
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 ($)
# Line 557  sub xsystem ($) Line 751  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    

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26