From e7f3fbdcfe12ad55ab88f85eed664cbe5ff28d36 Mon Sep 17 00:00:00 2001 From: Akim Demaille Date: Tue, 2 Oct 2001 17:17:42 +0000 Subject: [PATCH] * 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. --- ChangeLog | 8 + automake.in | 50 +----- lib/Automake/General.pm | 334 +++++++++++++++++++++++++++++++++++++++ lib/Automake/Makefile.am | 2 +- lib/Automake/Makefile.in | 9 +- lib/Automake/Struct.pm | 40 +++-- lib/Automake/XFile.pm | 156 ++++++++++++++++++ 7 files changed, 536 insertions(+), 63 deletions(-) create mode 100644 lib/Automake/General.pm create mode 100644 lib/Automake/XFile.pm diff --git a/ChangeLog b/ChangeLog index 0ac8fc64..23670a4b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2001-10-02 Akim Demaille + + * 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 * Makefile.am (maintainer-check): Don't check for 'cd' calls in m4. diff --git a/automake.in b/automake.in index a41bcaeb..14c15543 100755 --- a/automake.in +++ b/automake.in @@ -112,11 +112,10 @@ package Automake; 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. ## @@ -1040,25 +1039,6 @@ sub prog_error (@) } -# @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. @@ -4474,11 +4454,7 @@ sub scan_autoconf_traces $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) @@ -4529,11 +4505,7 @@ sub scan_one_autoconf_file { 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); @@ -6662,11 +6634,7 @@ sub read_am_file { 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 = ''; @@ -7016,11 +6984,7 @@ sub make_paragraphs ($%) . '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; diff --git a/lib/Automake/General.pm b/lib/Automake/General.pm new file mode 100644 index 00000000..2bd7a49e --- /dev/null +++ b/lib/Automake/General.pm @@ -0,0 +1,334 @@ +# 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 diff --git a/lib/Automake/Makefile.am b/lib/Automake/Makefile.am index 0321d192..3de266fd 100644 --- a/lib/Automake/Makefile.am +++ b/lib/Automake/Makefile.am @@ -1,4 +1,4 @@ ## 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 diff --git a/lib/Automake/Makefile.in b/lib/Automake/Makefile.in index 19e7126e..88fe5b9d 100644 --- a/lib/Automake/Makefile.in +++ b/lib/Automake/Makefile.in @@ -43,6 +43,7 @@ AUTOCONF = @AUTOCONF@ AUTOMAKE = @AUTOMAKE@ AUTOHEADER = @AUTOHEADER@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd INSTALL = @INSTALL@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_DATA = @INSTALL_DATA@ @@ -55,12 +56,14 @@ POST_INSTALL = : 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@ @@ -69,7 +72,7 @@ am__quote = @am__quote@ 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 = diff --git a/lib/Automake/Struct.pm b/lib/Automake/Struct.pm index f75ae8d6..68c66aac 100644 --- a/lib/Automake/Struct.pm +++ b/lib/Automake/Struct.pm @@ -1,6 +1,5 @@ -# 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 @@ -17,8 +16,11 @@ # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. -# Originally written by David Mackenzie . -# Perl reimplementation by Tom Tromey . +# 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; @@ -47,7 +49,7 @@ sub printem { } { - package Class::Struct::Tie_ISA; + package Automake::Struct::Tie_ISA; sub TIEARRAY { my $class = shift; @@ -56,7 +58,7 @@ sub printem { sub STORE { my ($self, $index, $value) = @_; - Class::Struct::_subclass_error(); + Automake::Struct::_subclass_error(); } sub FETCH { @@ -106,7 +108,7 @@ sub struct { \@{$class . '::ISA'}; }; _subclass_error() if @$isa; - tie @$isa, 'Class::Struct::Tie_ISA'; + tie @$isa, 'Automake::Struct::Tie_ISA'; # Create constructor. @@ -248,24 +250,24 @@ __END__ =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' ); @@ -293,7 +295,7 @@ Class::Struct - declare struct-like datatypes as Perl classes =head1 DESCRIPTION -C exports a single function, C. +C exports a single function, C. Given a list of element names and types, and optionally a class name, C creates a Perl 5 class that implements a "struct-like" data structure. @@ -443,7 +445,7 @@ structs are nested. Here, C represents a time (seconds and microseconds), and C has two elements, each of which is of type C. - use Class::Struct; + use Automake::Struct; struct( rusage => { ru_utime => timeval, # seconds @@ -474,7 +476,7 @@ element always to be nonnegative, so we redefine the C accessor accordingly. package MyObj; - use Class::Struct; + use Automake::Struct; # declare the struct struct ( 'MyObj', { count => '$', stuff => '%' } ); @@ -514,7 +516,7 @@ as an anonymous hash of initializers, which is passed on to the nested struct's constructor. - use Class::Struct; + use Automake::Struct; struct Breed => { @@ -545,6 +547,12 @@ struct's constructor. =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. diff --git a/lib/Automake/XFile.pm b/lib/Automake/XFile.pm new file mode 100644 index 00000000..835e0d84 --- /dev/null +++ b/lib/Automake/XFile.pm @@ -0,0 +1,156 @@ +# 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 . + +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 inherits from C. It provides dying +version of the methods C, C, and C. + +=head1 SEE ALSO + +L, +L, +L +L +L + +=head1 HISTORY + +Derived from IO::File.pm by Akim Demaille EFE. + +=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; -- 2.43.5