1# Copyright (C) 2001, 2003, 2004, 2006 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, write to the Free Software
15# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16# 02110-1301, USA.
17
18# Written by Akim Demaille <akim@freefriends.org>.
19
20###############################################################
21# The main copy of this file is in Automake's CVS repository. #
22# Updates should be sent to automake-patches@gnu.org.         #
23###############################################################
24
25package Autom4te::XFile;
26
27=head1 NAME
28
29Autom4te::XFile - supply object methods for filehandles with error handling
30
31=head1 SYNOPSIS
32
33    use Autom4te::XFile;
34
35    $fh = new Autom4te::XFile;
36    $fh->open ("< file");
37    # No need to check $FH: we died if open failed.
38    print <$fh>;
39    $fh->close;
40    # No need to check the return value of close: we died if it failed.
41
42    $fh = new Autom4te::XFile "> file";
43    # No need to check $FH: we died if new failed.
44    print $fh "bar\n";
45    $fh->close;
46
47    $fh = new Autom4te::XFile "file", "r";
48    # No need to check $FH: we died if new failed.
49    defined $fh
50    print <$fh>;
51    undef $fh;   # automatically closes the file and checks for errors.
52
53    $fh = new Autom4te::XFile "file", O_WRONLY | O_APPEND;
54    # No need to check $FH: we died if new failed.
55    print $fh "corge\n";
56
57    $pos = $fh->getpos;
58    $fh->setpos ($pos);
59
60    undef $fh;   # automatically closes the file and checks for errors.
61
62    autoflush STDOUT 1;
63
64=head1 DESCRIPTION
65
66C<Autom4te::XFile> inherits from C<IO::File>.  It provides the method
67C<name> returning the file name.  It provides dying version of the
68methods C<close>, C<lock> (corresponding to C<flock>), C<new>,
69C<open>, C<seek>, and C<trunctate>.  It also overrides the C<getline>
70and C<getlines> methods to translate C<\r\n> to C<\n>.
71
72=head1 SEE ALSO
73
74L<perlfunc>,
75L<perlop/"I/O Operators">,
76L<IO::File>
77L<IO::Handle>
78L<IO::Seekable>
79
80=head1 HISTORY
81
82Derived from IO::File.pm by Akim Demaille E<lt>F<akim@freefriends.org>E<gt>.
83
84=cut
85
86require 5.000;
87use strict;
88use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA);
89use Carp;
90use Errno;
91use IO::File;
92use File::Basename;
93use Autom4te::ChannelDefs;
94use Autom4te::Channels qw(msg);
95use Autom4te::FileUtils;
96
97require Exporter;
98require DynaLoader;
99
100@ISA = qw(IO::File Exporter DynaLoader);
101
102$VERSION = "1.2";
103
104@EXPORT = @IO::File::EXPORT;
105
106eval {
107  # Make all Fcntl O_XXX and LOCK_XXX constants available for importing
108  require Fcntl;
109  my @O = grep /^(LOCK|O)_/, @Fcntl::EXPORT, @Fcntl::EXPORT_OK;
110  Fcntl->import (@O);  # first we import what we want to export
111  push (@EXPORT, @O);
112};
113
114# Used in croak error messages.
115my $me = basename ($0);
116
117################################################
118## Constructor
119##
120
121sub new
122{
123  my $type = shift;
124  my $class = ref $type || $type || "Autom4te::XFile";
125  my $fh = $class->SUPER::new ();
126  if (@_)
127    {
128      $fh->open (@_);
129    }
130  $fh;
131}
132
133################################################
134## Open
135##
136
137sub open
138{
139  my $fh = shift;
140  my ($file) = @_;
141
142  # WARNING: Gross hack: $FH is a typeglob: use its hash slot to store
143  # the `name' of the file we are opening.  See the example with
144  # io_socket_timeout in IO::Socket for more, and read Graham's
145  # comment in IO::Handle.
146  ${*$fh}{'autom4te_xfile_file'} = "$file";
147
148  if (!$fh->SUPER::open (@_))
149    {
150      fatal "cannot open $file: $!";
151    }
152
153  # In case we're running under MSWindows, don't write with CRLF.
154  # (This circumvents a bug in at least Cygwin bash where the shell
155  # parsing fails on lines ending with the continuation character '\'
156  # and CRLF).
157  binmode $fh if $file =~ /^\s*>/;
158}
159
160################################################
161## Close
162##
163
164sub close
165{
166  my $fh = shift;
167  if (!$fh->SUPER::close (@_))
168    {
169      my $file = $fh->name;
170      Autom4te::FileUtils::handle_exec_errors $file
171	unless $!;
172      fatal "cannot close $file: $!";
173    }
174}
175
176################################################
177## Getline
178##
179
180# Some Win32/perl installations fail to translate \r\n to \n on input
181# so we do that here.
182sub getline
183{
184  local $_ = $_[0]->SUPER::getline;
185  # Perform a _global_ replacement: $_ may can contains many lines
186  # in slurp mode ($/ = undef).
187  s/\015\012/\n/gs if defined $_;
188  return $_;
189}
190
191################################################
192## Getlines
193##
194
195sub getlines
196{
197  my @res = ();
198  my $line;
199  push @res, $line while $line = $_[0]->getline;
200  return @res;
201}
202
203################################################
204## Name
205##
206
207sub name
208{
209  my $fh = shift;
210  return ${*$fh}{'autom4te_xfile_file'};
211}
212
213################################################
214## Lock
215##
216
217sub lock
218{
219  my ($fh, $mode) = @_;
220  # Cannot use @_ here.
221
222  # Unless explicitly configured otherwise, Perl implements its `flock' with the
223  # first of flock(2), fcntl(2), or lockf(3) that works.  These can fail on
224  # NFS-backed files, with ENOLCK (GNU/Linux) or EOPNOTSUPP (FreeBSD); we
225  # usually ignore these errors.  If $ENV{MAKEFLAGS} suggests that a parallel
226  # invocation of GNU `make' has invoked the tool we serve, report all locking
227  # failures and abort.
228  #
229  # On Unicos, flock(2) and fcntl(2) over NFS hang indefinitely when `lockd' is
230  # not running.  NetBSD NFS clients silently grant all locks.  We do not
231  # attempt to defend against these dangers.
232  if (!flock ($fh, $mode))
233    {
234      my $make_j = (exists $ENV{'MAKEFLAGS'}
235		    && " -$ENV{'MAKEFLAGS'}" =~ / (-[BdeikrRsSw]*j|---?jobs)/);
236      my $note = "\nforgo `make -j' or use a file system that supports locks";
237      my $file = $fh->name;
238
239      msg ($make_j ? 'fatal' : 'unsupported',
240	   "cannot lock $file with mode $mode: $!" . ($make_j ? $note : ""))
241	if $make_j || !($!{ENOLCK} || $!{EOPNOTSUPP});
242    }
243}
244
245################################################
246## Seek
247##
248
249sub seek
250{
251  my $fh = shift;
252  # Cannot use @_ here.
253  if (!seek ($fh, $_[0], $_[1]))
254    {
255      my $file = $fh->name;
256      fatal "$me: cannot rewind $file with @_: $!";
257    }
258}
259
260################################################
261## Truncate
262##
263
264sub truncate
265{
266  my ($fh, $len) = @_;
267  if (!truncate ($fh, $len))
268    {
269      my $file = $fh->name;
270      fatal "cannot truncate $file at $len: $!";
271    }
272}
273
2741;
275
276### Setup "GNU" style for perl-mode and cperl-mode.
277## Local Variables:
278## perl-indent-level: 2
279## perl-continued-statement-offset: 2
280## perl-continued-brace-offset: 0
281## perl-brace-offset: 0
282## perl-brace-imaginary-offset: 0
283## perl-label-offset: -2
284## cperl-indent-level: 2
285## cperl-brace-offset: 0
286## cperl-continued-brace-offset: 0
287## cperl-label-offset: -2
288## cperl-extra-newline-before-brace: t
289## cperl-merge-trailing-else: nil
290## cperl-continued-statement-offset: 2
291## End:
292