1 files changed, 319 insertions, 0 deletions
diff --git a/lib/Autom4te/XFile.pm b/lib/Autom4te/XFile.pm
new file mode 100644
index 0000000..28d5bc6
--- /dev/null
+++ b/lib/Autom4te/XFile.pm
@@ -0,0 +1,319 @@
+# Copyright (C) 2001-2012 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, see <http://www.gnu.org/licenses/>.
+
+# Written by Akim Demaille <akim@freefriends.org>.
+
+###############################################################
+# The main copy of this file is in Automake's git repository. #
+# Updates should be sent to automake-patches@gnu.org.         #
+###############################################################
+
+package Autom4te::XFile;
+
+=head1 NAME
+
+Autom4te::XFile - supply object methods for filehandles with error handling
+
+=head1 SYNOPSIS
+
+    use Autom4te::XFile;
+
+    $fh = new Autom4te::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 Autom4te::XFile "> file";
+    # No need to check $FH: we died if new failed.
+    print $fh "bar\n";
+    $fh->close;
+
+    $fh = new Autom4te::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 Autom4te::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<Autom4te::XFile> inherits from C<IO::File>.  It provides the method
+C<name> returning the file name.  It provides dying versions of the
+methods C<close>, C<lock> (corresponding to C<flock>), C<new>,
+C<open>, C<seek>, and C<truncate>.  It also overrides the C<getline>
+and C<getlines> methods to translate C<\r\n> to C<\n>.
+
+=cut
+
+use 5.006;
+use strict;
+use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA);
+use Carp;
+use Errno;
+use IO::File;
+use File::Basename;
+use Autom4te::ChannelDefs;
+use Autom4te::Channels qw(msg);
+use Autom4te::FileUtils;
+
+require Exporter;
+require DynaLoader;
+
+@ISA = qw(IO::File Exporter DynaLoader);
+
+$VERSION = "1.2";
+
+@EXPORT = @IO::File::EXPORT;
+
+eval {
+  # Make all Fcntl O_XXX and LOCK_XXX constants available for importing
+  require Fcntl;
+  my @O = grep /^(LOCK|O)_/, @Fcntl::EXPORT, @Fcntl::EXPORT_OK;
+  Fcntl->import (@O);  # first we import what we want to export
+  push (@EXPORT, @O);
+};
+
+=head2 Methods
+
+=over
+
+=item C<$fh = new Autom4te::XFile ([$expr, ...]>
+
+Constructor a new XFile object.  Additional arguments
+are passed to C<open>, if any.
+
+=cut
+
+sub new
+{
+  my $type = shift;
+  my $class = ref $type || $type || "Autom4te::XFile";
+  my $fh = $class->SUPER::new ();
+  if (@_)
+    {
+      $fh->open (@_);
+    }
+  $fh;
+}
+
+=item C<$fh-E<gt>open ([$file, ...])>
+
+Open a file, passing C<$file> and further arguments to C<IO::File::open>.
+Die if opening fails.  Store the name of the file.  Use binmode for writing.
+
+=cut
+
+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 (@_))
+    {
+      fatal "cannot open $file: $!";
+    }
+
+  # In case we're running under MSWindows, don't write with CRLF.
+  # (This circumvents a bug in at least Cygwin bash where the shell
+  # parsing fails on lines ending with the continuation character '\'
+  # and CRLF).
+  binmode $fh if $file =~ /^\s*>/;
+}
+
+=item C<$fh-E<gt>close>
+
+Close the file, handling errors.
+
+=cut
+
+sub close
+{
+  my $fh = shift;
+  if (!$fh->SUPER::close (@_))
+    {
+      my $file = $fh->name;
+      Autom4te::FileUtils::handle_exec_errors $file
+	unless $!;
+      fatal "cannot close $file: $!";
+    }
+}
+
+=item C<$line = $fh-E<gt>getline>
+
+Read and return a line from the file.  Ensure C<\r\n> is translated to
+C<\n> on input files.
+
+=cut
+
+# Some native Windows/perl installations fail to translate \r\n to \n on
+# input so we do that here.
+sub getline
+{
+  local $_ = $_[0]->SUPER::getline;
+  # Perform a _global_ replacement: $_ may can contains many lines
+  # in slurp mode ($/ = undef).
+  s/\015\012/\n/gs if defined $_;
+  return $_;
+}
+
+=item C<@lines = $fh-E<gt>getlines>
+
+Slurp lines from the files.
+
+=cut
+
+sub getlines
+{
+  my @res = ();
+  my $line;
+  push @res, $line while $line = $_[0]->getline;
+  return @res;
+}
+
+=item C<$name = $fh-E<gt>name>
+
+Return the name of the file.
+
+=cut
+
+sub name
+{
+  my $fh = shift;
+  return ${*$fh}{'autom4te_xfile_file'};
+}
+
+=item C<$fh-E<gt>lock>
+
+Lock the file using C<flock>.  If locking fails for reasons other than
+C<flock> being unsupported, then error out if C<$ENV{'MAKEFLAGS'}> indicates
+that we are spawned from a parallel C<make>.
+
+=cut
+
+sub lock
+{
+  my ($fh, $mode) = @_;
+  # Cannot use @_ here.
+
+  # Unless explicitly configured otherwise, Perl implements its 'flock' with the
+  # first of flock(2), fcntl(2), or lockf(3) that works.  These can fail on
+  # NFS-backed files, with ENOLCK (GNU/Linux) or EOPNOTSUPP (FreeBSD); we
+  # usually ignore these errors.  If $ENV{MAKEFLAGS} suggests that a parallel
+  # invocation of 'make' has invoked the tool we serve, report all locking
+  # failures and abort.
+  #
+  # On Unicos, flock(2) and fcntl(2) over NFS hang indefinitely when 'lockd' is
+  # not running.  NetBSD NFS clients silently grant all locks.  We do not
+  # attempt to defend against these dangers.
+  #
+  # -j is for parallel BSD make, -P is for parallel HP-UX make.
+  if (!flock ($fh, $mode))
+    {
+      my $make_j = (exists $ENV{'MAKEFLAGS'}
+		    && " -$ENV{'MAKEFLAGS'}" =~ / (-[BdeikrRsSw]*[jP]|--[jP]|---?jobs)/);
+      my $note = "\nforgo \"make -j\" or use a file system that supports locks";
+      my $file = $fh->name;
+
+      msg ($make_j ? 'fatal' : 'unsupported',
+	   "cannot lock $file with mode $mode: $!" . ($make_j ? $note : ""))
+	if $make_j || !($!{ENOLCK} || $!{EOPNOTSUPP});
+    }
+}
+
+=item C<$fh-E<gt>seek ($position, [$whence])>
+
+Seek file to C<$position>.  Die if seeking fails.
+
+=cut
+
+sub seek
+{
+  my $fh = shift;
+  # Cannot use @_ here.
+  if (!seek ($fh, $_[0], $_[1]))
+    {
+      my $file = $fh->name;
+      fatal "cannot rewind $file with @_: $!";
+    }
+}
+
+=item C<$fh-E<gt>truncate ($len)>
+
+Truncate the file to length C<$len>.  Die on failure.
+
+=cut
+
+sub truncate
+{
+  my ($fh, $len) = @_;
+  if (!truncate ($fh, $len))
+    {
+      my $file = $fh->name;
+      fatal "cannot truncate $file at $len: $!";
+    }
+}
+
+=back
+
+=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
+
+1;
+
+### Setup "GNU" style for perl-mode and cperl-mode.
+## Local Variables:
+## perl-indent-level: 2
+## perl-continued-statement-offset: 2
+## perl-continued-brace-offset: 0
+## perl-brace-offset: 0
+## perl-brace-imaginary-offset: 0
+## perl-label-offset: -2
+## cperl-indent-level: 2
+## cperl-brace-offset: 0
+## cperl-continued-brace-offset: 0
+## cperl-label-offset: -2
+## cperl-extra-newline-before-brace: t
+## cperl-merge-trailing-else: nil
+## cperl-continued-statement-offset: 2
+## End: