1 |
# Copyright 2001 Free Software Foundation, Inc. |
# Copyright (C) 2001, 2003 Free Software Foundation, Inc. |
2 |
|
|
3 |
# This program is free software; you can redistribute it and/or modify |
# 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 |
# it under the terms of the GNU General Public License as published by |
63 |
|
|
64 |
=head1 DESCRIPTION |
=head1 DESCRIPTION |
65 |
|
|
66 |
C<Autom4te::XFile> inherits from C<IO::File>. It provides dying |
C<Autom4te::XFile> inherits from C<IO::File>. It provides the method |
67 |
version of the methods C<open>, C<new>, and C<close>. It also overrides |
C<name> returning the file name. It provides dying version of the |
68 |
the C<getline> and C<getlines> methods to translate C<\r\n> to C<\n>. |
methods C<close>, C<lock> (corresponding to C<flock>), C<new>, |
69 |
|
C<open>, C<seek>, and C<trunctate>. It also overrides the C<getline> |
70 |
|
and C<getlines> methods to translate C<\r\n> to C<\n>. |
71 |
|
|
72 |
=head1 SEE ALSO |
=head1 SEE ALSO |
73 |
|
|
87 |
use strict; |
use strict; |
88 |
use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA); |
use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD @ISA); |
89 |
use Carp; |
use Carp; |
90 |
|
use IO::File; |
91 |
use File::Basename; |
use File::Basename; |
92 |
|
|
93 |
require Exporter; |
require Exporter; |
95 |
|
|
96 |
@ISA = qw(IO::File Exporter DynaLoader); |
@ISA = qw(IO::File Exporter DynaLoader); |
97 |
|
|
98 |
$VERSION = "1.1"; |
$VERSION = "1.2"; |
99 |
|
|
100 |
@EXPORT = @IO::File::EXPORT; |
@EXPORT = @IO::File::EXPORT; |
101 |
|
|
102 |
eval { |
eval { |
103 |
# Make all Fcntl O_XXX constants available for importing |
# Make all Fcntl O_XXX and LOCK_XXX constants available for importing |
104 |
require Fcntl; |
require Fcntl; |
105 |
my @O = grep /^O_/, @Fcntl::EXPORT; |
my @O = grep /^(LOCK|O)_/, @Fcntl::EXPORT, @Fcntl::EXPORT_OK; |
106 |
Fcntl->import(@O); # first we import what we want to export |
Fcntl->import (@O); # first we import what we want to export |
107 |
push(@EXPORT, @O); |
push (@EXPORT, @O); |
108 |
}; |
}; |
109 |
|
|
110 |
|
# Used in croak error messages. |
111 |
|
my $me = basename ($0); |
112 |
|
|
113 |
################################################ |
################################################ |
114 |
## Constructor |
## Constructor |
143 |
|
|
144 |
if (!$fh->SUPER::open (@_)) |
if (!$fh->SUPER::open (@_)) |
145 |
{ |
{ |
|
my $me = basename ($0); |
|
146 |
croak "$me: cannot open $file: $!\n"; |
croak "$me: cannot open $file: $!\n"; |
147 |
} |
} |
148 |
|
|
162 |
my ($fh) = shift; |
my ($fh) = shift; |
163 |
if (!$fh->SUPER::close (@_)) |
if (!$fh->SUPER::close (@_)) |
164 |
{ |
{ |
165 |
my $me = basename ($0); |
my $file = $fh->name; |
|
my $file = ${*$fh}{'autom4te_xfile_file'}; |
|
166 |
croak "$me: cannot close $file: $!\n"; |
croak "$me: cannot close $file: $!\n"; |
167 |
} |
} |
168 |
} |
} |
175 |
# so we do that here. |
# so we do that here. |
176 |
sub getline |
sub getline |
177 |
{ |
{ |
178 |
local $_ = $_[0]->SUPER::getline; |
local $_ = $_[0]->SUPER::getline; |
179 |
# Perform a _global_ replacement: $_ may can contains many lines |
# Perform a _global_ replacement: $_ may can contains many lines |
180 |
# in slurp mode ($/ = undef). |
# in slurp mode ($/ = undef). |
181 |
s/\015\012/\n/gs if defined $_; |
s/\015\012/\n/gs if defined $_; |
182 |
return $_; |
return $_; |
183 |
} |
} |
184 |
|
|
185 |
################################################ |
################################################ |
188 |
|
|
189 |
sub getlines |
sub getlines |
190 |
{ |
{ |
191 |
my @res = (); |
my @res = (); |
192 |
my $line; |
my $line; |
193 |
push @res, $line while $line = $_[0]->getline; |
push @res, $line while $line = $_[0]->getline; |
194 |
return @res; |
return @res; |
195 |
|
} |
196 |
|
|
197 |
|
################################################ |
198 |
|
## Name |
199 |
|
## |
200 |
|
|
201 |
|
sub name |
202 |
|
{ |
203 |
|
my ($fh) = shift; |
204 |
|
return ${*$fh}{'autom4te_xfile_file'}; |
205 |
|
} |
206 |
|
|
207 |
|
################################################ |
208 |
|
## Lock |
209 |
|
## |
210 |
|
|
211 |
|
sub lock |
212 |
|
{ |
213 |
|
use Fcntl qw(:DEFAULT :flock); |
214 |
|
my ($fh) = shift; |
215 |
|
if (!flock ($fh, @_)) |
216 |
|
{ |
217 |
|
my $file = $fh->name; |
218 |
|
croak "$me: cannot lock $file with @_: $!\n"; |
219 |
|
} |
220 |
|
} |
221 |
|
|
222 |
|
################################################ |
223 |
|
## Seek |
224 |
|
## |
225 |
|
|
226 |
|
sub seek |
227 |
|
{ |
228 |
|
my ($fh) = shift; |
229 |
|
# Cannot use @_ here. |
230 |
|
if (!seek ($fh, $_[0], $_[1])) |
231 |
|
{ |
232 |
|
my $file = $fh->name; |
233 |
|
croak "$me: cannot rewind $file with @_: $!\n"; |
234 |
|
} |
235 |
|
} |
236 |
|
|
237 |
|
################################################ |
238 |
|
## Truncate |
239 |
|
## |
240 |
|
|
241 |
|
sub truncate |
242 |
|
{ |
243 |
|
my ($fh) = shift; |
244 |
|
if (!truncate ($fh, @_)) |
245 |
|
{ |
246 |
|
my $file = $fh->name; |
247 |
|
croak "$me: cannot truncate $file with @_: $!\n"; |
248 |
|
} |
249 |
} |
} |
250 |
|
|
251 |
1; |
1; |