File: | /usr/local/share/autoconf/Autom4te/XFile.pm |
Coverage: | 72.4% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
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 | |||||||
24 | package 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 | |||||||
73 | require 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 | |||||||
84 | require Exporter; | ||||||
85 | require DynaLoader; | ||||||
86 | |||||||
87 | @ISA = qw(IO::File Exporter DynaLoader); | ||||||
88 | |||||||
89 | $VERSION = "1.2"; | ||||||
90 | |||||||
91 | @EXPORT = @IO::File::EXPORT; | ||||||
92 | |||||||
93 | eval { | ||||||
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 | |||||||
112 | sub 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 | |||||||
131 | sub 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 | |||||||
160 | sub 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. | ||||||
181 | sub 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 | |||||||
196 | sub 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 | |||||||
210 | sub 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 | |||||||
224 | sub 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 | |||||||
260 | sub 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 | |||||||
277 | sub 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 | |||||||
303 | 1; | ||||||
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: |