File Coverage

File:/usr/local/share/autoconf/Autom4te/XFile.pm
Coverage:72.4%

linestmtbrancondsubpodtimecode
1# Copyright (C) 2001, 2003, 2004, 2006, 2008, 2009, 2010 Free Software
2# Foundation, Inc.
3
4# This program is free software; you can redistribute it and/or modify
5# it under the terms of the GNU General Public License as published by
6# the Free Software Foundation; either version 2, or (at your option)
7# any later version.
8
9# This program is distributed in the hope that it will be useful,
10# but WITHOUT ANY WARRANTY; without even the implied warranty of
11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12# GNU General Public License for more details.
13
14# You should have received a copy of the GNU General Public License
15# along with this program. If not, see <http://www.gnu.org/licenses/>.
16
17# Written by Akim Demaille <akim@freefriends.org>.
18
19###############################################################
20# The main copy of this file is in Automake's CVS repository. #
21# Updates should be sent to automake-patches@gnu.org. #
22###############################################################
23
24package Autom4te::XFile;
25
26 - 71
=head1 NAME

Autom4te::XFile - supply object methods for filehandles with error handling

=head1 SYNOPSIS

    use Autom4te::XFile;

    $fh = new Autom4te::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 Autom4te::XFile "> file";
    # No need to check $FH: we died if new failed.
    print $fh "bar\n";
    $fh->close;

    $fh = new Autom4te::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 Autom4te::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<Autom4te::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
72
73require 5.000;
74
2774
2774
2774
8453
2841
10460
use strict;
75
2774
2774
2774
10274
3082
10847
use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA);
76
2774
2774
2774
11336
3082
8543
use Carp;
77
2774
2774
2774
20471
3832
16704
use Errno;
78
2774
2774
2774
10976
2632
8123
use IO::File;
79
2774
2774
2774
11812
2734
8196
use File::Basename;
80
2774
2774
2774
10097
2489
7574
use Autom4te::ChannelDefs;
81
2774
2774
2774
10504
2590
9376
use Autom4te::Channels qw(msg);
82
2774
2774
2774
11583
3445
7895
use Autom4te::FileUtils;
83
84require Exporter;
85require DynaLoader;
86
87@ISA = qw(IO::File Exporter DynaLoader);
88
89$VERSION = "1.2";
90
91@EXPORT = @IO::File::EXPORT;
92
93eval {
94  # Make all Fcntl O_XXX and LOCK_XXX constants available for importing
95  require Fcntl;
96  my @O = grep /^(LOCK|O)_/, @Fcntl::EXPORT, @Fcntl::EXPORT_OK;
97  Fcntl->import (@O); # first we import what we want to export
98  push (@EXPORT, @O);
99};
100
101 - 110
=head2 Methods

=over

