"Fossies" - the Fresh Open Source Software Archive

Member "automake-1.16.3/lib/Automake/XFile.pm" (19 Nov 2020, 7461 Bytes) of package /linux/misc/automake-1.16.3.tar.xz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "XFile.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 1.16.2_vs_1.16.3.

    1 # Copyright (C) 2001-2020 Free Software Foundation, Inc.
    2 
    3 # This program is free software; you can redistribute it and/or modify
    4 # it under the terms of the GNU General Public License as published by
    5 # the Free Software Foundation; either version 2, or (at your option)
    6 # any later version.
    7 
    8 # This program is distributed in the hope that it will be useful,
    9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 # GNU General Public License for more details.
   12 
   13 # You should have received a copy of the GNU General Public License
   14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
   15 
   16 # Written by Akim Demaille <akim@freefriends.org>.
   17 
   18 ###############################################################
   19 # The main copy of this file is in Automake's git repository. #
   20 # Updates should be sent to automake-patches@gnu.org.         #
   21 ###############################################################
   22 
   23 package Automake::XFile;
   24 
   25 =head1 NAME
   26 
   27 Automake::XFile - supply object methods for filehandles with error handling
   28 
   29 =head1 SYNOPSIS
   30 
   31     use Automake::XFile;
   32 
   33     $fh = new Automake::XFile;
   34     $fh->open ("file", "<");
   35     # No need to check $FH: we died if open failed.
   36     print <$fh>;
   37     $fh->close;
   38     # No need to check the return value of close: we died if it failed.
   39 
   40     $fh = new Automake::XFile "file", ">";
   41     # No need to check $FH: we died if new failed.
   42     print $fh "bar\n";
   43     $fh->close;
   44 
   45     $fh = new Automake::XFile "file", "r";
   46     # No need to check $FH: we died if new failed.
   47     defined $fh
   48     print <$fh>;
   49     undef $fh;   # automatically closes the file and checks for errors.
   50 
   51     $fh = new Automake::XFile "file", O_WRONLY | O_APPEND;
   52     # No need to check $FH: we died if new failed.
   53     print $fh "corge\n";
   54 
   55     $pos = $fh->getpos;
   56     $fh->setpos ($pos);
   57 
   58     undef $fh;   # automatically closes the file and checks for errors.
   59 
   60     autoflush STDOUT 1;
   61 
   62 =head1 DESCRIPTION
   63 
   64 C<Automake::XFile> inherits from C<IO::File>.  It provides the method
   65 C<name> returning the file name.  It provides dying versions of the
   66 methods C<close>, C<lock> (corresponding to C<flock>), C<new>,
   67 C<open>, C<seek>, and C<truncate>.  It also overrides the C<getline>
   68 and C<getlines> methods to translate C<\r\n> to C<\n>.
   69 
   70 =cut
   71 
   72 use 5.006;
   73 use strict;
   74 use warnings FATAL => 'all';
   75 
   76 use Errno;
   77 use Exporter;
   78 use IO::File;
   79 
   80 use Automake::ChannelDefs;
   81 use Automake::Channels qw (msg);
   82 use Automake::FileUtils;
   83 
   84 our @ISA = qw(Exporter IO::File);
   85 our @EXPORT = @IO::File::EXPORT;
   86 our $VERSION = "1.2";
   87 
   88 eval {
   89   # Make all Fcntl O_XXX and LOCK_XXX constants available for importing
   90   require Fcntl;
   91   my @O = grep /^(LOCK|O)_/, @Fcntl::EXPORT, @Fcntl::EXPORT_OK;
   92   Fcntl->import (@O);  # first we import what we want to export
   93   push (@EXPORT, @O);
   94 };
   95 
   96 =head2 Methods
   97 
   98 =over
   99 
  100 =item C<$fh = new Automake::XFile ([$expr, ...]>
  101 
  102 Constructor a new XFile object.  Additional arguments
  103 are passed to C<open>, if any.
  104 
  105 =cut
  106 
  107 sub new
  108 {
  109   my $type = shift;
  110   my $class = ref $type || $type || "Automake::XFile";
  111   my $fh = $class->SUPER::new ();
  112   if (@_)
  113     {
  114       $fh->open (@_);
  115     }
  116   $fh;
  117 }
  118 
  119 =item C<$fh-E<gt>open ([$file, ...])>
  120 
  121 Open a file, passing C<$file> and further arguments to C<IO::File::open>.
  122 Die if opening fails.  Store the name of the file.  Use binmode for writing.
  123 
  124 =cut
  125 
  126 sub open
  127 {
  128   my $fh = shift;
  129   my ($file, $mode) = @_;
  130 
  131   # WARNING: Gross hack: $FH is a typeglob: use its hash slot to store
  132   # the 'name' of the file we are opening.  See the example with
  133   # io_socket_timeout in IO::Socket for more, and read Graham's
  134   # comment in IO::Handle.
  135   ${*$fh}{'autom4te_xfile_file'} = "$file";
  136 
  137   if (!$fh->SUPER::open (@_))
  138     {
  139       fatal "cannot open $file: $!";
  140     }
  141 
  142   # In case we're running under MSWindows, don't write with CRLF.
  143   # (This circumvents a bug in at least Cygwin bash where the shell
  144   # parsing fails on lines ending with the continuation character '\'
  145   # and CRLF).
  146   # Correctly recognize usages like:
  147   #  - open ($file, "w")
  148   #  - open ($file, "+<")
  149   #  - open (" >$file")
  150   binmode $fh
  151     if (defined $mode && $mode =~ /^[+>wa]/ or $file =~ /^\s*>/);
  152 }
  153 
  154 =item C<$fh-E<gt>close>
  155 
  156 Close the file, handling errors.
  157 
  158 =cut
  159 
  160 sub close
  161 {
  162   my $fh = shift;
  163   if (!$fh->SUPER::close (@_))
  164     {
  165       my $file = $fh->name;
  166       Automake::FileUtils::handle_exec_errors $file
  167     unless $!;
  168       fatal "cannot close $file: $!";
  169     }
  170 }
  171 
  172 =item C<$line = $fh-E<gt>getline>
  173 
  174 Read and return a line from the file.  Ensure C<\r\n> is translated to
  175 C<\n> on input files.
  176 
  177 =cut
  178 
  179 # Some native Windows/perl installations fail to translate \r\n to \n on
  180 # input so we do that here.
  181 sub getline
  182 {
  183   local $_ = $_[0]->SUPER::getline;
  184   # Perform a _global_ replacement: $_ may can contains many lines
  185   # in slurp mode ($/ = undef).
  186   s/\015\012/\n/gs if defined $_;
  187   return $_;
  188 }
  189 
  190 =item C<@lines = $fh-E<gt>getlines>
  191 
  192 Slurp lines from the files.
  193 
  194 =cut
  195 
  196 sub getlines
  197 {
  198   my @res = ();
  199   my $line;
  200   push @res, $line while $line = $_[0]->getline;
  201   return @res;
  202 }
  203 
  204 =item C<$name = $fh-E<gt>name>
  205 
  206 Return the name of the file.
  207 
  208 =cut
  209 
  210 sub name
  211 {
  212   my $fh = shift;
  213   return ${*$fh}{'autom4te_xfile_file'};
  214 }
  215 
  216 =item C<$fh-E<gt>lock>
  217 
  218 Lock the file using C<flock>.  If locking fails for reasons other than
  219 C<flock> being unsupported, then error out if C<$ENV{'MAKEFLAGS'}> indicates
  220 that we are spawned from a parallel C<make>.
  221 
  222 =cut
  223 
  224 sub lock
  225 {
  226   my ($fh, $mode) = @_;
  227   # Cannot use @_ here.
  228 
  229   # Unless explicitly configured otherwise, Perl implements its 'flock' with the
  230   # first of flock(2), fcntl(2), or lockf(3) that works.  These can fail on
  231   # NFS-backed files, with ENOLCK (GNU/Linux) or EOPNOTSUPP (FreeBSD) or
  232   # EINVAL (OpenIndiana, as per POSIX 1003.1-2017 fcntl spec); we
  233   # usually ignore these errors.  If $ENV{MAKEFLAGS} suggests that a parallel
  234   # invocation of 'make' has invoked the tool we serve, report all locking
  235   # failures and abort.
  236   #
  237   # On Unicos, flock(2) and fcntl(2) over NFS hang indefinitely when 'lockd' is
  238   # not running.  NetBSD NFS clients silently grant all locks.  We do not
  239   # attempt to defend against these dangers.
  240   #
  241   # -j is for parallel BSD make, -P is for parallel HP-UX make.
  242   if (!flock ($fh, $mode))
  243     {
  244       my $make_j = (exists $ENV{'MAKEFLAGS'}
  245             && " -$ENV{'MAKEFLAGS'}" =~ / (-[BdeikrRsSw]*[jP]|--[jP]|---?jobs)/);
  246       my $note = "\nforgo \"make -j\" or use a file system that supports locks";
  247       my $file = $fh->name;
  248 
  249       msg ($make_j ? 'fatal' : 'unsupported',
  250        "cannot lock $file with mode $mode: $!" . ($make_j ? $note : ""))
  251     if $make_j || !($!{EINVAL} || $!{ENOLCK} || $!{EOPNOTSUPP});
  252     }
  253 }
  254 
  255 =item C<$fh-E<gt>seek ($position, [$whence])>
  256 
  257 Seek file to C<$position>.  Die if seeking fails.
  258 
  259 =cut
  260 
  261 sub seek
  262 {
  263   my $fh = shift;
  264   # Cannot use @_ here.
  265   if (!seek ($fh, $_[0], $_[1]))
  266     {
  267       my $file = $fh->name;
  268       fatal "cannot rewind $file with @_: $!";
  269     }
  270 }
  271 
  272 =item C<$fh-E<gt>truncate ($len)>
  273 
  274 Truncate the file to length C<$len>.  Die on failure.
  275 
  276 =cut
  277 
  278 sub truncate
  279 {
  280   my ($fh, $len) = @_;
  281   if (!truncate ($fh, $len))
  282     {
  283       my $file = $fh->name;
  284       fatal "cannot truncate $file at $len: $!";
  285     }
  286 }
  287 
  288 =back
  289 
  290 =head1 SEE ALSO
  291 
  292 L<perlfunc>,
  293 L<perlop/"I/O Operators">,
  294 L<IO::File>
  295 L<IO::Handle>
  296 L<IO::Seekable>
  297 
  298 =head1 HISTORY
  299 
  300 Derived from IO::File.pm by Akim Demaille E<lt>F<akim@freefriends.org>E<gt>.
  301 
  302 =cut
  303 
  304 1;