File manager

File manager - Edit - /usr/share/automake-1.16/Automake/XFile.pm

Back
# 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 vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA); use Carp; use Errno; use IO::File; use File::Basename; use Automake::ChannelDefs; use Automake::Channels qw(msg); use Automake::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 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); 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;

| ver. 1.4 | Github | . | PHP 8.0.30 | Generation time: 0.01 | proxy | phpinfo | Settings