=item C<$fh = new Autom4te::XFile ([$expr, ...]>

Constructor a new XFile object.  Additional arguments
are passed to C<open>, if any.

=cut
111
112sub new
113{
114
36223
1
84343
  my $type = shift;
115
36223
300310
  my $class = ref $type || $type || "Autom4te::XFile";
116
36223
497540
  my $fh = $class->SUPER::new ();
117
36223
2102182
  if (@_)
118    {
119
35643
99426
      $fh->open (@_);
120    }
121
36223
131953
  $fh;
122}
123
124 - 129
=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
130
131sub open
132{
133
36223
1
55307
  my $fh = shift;
134
36223
64975
  my ($file) = @_;
135
136  # WARNING: Gross hack: $FH is a typeglob: use its hash slot to store
137  # the `name' of the file we are opening. See the example with
138  # io_socket_timeout in IO::Socket for more, and read Graham's
139  # comment in IO::Handle.
140
36223
36223
53667
163164
  ${*$fh}{'autom4te_xfile_file'} = "$file";
141
142
36223
215504
  if (!$fh->SUPER::open (@_))
143    {
144
0
0
      fatal "cannot open $file: $!";
145    }
146
147  # In case we're running under MSWindows, don't write with CRLF.
148  # (This circumvents a bug in at least Cygwin bash where the shell
149  # parsing fails on lines ending with the continuation character '\'
150  # and CRLF).
151
36223
21600891
  binmode $fh if $file =~ /^\s*>/;
152}
153
154 - 158
=item C<$fh-E<gt>close>

Close the file, handling errors.

=cut
159
160sub close
161{
162
9670
1
19786
  my $fh = shift;
163
9670
88249
  if (!$fh->SUPER::close (@_))
164    {
165
0
0
      my $file = $fh->name;
166
0
0
      Autom4te::FileUtils::handle_exec_errors $file
167        unless $!;
168
0
0
      fatal "cannot close $file: $!";
169    }
170}
171
172 - 177
=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
178
179# Some Win32/perl installations fail to translate \r\n to \n on input
180# so we do that here.
181sub getline
182{
183
6792330
1
27507048
  local $_ = $_[0]->SUPER::getline;
184  # Perform a _global_ replacement: $_ may can contains many lines
185  # in slurp mode ($/ = undef).
186
6792330
76180164
  s/\015\012/\n/gs if defined $_;
187
6792330
20442941
  return $_;
188}
189
190 - 194
=item C<@lines = $fh-E<gt>getlines>

Slurp lines from the files.

=cut
195
196sub getlines
197{
198
3338
1
7999
  my @res = ();
199
3338
5026
  my $line;
200
3338
12991
  push @res, $line while $line = $_[0]->getline;
201
3338
117146
  return @res;
202}
203
204 - 208
=item C<$name = $fh-E<gt>name>

Return the name of the file.

=cut
209
210sub name
211{
212
2758
1
5808
  my $fh = shift;
213
2758
2758
3834
12117
  return ${*$fh}{'autom4te_xfile_file'};
214}
215
216 - 222
=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
223
224sub lock
225{
226
2758
1
9322
  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); we
232  # usually ignore these errors. If $ENV{MAKEFLAGS} suggests that a parallel
233  # invocation of `make' has invoked the tool we serve, report all locking
234  # failures and abort.
235  #
236  # On Unicos, flock(2) and fcntl(2) over NFS hang indefinitely when `lockd' is
237  # not running. NetBSD NFS clients silently grant all locks. We do not
238  # attempt to defend against these dangers.
239  #
240  # -j is for parallel BSD make, -P is for parallel HP-UX make.
241
2758
40280
  if (!flock ($fh, $mode))
242    {
243
0
0
      my $make_j = (exists $ENV{'MAKEFLAGS'}
244                    && " -$ENV{'MAKEFLAGS'}" =~ / (-[BdeikrRsSw]*[jP]|--[jP]|---?jobs)/);
245
0
0
      my $note = "\nforgo `make -j' or use a file system that supports locks";
246
0
0
      my $file = $fh->name;
247
248
0
0
      msg ($make_j ? 'fatal' : 'unsupported',
249           "cannot lock $file with mode $mode: $!" . ($make_j ? $note : ""))
250        if $make_j || !($!{ENOLCK} || $!{EOPNOTSUPP});
251    }
252}
253
254 - 258
=item C<$fh-E<gt>seek ($position, [$whence])>

Seek file to C<$position>.  Die if seeking fails.

=cut
259
260sub seek
261{
262
2742
1
6766
  my $fh = shift;
263  # Cannot use @_ here.
264
2742
39203
  if (!seek ($fh, $_[0], $_[1]))
265    {
266
0
0
      my $file = $fh->name;
267
0
0
      fatal "cannot rewind $file with @_: $!";
268    }
269}
270
271 - 275
=item C<$fh-E<gt>truncate ($len)>

Truncate the file to length C<$len>.  Die on failure.

=cut
276
277sub truncate
278{
279
2742
1
7716
  my ($fh, $len) = @_;
280
2742
2069250
  if (!truncate ($fh, $len))
281    {
282
0
      my $file = $fh->name;
283
0
      fatal "cannot truncate $file at $len: $!";
284    }
285}
286
287=back
288
289 - 301
=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
302
3031;
304
305### Setup "GNU" style for perl-mode and cperl-mode.
306## Local Variables:
307## perl-indent-level: 2
308## perl-continued-statement-offset: 2
309## perl-continued-brace-offset: 0
310## perl-brace-offset: 0
311## perl-brace-imaginary-offset: 0
312## perl-label-offset: -2
313## cperl-indent-level: 2
314## cperl-brace-offset: 0
315## cperl-continued-brace-offset: 0
316## cperl-label-offset: -2
317## cperl-extra-newline-before-brace: t
318## cperl-merge-trailing-else: nil
319## cperl-continued-statement-offset: 2
320## End: