"Fossies" - the Fresh Open Source Software Archive 
Member "automake-1.16.3/lib/Automake/XFile.pm" (19 Nov 2020, 7461 Bytes) of package /linux/misc/automake-1.16.3.tar.xz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "XFile.pm" see the
Fossies "Dox" file reference documentation and the latest
Fossies "Diffs" side-by-side code changes report:
1.16.2_vs_1.16.3.
1 # Copyright (C) 2001-2020 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, see <https://www.gnu.org/licenses/>.
15
16 # Written by Akim Demaille <akim@freefriends.org>.
17
18 ###############################################################
19 # The main copy of this file is in Automake's git repository. #
20 # Updates should be sent to automake-patches@gnu.org. #
21 ###############################################################
22
23 package Automake::XFile;
24
25 =head1 NAME
26
27 Automake::XFile - supply object methods for filehandles with error handling
28
29 =head1 SYNOPSIS
30
31 use Automake::XFile;
32
33 $fh = new Automake::XFile;
34 $fh->open ("file", "<");
35 # No need to check $FH: we died if open failed.
36 print <$fh>;
37 $fh->close;
38 # No need to check the return value of close: we died if it failed.
39
40 $fh = new Automake::XFile "file", ">";
41 # No need to check $FH: we died if new failed.
42 print $fh "bar\n";
43 $fh->close;
44
45 $fh = new Automake::XFile "file", "r";
46 # No need to check $FH: we died if new failed.
47 defined $fh
48 print <$fh>;
49 undef $fh; # automatically closes the file and checks for errors.
50
51 $fh = new Automake::XFile "file", O_WRONLY | O_APPEND;
52 # No need to check $FH: we died if new failed.
53 print $fh "corge\n";
54
55 $pos = $fh->getpos;
56 $fh->setpos ($pos);
57
58 undef $fh; # automatically closes the file and checks for errors.
59
60 autoflush STDOUT 1;
61
62 =head1 DESCRIPTION
63
64 C<Automake::XFile> inherits from C<IO::File>. It provides the method
65 C<name> returning the file name. It provides dying versions of the
66 methods C<close>, C<lock> (corresponding to C<flock>), C<new>,
67 C<open>, C<seek>, and C<truncate>. It also overrides the C<getline>
68 and C<getlines> methods to translate C<\r\n> to C<\n>.
69
70 =cut
71
72 use 5.006;
73 use strict;
74 use warnings FATAL => 'all';
75
76 use Errno;
77 use Exporter;
78 use IO::File;
79
80 use Automake::ChannelDefs;
81 use Automake::Channels qw (msg);
82 use Automake::FileUtils;
83
84 our @ISA = qw(Exporter IO::File);
85 our @EXPORT = @IO::File::EXPORT;
86 our $VERSION = "1.2";
87
88 eval {
89 # Make all Fcntl O_XXX and LOCK_XXX constants available for importing
90 require Fcntl;
91 my @O = grep /^(LOCK|O)_/, @Fcntl::EXPORT, @Fcntl::EXPORT_OK;
92 Fcntl->import (@O); # first we import what we want to export
93 push (@EXPORT, @O);
94 };
95
96 =head2 Methods
97
98 =over
99
100 =item C<$fh = new Automake::XFile ([$expr, ...]>
101
102 Constructor a new XFile object. Additional arguments
103 are passed to C<open>, if any.
104
105 =cut
106
107 sub new
108 {
109 my $type = shift;
110 my $class = ref $type || $type || "Automake::XFile";
111 my $fh = $class->SUPER::new ();
112 if (@_)
113 {
114 $fh->open (@_);
115 }
116 $fh;
117 }
118
119 =item C<$fh-E<gt>open ([$file, ...])>
120
121 Open a file, passing C<$file> and further arguments to C<IO::File::open>.
122 Die if opening fails. Store the name of the file. Use binmode for writing.
123
124 =cut
125
126 sub open
127 {
128 my $fh = shift;
129 my ($file, $mode) = @_;
130
131 # WARNING: Gross hack: $FH is a typeglob: use its hash slot to store
132 # the 'name' of the file we are opening. See the example with
133 # io_socket_timeout in IO::Socket for more, and read Graham's
134 # comment in IO::Handle.
135 ${*$fh}{'autom4te_xfile_file'} = "$file";
136
137 if (!$fh->SUPER::open (@_))
138 {
139 fatal "cannot open $file: $!";
140 }
141
142 # In case we're running under MSWindows, don't write with CRLF.
143 # (This circumvents a bug in at least Cygwin bash where the shell
144 # parsing fails on lines ending with the continuation character '\'
145 # and CRLF).
146 # Correctly recognize usages like:
147 # - open ($file, "w")
148 # - open ($file, "+<")
149 # - open (" >$file")
150 binmode $fh
151 if (defined $mode && $mode =~ /^[+>wa]/ or $file =~ /^\s*>/);
152 }
153
154 =item C<$fh-E<gt>close>
155
156 Close the file, handling errors.
157
158 =cut
159
160 sub close
161 {
162 my $fh = shift;
163 if (!$fh->SUPER::close (@_))
164 {
165 my $file = $fh->name;
166 Automake::FileUtils::handle_exec_errors $file
167 unless $!;
168 fatal "cannot close $file: $!";
169 }
170 }
171
172 =item C<$line = $fh-E<gt>getline>
173
174 Read and return a line from the file. Ensure C<\r\n> is translated to
175 C<\n> on input files.
176
177 =cut
178
179 # Some native Windows/perl installations fail to translate \r\n to \n on
180 # input so we do that here.
181 sub getline
182 {
183 local $_ = $_[0]->SUPER::getline;
184 # Perform a _global_ replacement: $_ may can contains many lines
185 # in slurp mode ($/ = undef).
186 s/\015\012/\n/gs if defined $_;
187 return $_;
188 }
189
190 =item C<@lines = $fh-E<gt>getlines>
191
192 Slurp lines from the files.
193
194 =cut
195
196 sub getlines
197 {
198 my @res = ();
199 my $line;
200 push @res, $line while $line = $_[0]->getline;
201 return @res;
202 }
203
204 =item C<$name = $fh-E<gt>name>
205
206 Return the name of the file.
207
208 =cut
209
210 sub name
211 {
212 my $fh = shift;
213 return ${*$fh}{'autom4te_xfile_file'};
214 }
215
216 =item C<$fh-E<gt>lock>
217
218 Lock the file using C<flock>. If locking fails for reasons other than
219 C<flock> being unsupported, then error out if C<$ENV{'MAKEFLAGS'}> indicates
220 that we are spawned from a parallel C<make>.
221
222 =cut
223
224 sub lock
225 {
226 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) or
232 # EINVAL (OpenIndiana, as per POSIX 1003.1-2017 fcntl spec); we
233 # usually ignore these errors. If $ENV{MAKEFLAGS} suggests that a parallel
234 # invocation of 'make' has invoked the tool we serve, report all locking
235 # failures and abort.
236 #
237 # On Unicos, flock(2) and fcntl(2) over NFS hang indefinitely when 'lockd' is
238 # not running. NetBSD NFS clients silently grant all locks. We do not
239 # attempt to defend against these dangers.
240 #
241 # -j is for parallel BSD make, -P is for parallel HP-UX make.
242 if (!flock ($fh, $mode))
243 {
244 my $make_j = (exists $ENV{'MAKEFLAGS'}
245 && " -$ENV{'MAKEFLAGS'}" =~ / (-[BdeikrRsSw]*[jP]|--[jP]|---?jobs)/);
246 my $note = "\nforgo \"make -j\" or use a file system that supports locks";
247 my $file = $fh->name;
248
249 msg ($make_j ? 'fatal' : 'unsupported',
250 "cannot lock $file with mode $mode: $!" . ($make_j ? $note : ""))
251 if $make_j || !($!{EINVAL} || $!{ENOLCK} || $!{EOPNOTSUPP});
252 }
253 }
254
255 =item C<$fh-E<gt>seek ($position, [$whence])>
256
257 Seek file to C<$position>. Die if seeking fails.
258
259 =cut
260
261 sub seek
262 {
263 my $fh = shift;
264 # Cannot use @_ here.
265 if (!seek ($fh, $_[0], $_[1]))
266 {
267 my $file = $fh->name;
268 fatal "cannot rewind $file with @_: $!";
269 }
270 }
271
272 =item C<$fh-E<gt>truncate ($len)>
273
274 Truncate the file to length C<$len>. Die on failure.
275
276 =cut
277
278 sub truncate
279 {
280 my ($fh, $len) = @_;
281 if (!truncate ($fh, $len))
282 {
283 my $file = $fh->name;
284 fatal "cannot truncate $file at $len: $!";
285 }
286 }
287
288 =back
289
290 =head1 SEE ALSO
291
292 L<perlfunc>,
293 L<perlop/"I/O Operators">,
294 L<IO::File>
295 L<IO::Handle>
296 L<IO::Seekable>
297
298 =head1 HISTORY
299
300 Derived from IO::File.pm by Akim Demaille E<lt>F<akim@freefriends.org>E<gt>.
301
302 =cut
303
304 1;