XFile.pm

Branch :

Show log
Commit
Author : Zack Weinberg
Date : 2020-09-11 18:03:19
Hash : 74673d1c
Message : Consistently use ‘our’ instead of ‘use vars’. At file scope of a file containing at most one ‘package’ declaration, ‘use vars’ is exactly equivalent to ‘our’, and the latter is preferred starting with Perl 5.6.0, which happens to be the oldest version we support. (This change has nothing to do with the previous two, but I want to make the same change in Autoconf and that means doing it here for all the files synced from Automake.) (I don’t know why, but this change exposed a latent bug in FileUtils.pm where the last pod block in the file didn’t have a ‘=cut’ delimiter, so the code after it was considered documentation, causing ‘require FileUtils’ to fail.) * lib/Automake/ChannelDefs.pm * lib/Automake/Channels.pm * lib/Automake/Condition.pm * lib/Automake/Configure_ac.pm * lib/Automake/DisjConditions.pm * lib/Automake/FileUtils.pm * lib/Automake/General.pm * lib/Automake/Getopt.pm * lib/Automake/Options.pm * lib/Automake/Rule.pm * lib/Automake/RuleDef.pm * lib/Automake/VarDef.pm * lib/Automake/Variable.pm * lib/Automake/Wrap.pm * lib/Automake/XFile.pm: Replace all uses of ‘use vars’ with ‘our’. * lib/Automake/FileUtils.pm: Add missing ‘=cut’ to a pod block near the end of the file.

lib/Automake/XFile.pm

# Copyright (C) 2001-2020 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 <https://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 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 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 warnings FATAL => 'all';

use Errno;
use Exporter;
use IO::File;

use Automake::ChannelDefs;
use Automake::Channels qw (msg);
use Automake::FileUtils;

our @ISA = qw(Exporter IO::File);
our @EXPORT = @IO::File::EXPORT;
our $VERSION = "1.2";

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 Automake::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 || "Automake::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, $mode) = @_;

  # 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).
  # Correctly recognize usages like:
  #  - open ($file, "w")
  #  - open ($file, "+<")
  #  - open (" >$file")
  binmode $fh
    if (defined $mode && $mode =~ /^[+>wa]/ or $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;
      Automake::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) or
  # EINVAL (OpenIndiana, as per POSIX 1003.1-2017 fcntl spec); 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 || !($!{EINVAL} || $!{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;

kc3-lang/automake/lib/Automake/XFile.pm

Commit

kc3-lang/automake /lib/Automake/XFile.pm