1 # Copyright (C) 2001, 2003, 2004, 2006 Free Software Foundation, Inc.
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 3 of the License, or
6 # (at your option) any later version.
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.
13 # You should have received a copy of the GNU General Public License
14 # along with this program. If not, see <http://www.gnu.org/licenses/>.
16 # Written by Akim Demaille <akim@freefriends.org>.
18 ###############################################################
19 # The main copy of this file is in Automake's CVS repository. #
20 # Updates should be sent to automake-patches@gnu.org. #
21 ###############################################################
23 package Autom4te
::XFile
;
27 Autom4te::XFile - supply object methods for filehandles with error handling
33 $fh = new Autom4te::XFile;
35 # No need to check $FH: we died if open failed.
38 # No need to check the return value of close: we died if it failed.
40 $fh = new Autom4te::XFile "> file";
41 # No need to check $FH: we died if new failed.
45 $fh = new Autom4te::XFile "file", "r";
46 # No need to check $FH: we died if new failed.
49 undef $fh; # automatically closes the file and checks for errors.
51 $fh = new Autom4te::XFile "file", O_WRONLY | O_APPEND;
52 # No need to check $FH: we died if new failed.
58 undef $fh; # automatically closes the file and checks for errors.
64 C<Autom4te::XFile> inherits from C<IO::File>. It provides the method
65 C<name> returning the file name. It provides dying version of the
66 methods C<close>, C<lock> (corresponding to C<flock>), C<new>,
67 C<open>, C<seek>, and C<trunctate>. It also overrides the C<getline>
68 and C<getlines> methods to translate C<\r\n> to C<\n>.
73 L<perlop/"I/O Operators">,
80 Derived from IO::File.pm by Akim Demaille E<lt>F<akim@freefriends.org>E<gt>.
86 use vars
qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA);
91 use Autom4te::ChannelDefs;
92 use Autom4te::Channels qw(msg);
93 use Autom4te
::FileUtils
;
98 @ISA = qw(IO::File Exporter DynaLoader);
102 @EXPORT = @IO::File
::EXPORT
;
105 # Make all Fcntl O_XXX and LOCK_XXX constants available for importing
107 my @O = grep /^(LOCK|O)_/, @Fcntl::EXPORT
, @Fcntl::EXPORT_OK
;
108 Fcntl
->import (@O); # first we import what we want to export
112 # Used in croak error messages.
113 my $me = basename
($0);
115 ################################################
122 my $class = ref $type || $type || "Autom4te::XFile";
123 my $fh = $class->SUPER::new
();
131 ################################################
140 # WARNING: Gross hack: $FH is a typeglob: use its hash slot to store
141 # the `name' of the file we are opening. See the example with
142 # io_socket_timeout in IO::Socket for more, and read Graham's
143 # comment in IO::Handle.
144 ${*$fh}{'autom4te_xfile_file'} = "$file";
146 if (!$fh->SUPER::open (@_))
148 fatal
"cannot open $file: $!";
151 # In case we're running under MSWindows, don't write with CRLF.
152 # (This circumvents a bug in at least Cygwin bash where the shell
153 # parsing fails on lines ending with the continuation character '\'
155 binmode $fh if $file =~ /^\s*>/;
158 ################################################
165 if (!$fh->SUPER::close (@_))
167 my $file = $fh->name;
168 Autom4te
::FileUtils
::handle_exec_errors
$file
170 fatal
"cannot close $file: $!";
174 ################################################
178 # Some Win32/perl installations fail to translate \r\n to \n on input
179 # so we do that here.
182 local $_ = $_[0]->SUPER::getline
;
183 # Perform a _global_ replacement: $_ may can contains many lines
184 # in slurp mode ($/ = undef).
185 s/\015\012/\n/gs if defined $_;
189 ################################################
197 push @res, $line while $line = $_[0]->getline;
201 ################################################
208 return ${*$fh}{'autom4te_xfile_file'};
211 ################################################
217 my ($fh, $mode) = @_;
218 # Cannot use @_ here.
220 # Unless explicitly configured otherwise, Perl implements its `flock' with the
221 # first of flock(2), fcntl(2), or lockf(3) that works. These can fail on
222 # NFS-backed files, with ENOLCK (GNU/Linux) or EOPNOTSUPP (FreeBSD); we
223 # usually ignore these errors. If $ENV{MAKEFLAGS} suggests that a parallel
224 # invocation of GNU `make' has invoked the tool we serve, report all locking
225 # failures and abort.
227 # On Unicos, flock(2) and fcntl(2) over NFS hang indefinitely when `lockd' is
228 # not running. NetBSD NFS clients silently grant all locks. We do not
229 # attempt to defend against these dangers.
230 if (!flock ($fh, $mode))
232 my $make_j = (exists $ENV{'MAKEFLAGS'}
233 && " -$ENV{'MAKEFLAGS'}" =~ / (-[BdeikrRsSw]*j|---?jobs)/);
234 my $note = "\nforgo `make -j' or use a file system that supports locks";
235 my $file = $fh->name;
237 msg
($make_j ?
'fatal' : 'unsupported',
238 "cannot lock $file with mode $mode: $!" . ($make_j ?
$note : ""))
239 if $make_j || !($!{ENOLCK
} || $!{EOPNOTSUPP
});
243 ################################################
250 # Cannot use @_ here.
251 if (!seek ($fh, $_[0], $_[1]))
253 my $file = $fh->name;
254 fatal
"$me: cannot rewind $file with @_: $!";
258 ################################################
265 if (!truncate ($fh, $len))
267 my $file = $fh->name;
268 fatal
"cannot truncate $file at $len: $!";
274 ### Setup "GNU" style for perl-mode and cperl-mode.
276 ## perl-indent-level: 2
277 ## perl-continued-statement-offset: 2
278 ## perl-continued-brace-offset: 0
279 ## perl-brace-offset: 0
280 ## perl-brace-imaginary-offset: 0
281 ## perl-label-offset: -2
282 ## cperl-indent-level: 2
283 ## cperl-brace-offset: 0
284 ## cperl-continued-brace-offset: 0
285 ## cperl-label-offset: -2
286 ## cperl-extra-newline-before-brace: t
287 ## cperl-merge-trailing-else: nil
288 ## cperl-continued-statement-offset: 2