<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># 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 &lt;http://www.gnu.org/licenses/&gt;.

# Written by Akim Demaille &lt;akim@freefriends.org&gt;.

###############################################################
# 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-&gt;open ("&lt; file");
    # No need to check $FH: we died if open failed.
    print &lt;$fh&gt;;
    $fh-&gt;close;
    # No need to check the return value of close: we died if it failed.

    $fh = new Autom4te::XFile "&gt; file";
    # No need to check $FH: we died if new failed.
    print $fh "bar\n";
    $fh-&gt;close;

    $fh = new Autom4te::XFile "file", "r";
    # No need to check $FH: we died if new failed.
    defined $fh
    print &lt;$fh&gt;;
    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-&gt;getpos;
    $fh-&gt;setpos ($pos);

    undef $fh;   # automatically closes the file and checks for errors.

    autoflush STDOUT 1;

=head1 DESCRIPTION

C&lt;Autom4te::XFile&gt; inherits from C&lt;IO::File&gt;.  It provides the method
C&lt;name&gt; returning the file name.  It provides dying versions of the
methods C&lt;close&gt;, C&lt;lock&gt; (corresponding to C&lt;flock&gt;), C&lt;new&gt;,
C&lt;open&gt;, C&lt;seek&gt;, and C&lt;truncate&gt;.  It also overrides the C&lt;getline&gt;
and C&lt;getlines&gt; methods to translate C&lt;\r\n&gt; to C&lt;\n&gt;.

=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-&gt;import (@O);  # first we import what we want to export
  push (@EXPORT, @O);
};

=head2 Methods

=over

=item C&lt;$fh = new Autom4te::XFile ([$expr, ...]&gt;

Constructor a new XFile object.  Additional arguments
are passed to C&lt;open&gt;, if any.

=cut

sub new
{
  my $type = shift;
  my $class = ref $type || $type || "Autom4te::XFile";
  my $fh = $class-&gt;SUPER::new ();
  if (@_)
    {
      $fh-&gt;open (@_);
    }
  $fh;
}

=item C&lt;$fh-E&lt;gt&gt;open ([$file, ...])&gt;

Open a file, passing C&lt;$file&gt; and further arguments to C&lt;IO::File::open&gt;.
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-&gt;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*&gt;/;
}

=item C&lt;$fh-E&lt;gt&gt;close&gt;

Close the file, handling errors.

=cut

sub close
{
  my $fh = shift;
  if (!$fh-&gt;SUPER::close (@_))
    {
      my $file = $fh-&gt;name;
      Autom4te::FileUtils::handle_exec_errors $file
	unless $!;
      fatal "cannot close $file: $!";
    }
}

=item C&lt;$line = $fh-E&lt;gt&gt;getline&gt;

Read and return a line from the file.  Ensure C&lt;\r\n&gt; is translated to
C&lt;\n&gt; 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]-&gt;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&lt;@lines = $fh-E&lt;gt&gt;getlines&gt;

Slurp lines from the files.

=cut

sub getlines
{
  my @res = ();
  my $line;
  push @res, $line while $line = $_[0]-&gt;getline;
  return @res;
}

=item C&lt;$name = $fh-E&lt;gt&gt;name&gt;

Return the name of the file.

=cut

sub name
{
  my $fh = shift;
  return ${*$fh}{'autom4te_xfile_file'};
}

=item C&lt;$fh-E&lt;gt&gt;lock&gt;

Lock the file using C&lt;flock&gt;.  If locking fails for reasons other than
C&lt;flock&gt; being unsupported, then error out if C&lt;$ENV{'MAKEFLAGS'}&gt; indicates
that we are spawned from a parallel C&lt;make&gt;.

=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'}
		    &amp;&amp; " -$ENV{'MAKEFLAGS'}" =~ / (-[BdeikrRsSw]*[jP]|--[jP]|---?jobs)/);
      my $note = "\nforgo \"make -j\" or use a file system that supports locks";
      my $file = $fh-&gt;name;

      msg ($make_j ? 'fatal' : 'unsupported',
	   "cannot lock $file with mode $mode: $!" . ($make_j ? $note : ""))
	if $make_j || !($!{ENOLCK} || $!{EOPNOTSUPP});
    }
}

=item C&lt;$fh-E&lt;gt&gt;seek ($position, [$whence])&gt;

Seek file to C&lt;$position&gt;.  Die if seeking fails.

=cut

sub seek
{
  my $fh = shift;
  # Cannot use @_ here.
  if (!seek ($fh, $_[0], $_[1]))
    {
      my $file = $fh-&gt;name;
      fatal "cannot rewind $file with @_: $!";
    }
}

=item C&lt;$fh-E&lt;gt&gt;truncate ($len)&gt;

Truncate the file to length C&lt;$len&gt;.  Die on failure.

=cut

sub truncate
{
  my ($fh, $len) = @_;
  if (!truncate ($fh, $len))
    {
      my $file = $fh-&gt;name;
      fatal "cannot truncate $file at $len: $!";
    }
}

=back

=head1 SEE ALSO

L&lt;perlfunc&gt;,
L&lt;perlop/"I/O Operators"&gt;,
L&lt;IO::File&gt;
L&lt;IO::Handle&gt;
L&lt;IO::Seekable&gt;

=head1 HISTORY

Derived from IO::File.pm by Akim Demaille E&lt;lt&gt;F&lt;akim@freefriends.org&gt;E&lt;gt&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:
</pre></body></html>