3 # Note that some additional FileHandle methods are defined in POSIX.pm.
7 FileHandle - supply object methods for filehandles
9 cacheout - keep more files open than the system permits
21 See L<perlvar> for complete descriptions of each of the following supported C<FileHandle>
25 output_field_separator
26 output_record_separator
27 input_record_separator
34 format_line_break_characters
37 Furthermore, for doing normal I/O you might need these:
43 See L<perlfunc/print>.
47 See L<perlfunc/printf>.
51 This works like <$fh> described in L<perlop/"I/O Operators"> except that it's more readable
52 and can be safely called in an array context but still
53 returns just one line.
57 This works like <$fh> when called in an array context to
58 read all the remaining lines in a file, except that it's more readable.
59 It will also croak() if accidentally called in a scalar context.
63 =head2 The cacheout() Library
65 The cacheout() function will make sure that there's a filehandle
66 open for writing available as the pathname you give it. It automatically
67 closes and re-opens files if you exceed your system file descriptor maximum.
72 L<perlop/"I/O Operators">,
77 F<sys/param.h> lies with its C<NOFILE> define on some systems,
78 so you may have to set $cacheout::maxopen yourself.
80 Some of the methods that set variables (like format_name()) don't
83 The POSIX functions that create FileHandle methods should be
84 in this module instead.
86 Due to backwards compatibility, all filehandles resemble objects
87 of class C<FileHandle>, or actually classes derived from that class.
88 They actually aren't. Which means you can't derive your own
89 class from C<FileHandle> and inherit those methods.
101 output_field_separator
102 output_record_separator
103 input_record_separator
106 format_lines_per_page
110 format_line_break_characters
122 local($this) = shift;
127 local($this) = shift;
132 local($this) = shift;
133 croak "usage: FileHandle::getline()" if @_;
134 return scalar <$this>;
138 local($this) = shift;
139 croak "usage: FileHandle::getline()" if @_;
140 croak "can't call FileHandle::getlines in a scalar context" if wantarray;
145 local($old) = select($_[0]);
146 local($prev) = $OUTPUT_AUTOFLUSH;
147 $OUTPUT_AUTOFLUSH = @_ > 1 ? $_[1] : 1;
152 sub output_field_separator {
153 local($old) = select($_[0]);
154 local($prev) = $OUTPUT_FIELD_SEPARATOR;
155 $OUTPUT_FIELD_SEPARATOR = $_[1] if @_ > 1;
160 sub output_record_separator {
161 local($old) = select($_[0]);
162 local($prev) = $OUTPUT_RECORD_SEPARATOR;
163 $OUTPUT_RECORD_SEPARATOR = $_[1] if @_ > 1;
168 sub input_record_separator {
169 local($old) = select($_[0]);
170 local($prev) = $INPUT_RECORD_SEPARATOR;
171 $INPUT_RECORD_SEPARATOR = $_[1] if @_ > 1;
176 sub input_line_number {
177 local($old) = select($_[0]);
178 local($prev) = $INPUT_LINE_NUMBER;
179 $INPUT_LINE_NUMBER = $_[1] if @_ > 1;
184 sub format_page_number {
185 local($old) = select($_[0]);
186 local($prev) = $FORMAT_PAGE_NUMBER;
187 $FORMAT_PAGE_NUMBER = $_[1] if @_ > 1;
192 sub format_lines_per_page {
193 local($old) = select($_[0]);
194 local($prev) = $FORMAT_LINES_PER_PAGE;
195 $FORMAT_LINES_PER_PAGE = $_[1] if @_ > 1;
200 sub format_lines_left {
201 local($old) = select($_[0]);
202 local($prev) = $FORMAT_LINES_LEFT;
203 $FORMAT_LINES_LEFT = $_[1] if @_ > 1;
209 local($old) = select($_[0]);
210 local($prev) = $FORMAT_NAME;
211 $FORMAT_NAME = $_[1] if @_ > 1;
216 sub format_top_name {
217 local($old) = select($_[0]);
218 local($prev) = $FORMAT_TOP_NAME;
219 $FORMAT_TOP_NAME = $_[1] if @_ > 1;
224 sub format_line_break_characters {
225 local($old) = select($_[0]);
226 local($prev) = $FORMAT_LINE_BREAK_CHARACTERS;
227 $FORMAT_LINE_BREAK_CHARACTERS = $_[1] if @_ > 1;
232 sub format_formfeed {
233 local($old) = select($_[0]);
234 local($prev) = $FORMAT_FORMFEED;
235 $FORMAT_FORMFEED = $_[1] if @_ > 1;
241 # --- cacheout functions ---
243 # Open in their package.
246 my $pack = caller(1);
247 open(*{$pack . '::' . $_[0]}, $_[1]);
251 my $pack = caller(1);
252 close(*{$pack . '::' . $_[0]});
255 # But only this sub name is visible to them.
259 if (!$cacheout_maxopen){
260 if (open(PARAM,'/usr/include/sys/param.h')) {
263 $cacheout_maxopen = $1 - 4
264 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
268 $cacheout_maxopen = 16 unless $cacheout_maxopen;
270 if (!$isopen{$file}) {
271 if (++$cacheout_numopen > $cacheout_maxopen) {
272 local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
273 splice(@lru, $cacheout_maxopen / 3);
274 $cacheout_numopen -= @lru;
275 for (@lru) { &cacheout_close($_); delete $isopen{$_}; }
277 &cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file)
278 || croak("Can't create $file: $!");
280 $isopen{$file} = ++$cacheout_seq;
284 $cacheout_numopen = 0;