+2001-10-02 Akim Demaille <akim@epita.fr>
+
+ * lib/Automake/Struct.pm: Update from Autoconf.
+ * lib/Automake/General.pm, lib/Automake/XFile.pm: New, from CVS
+ Autoconf.
+ * automake.in: Use them.
+ (&uniq, $me): Remove, as they are provided by Automake::General.
+
2001-10-02 Alexandre Duret-Lutz <duret_g@epita.fr>
* Makefile.am (maintainer-check): Don't check for 'cd' calls in m4.
require 5.005;
use strict 'vars', 'subs';
-use File::Basename;
+use Automake::General;
+use Automake::XFile;
use IO::File;
-
-my $me = basename ($0);
-
+use File::Basename;
## ----------- ##
## Constants. ##
}
-# @RES
-# uniq (@LIST)
-# ------------
-# Return LIST with no duplicates.
-sub uniq (@)
-{
- my @res = ();
- my %seen = ();
- foreach my $item (@_)
- {
- if (! defined $seen{$item})
- {
- $seen{$item} = 1;
- push (@res, $item);
- }
- }
- return @res;
-}
-
# subst ($TEXT)
# -------------
# Return a configure-style substitution using the indicated text.
$traces .= ' -t AC_LIBSOURCE';
$traces .= ' -t AC_SUBST';
- my $tracefh = new IO::File ("$traces |");
- if (! $tracefh)
- {
- die "$me: couldn't open `$traces': $!\n";
- }
+ my $tracefh = new Automake::XFile ("$traces |");
print "$me: reading $traces\n" if $verbose;
while ($_ = $tracefh->getline)
{
my ($filename) = @_;
- my $configfh = new IO::File ("< $filename");
- if (! $configfh)
- {
- die "$me: couldn't open `$filename': $!\n";
- }
+ my $configfh = new Automake::XFile ("< $filename");
print "$me: reading $filename\n" if $verbose;
my ($in_ac_output, $in_ac_replace) = (0, 0);
{
my ($amfile) = @_;
- my $am_file = new IO::File ("< $amfile");
- if (! $am_file)
- {
- die "$me: couldn't open `$amfile': $!\n";
- }
+ my $am_file = new Automake::XFile ("< $amfile");
print "$me: reading $amfile\n" if $verbose;
my $spacing = '';
. 's/\n{3,}/\n\n/g';
# Swallow the file and apply the COMMAND.
- my $fc_file = new IO::File ("< $file");
- if (! $fc_file)
- {
- die "$me: installation error: cannot open `$file'\n";
- }
+ my $fc_file = new Automake::XFile ("< $file");
# Looks stupid?
print "$me: reading $file\n"
if $verbose;
--- /dev/null
+# Copyright 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+package Automake::General;
+
+use 5.005;
+use Exporter;
+use File::Basename;
+use File::stat;
+use IO::File;
+use Carp;
+use strict;
+
+use vars qw (@ISA @EXPORT);
+
+@ISA = qw (Exporter);
+@EXPORT = qw (&debug &find_configure_ac &find_file &getopt &mktmpdir &mtime
+ &uniq &update_file &verbose &xsystem
+ $debug $help $me $tmp $verbose $version);
+
+# Variable we share with the main package. Be sure to have a single
+# copy of them: using `my' together with multiple inclusion of this
+# package would introduce several copies.
+use vars qw ($debug);
+$debug = 0;
+
+use vars qw ($help);
+$help = undef;
+
+use vars qw ($me);
+$me = basename ($0);
+
+# Our tmp dir.
+use vars qw ($tmp);
+$tmp = undef;
+
+use vars qw ($verbose);
+$verbose = 0;
+
+use vars qw ($version);
+$version = undef;
+
+
+# END
+# ---
+# Exit nonzero whenever closing STDOUT fails.
+# Ideally we should `exit ($? >> 8)', unfortunately, for some reason
+# I don't understand, whenever we `exit (1)' somewhere in the code,
+# we arrive here with `$? = 29'. I suspect some low level END routine
+# might be responsible. In this case, be sure to exit 1, not 29.
+sub END
+{
+ my $exit_status = $? ? 1 : 0;
+
+ use POSIX qw (_exit);
+
+ if (!$debug && defined $tmp && -d $tmp)
+ {
+ if (<$tmp/*>)
+ {
+ unlink <$tmp/*>
+ or carp ("$me: cannot empty $tmp: $!\n"), _exit (1);
+ }
+ rmdir $tmp
+ or carp ("$me: cannot remove $tmp: $!\n"), _exit (1);
+ }
+
+ # This is required if the code might send any output to stdout
+ # E.g., even --version or --help. So it's best to do it unconditionally.
+ close STDOUT
+ or (carp "$me: closing standard output: $!\n"), _exit (1);
+
+ _exit ($exit_status);
+}
+
+
+# debug(@MESSAGE)
+# ---------------
+# Messages displayed only if $DEBUG and $VERBOSE.
+sub debug (@)
+{
+ print STDERR "$me: ", @_, "\n"
+ if $verbose && $debug;
+}
+
+
+# $CONFIGURE_AC
+# &find_configure_ac ()
+# ---------------------
+sub find_configure_ac ()
+{
+ if (-f 'configure.ac')
+ {
+ if (-f 'configure.in')
+ {
+ carp "warning: `configure.ac' and `configure.in' both present.\n";
+ carp "warning: proceeding with `configure.ac'.\n";
+ }
+ return 'configure.ac';
+ }
+ elsif (-f 'configure.in')
+ {
+ return 'configure.in';
+ }
+ return;
+}
+
+
+# $FILENAME
+# find_file ($FILENAME, @INCLUDE)
+# -------------------------------
+# 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 the path.
+#
+# If the file is flagged as optional (ends with `?'), then return undef
+# if absent.
+sub find_file ($@)
+{
+ use File::Spec;
+
+ my ($filename, @include) = @_;
+ my $optional = 0;
+
+ $optional = 1
+ if $filename =~ s/\?$//;
+
+ return File::Spec->canonpath ($filename)
+ if -e $filename;
+
+ if (File::Spec->file_name_is_absolute ($filename))
+ {
+ die "$me: no such file or directory: $filename\n"
+ unless $optional;
+ return undef;
+ }
+
+ foreach my $path (reverse @include)
+ {
+ return File::Spec->canonpath (File::Spec->catfile ($path, $filename))
+ if -e File::Spec->catfile ($path, $filename)
+ }
+
+ die "$me: no such file or directory: $filename\n"
+ unless $optional;
+
+ return undef;
+}
+
+
+# getopt (%OPTION)
+# ----------------
+# Handle the %OPTION, plus all the common options.
+# Work around Getopt bugs wrt `-'.
+sub getopt (%)
+{
+ my (%option) = @_;
+ use Getopt::Long;
+
+ # F*k. Getopt seems bogus and dies when given `-' with `bundling'.
+ # If fixed some day, use this: '' => sub { push @ARGV, "-" }
+ my $stdin = grep /^-$/, @ARGV;
+ @ARGV = grep !/^-$/, @ARGV;
+ %option = (%option,
+ "h|help" => sub { print $help; exit 0 },
+ "V|version" => sub { print $version; exit 0 },
+
+ "v|verbose" => \$verbose,
+ "d|debug" => \$debug,
+ );
+ Getopt::Long::Configure ("bundling");
+ GetOptions (%option)
+ or exit 1;
+
+ push @ARGV, '-'
+ if $stdin;
+}
+
+
+# mktmpdir ($SIGNATURE)
+# ---------------------
+# Create a temporary directory which name is based on $SIGNATURE.
+sub mktmpdir ($)
+{
+ my ($signature) = @_;
+ my $TMPDIR = $ENV{'TMPDIR'} || '/tmp';
+
+ # If mktemp supports dirs, use it.
+ $tmp = `(umask 077 &&
+ mktemp -d -q "$TMPDIR/${signature}XXXXXX") 2>/dev/null`;
+ chomp $tmp;
+
+ if (!$tmp || ! -d $tmp)
+ {
+ $tmp = "$TMPDIR/$signature" . int (rand 10000) . ".$$";
+ mkdir $tmp, 0700
+ or croak "$me: cannot create $tmp: $!\n";
+ }
+
+ print STDERR "$me:$$: working in $tmp\n"
+ if $debug;
+}
+
+
+# $MTIME
+# MTIME ($FILE)
+# -------------
+# Return the mtime of $FILE. Missing files, or `-' standing for STDIN
+# or STDOUT are ``obsolete'', i.e., as old as possible.
+sub mtime ($)
+{
+ my ($file) = @_;
+
+ return 0
+ if $file eq '-' || ! -f $file;
+
+ my $stat = stat ($file)
+ or croak "$me: cannot stat $file: $!\n";
+
+ return $stat->mtime;
+}
+
+
+# @RES
+# uniq (@LIST)
+# ------------
+# Return LIST with no duplicates.
+sub uniq (@)
+{
+ my @res = ();
+ my %seen = ();
+ foreach my $item (@_)
+ {
+ if (! exists $seen{$item})
+ {
+ $seen{$item} = 1;
+ push (@res, $item);
+ }
+ }
+ return wantarray ? @res : "@res";
+}
+
+
+# &update_file ($FROM, $TO)
+# -------------------------
+# Rename $FROM as $TO, preserving $TO timestamp if it has not changed.
+# Recognize `$TO = -' standing for stdin.
+sub update_file ($$)
+{
+ my ($from, $to) = @_;
+ my $SIMPLE_BACKUP_SUFFIX = $ENV{'SIMPLE_BACKUP_SUFFIX'} || '~';
+ use File::Compare;
+ use File::Copy;
+
+ if ($to eq '-')
+ {
+ my $in = new IO::File ("$from");
+ my $out = new IO::File (">-");
+ while ($_ = $in->getline)
+ {
+ print $out $_;
+ }
+ $in->close;
+ unlink ($from)
+ or die "$me: cannot not remove $from: $!\n";
+ return;
+ }
+
+ if (-f "$to" && compare ("$from", "$to") == 0)
+ {
+ # File didn't change, so don't update its mod time.
+ print STDERR "$me: `$to' is unchanged\n";
+ return
+ }
+
+ if (-f "$to")
+ {
+ # Back up and install the new one.
+ move ("$to", "$to$SIMPLE_BACKUP_SUFFIX")
+ or die "$me: cannot not backup $to: $!\n";
+ move ("$from", "$to")
+ or die "$me: cannot not rename $from as $to: $!\n";
+ print STDERR "$me: `$to' is updated\n";
+ }
+ else
+ {
+ move ("$from", "$to")
+ or die "$me: cannot not rename $from as $to: $!\n";
+ print STDERR "$me: `$to' is created\n";
+ }
+}
+
+
+# verbose(@MESSAGE)
+# -----------------
+sub verbose (@)
+{
+ print STDERR "$me: ", @_, "\n"
+ if $verbose;
+}
+
+
+# xsystem ($COMMAND)
+# ------------------
+sub xsystem ($)
+{
+ my ($command) = @_;
+
+ verbose "running: $command";
+
+ (system $command) == 0
+ or croak ("$me: "
+ . (split (' ', $command))[0]
+ . " failed with exit status: "
+ . ($? >> 8)
+ . "\n");
+}
+
+
+1; # for require
## Process this file with automake to create Makefile.in
perllibdir = $(pkgdatadir)/Automake
-dist_perllib_DATA = Struct.pm
+dist_perllib_DATA = Struct.pm General.pm XFile.pm
AUTOMAKE = @AUTOMAKE@
AUTOHEADER = @AUTOHEADER@
+am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
+
+EXEEXT = @EXEEXT@
+OBJEXT = @OBJEXT@
+PATH_SEPARATOR = @PATH_SEPARATOR@
AMTAR = @AMTAR@
AWK = @AWK@
DEPDIR = @DEPDIR@
-EXEEXT = @EXEEXT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
-OBJEXT = @OBJEXT@
PACKAGE = @PACKAGE@
PERL = @PERL@
VERSION = @VERSION@
install_sh = @install_sh@
perllibdir = $(pkgdatadir)/Automake
-dist_perllib_DATA = Struct.pm
+dist_perllib_DATA = Struct.pm General.pm XFile.pm
subdir = lib/Automake
mkinstalldirs = $(SHELL) $(top_srcdir)/lib/mkinstalldirs
CONFIG_CLEAN_FILES =
-# automake - create Makefile.in from Makefile.am
-# Copyright 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
-# Free Software Foundation, Inc.
+# autoconf -- create `configure' using m4 macros
+# Copyright 2001 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.
-# Originally written by David Mackenzie <djm@gnu.ai.mit.edu>.
-# Perl reimplementation by Tom Tromey <tromey@cygnus.com>.
+# This file is basically Perl 5.6's Class::Struct, but made compatible
+# with Perl 5.5. If someday this has to be updated, be sure to rename
+# all the occurrences of Class::Struct into Automake::Struct, otherwise
+# if we `use' a Perl module (e.g., File::stat) that uses Class::Struct,
+# we would have two packages defining the same symbols. Boom.
package Automake::Struct;
}
{
- package Class::Struct::Tie_ISA;
+ package Automake::Struct::Tie_ISA;
sub TIEARRAY {
my $class = shift;
sub STORE {
my ($self, $index, $value) = @_;
- Class::Struct::_subclass_error();
+ Automake::Struct::_subclass_error();
}
sub FETCH {
\@{$class . '::ISA'};
};
_subclass_error() if @$isa;
- tie @$isa, 'Class::Struct::Tie_ISA';
+ tie @$isa, 'Automake::Struct::Tie_ISA';
# Create constructor.
=head1 NAME
-Class::Struct - declare struct-like datatypes as Perl classes
+Automake::Struct - declare struct-like datatypes as Perl classes
=head1 SYNOPSIS
- use Class::Struct;
+ use Automake::Struct;
# declare struct, based on array:
struct( CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]);
# declare struct, based on hash:
struct( CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... });
package CLASS_NAME;
- use Class::Struct;
+ use Automake::Struct;
# declare struct, based on array, implicit class name:
struct( ELEMENT_NAME => ELEMENT_TYPE, ... );
package Myobj;
- use Class::Struct;
+ use Automake::Struct;
# declare struct with four types of elements:
struct( s => '$', a => '@', h => '%', c => 'My_Other_Class' );
=head1 DESCRIPTION
-C<Class::Struct> exports a single function, C<struct>.
+C<Automake::Struct> exports a single function, C<struct>.
Given a list of element names and types, and optionally
a class name, C<struct> creates a Perl 5 class that implements
a "struct-like" data structure.
microseconds), and C<rusage> has two elements, each of which is of
type C<timeval>.
- use Class::Struct;
+ use Automake::Struct;
struct( rusage => {
ru_utime => timeval, # seconds
accessor accordingly.
package MyObj;
- use Class::Struct;
+ use Automake::Struct;
# declare the struct
struct ( 'MyObj', { count => '$', stuff => '%' } );
struct's constructor.
- use Class::Struct;
+ use Automake::Struct;
struct Breed =>
{
=head1 Author and Modification History
+Modified by Akim Demaille, 2001-08-03
+
+ Rename as Automake::Struct to avoid name clashes with
+ Class::Struct.
+
+ Make it compatible with Perl 5.5.
Modified by Damian Conway, 1999-03-05, v0.58.
--- /dev/null
+# Copyright 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# Written by Akim Demaille <akim@freefriends.org>.
+
+package Automake::XFile;
+
+=head1 NAME
+
+Automake::XFile - supply object methods for filehandles with error handling
+
+=head1 SYNOPSIS
+
+ use Automake::XFile;
+
+ $fh = new Automake::XFile;
+ $fh->open("< file"))
+ # No need to check $FH: we died if open failed.
+ print <$fh>;
+ $fh->close;
+ # No need to check the return value of close: we died if it failed.
+
+ $fh = new Automake::XFile "> file";
+ # No need to check $FH: we died if new failed.
+ print $fh "bar\n";
+ $fh->close;
+
+ $fh = new Automake::XFile "file", "r";
+ # No need to check $FH: we died if new failed.
+ defined $fh
+ print <$fh>;
+ undef $fh; # automatically closes the file and checks for errors.
+
+ $fh = new Automake::XFile "file", O_WRONLY|O_APPEND;
+ # No need to check $FH: we died if new failed.
+ print $fh "corge\n";
+
+ $pos = $fh->getpos;
+ $fh->setpos($pos);
+
+ undef $fh; # automatically closes the file and checks for errors.
+
+ autoflush STDOUT 1;
+
+=head1 DESCRIPTION
+
+C<Automake::XFile> inherits from C<IO::File>. It provides dying
+version of the methods C<open>, C<new>, and C<close>.
+
+=head1 SEE ALSO
+
+L<perlfunc>,
+L<perlop/"I/O Operators">,
+L<IO::File>
+L<IO::Handle>
+L<IO::Seekable>
+
+=head1 HISTORY
+
+Derived from IO::File.pm by Akim Demaille E<lt>F<akim@freefriends.org>E<gt>.
+
+=cut
+
+require 5.000;
+use strict;
+use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA);
+use Carp;
+use File::Basename;
+
+require Exporter;
+require DynaLoader;
+
+@ISA = qw(IO::File Exporter DynaLoader);
+
+$VERSION = "1.0";
+
+@EXPORT = @IO::File::EXPORT;
+
+eval {
+ # Make all Fcntl O_XXX constants available for importing
+ require Fcntl;
+ my @O = grep /^O_/, @Fcntl::EXPORT;
+ Fcntl->import(@O); # first we import what we want to export
+ push(@EXPORT, @O);
+};
+
+
+################################################
+## Constructor
+##
+
+sub new
+{
+ my $type = shift;
+ my $class = ref($type) || $type || "Automake::XFile";
+ my $fh = $class->SUPER::new ();
+ if (@_)
+ {
+ $fh->open (@_);
+ }
+ $fh;
+}
+
+################################################
+## Open
+##
+
+sub open
+{
+ my ($fh) = shift;
+ my ($file) = @_;
+
+ # WARNING: Gross hack: $FH is a typeglob: use its hash slot to store
+ # the `name' of the file we are opening. See the example with
+ # io_socket_timeout in IO::Socket for more, and read Graham's
+ # comment in IO::Handle.
+ ${*$fh}{'autom4te_xfile_file'} = "$file";
+
+ if (!$fh->SUPER::open (@_))
+ {
+ my $me = basename ($0);
+ croak "$me: cannot open $file: $!\n";
+ }
+ binmode $fh if $file =~ /^\s*>/;
+}
+
+################################################
+## Close
+##
+
+sub close
+{
+ my ($fh) = shift;
+ if (!$fh->SUPER::close (@_))
+ {
+ my $me = basename ($0);
+ my $file = ${*$fh}{'autom4te_xfile_file'};
+ croak "$me: cannot close $file: $!\n";
+ }
+}
+
+1;
projects / thirdparty / automake.git / commitdiff
