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>
26 output_field_separator
27 output_record_separator
28 input_record_separator
35 format_line_break_characters
38 The cacheout() function will make sure that there's a filehandle
39 open for writing available as the pathname you give it. It automatically
40 closes and re-opens files if you exceed your system file descriptor maximum.
44 F<sys/param.h> lies with its C<NOFILE> define on some systems,
45 so you may have to set $cacheout::maxopen yourself.
47 Due to backwards compatibility, all filehandles resemble objects
48 of class C<FileHandle>, or actually classes derived from that class.
49 They actually aren't. Which means you can't derive your own
50 class from C<FileHandle> and inherit those methods.
62 output_field_separator
63 output_record_separator
64 input_record_separator
71 format_line_break_characters
82 local($old) = select($_[0]);
83 local($prev) = $OUTPUT_AUTOFLUSH;
84 $OUTPUT_AUTOFLUSH = @_ > 1 ? $_[1] : 1;
89 sub output_field_separator {
90 local($old) = select($_[0]);
91 local($prev) = $OUTPUT_FIELD_SEPARATOR;
92 $OUTPUT_FIELD_SEPARATOR = $_[1] if @_ > 1;
97 sub output_record_separator {
98 local($old) = select($_[0]);
99 local($prev) = $OUTPUT_RECORD_SEPARATOR;
100 $OUTPUT_RECORD_SEPARATOR = $_[1] if @_ > 1;
105 sub input_record_separator {
106 local($old) = select($_[0]);
107 local($prev) = $INPUT_RECORD_SEPARATOR;
108 $INPUT_RECORD_SEPARATOR = $_[1] if @_ > 1;
113 sub input_line_number {
114 local($old) = select($_[0]);
115 local($prev) = $INPUT_LINE_NUMBER;
116 $INPUT_LINE_NUMBER = $_[1] if @_ > 1;
121 sub format_page_number {
122 local($old) = select($_[0]);
123 local($prev) = $FORMAT_PAGE_NUMBER;
124 $FORMAT_PAGE_NUMBER = $_[1] if @_ > 1;
129 sub format_lines_per_page {
130 local($old) = select($_[0]);
131 local($prev) = $FORMAT_LINES_PER_PAGE;
132 $FORMAT_LINES_PER_PAGE = $_[1] if @_ > 1;
137 sub format_lines_left {
138 local($old) = select($_[0]);
139 local($prev) = $FORMAT_LINES_LEFT;
140 $FORMAT_LINES_LEFT = $_[1] if @_ > 1;
146 local($old) = select($_[0]);
147 local($prev) = $FORMAT_NAME;
148 $FORMAT_NAME = $_[1] if @_ > 1;
153 sub format_top_name {
154 local($old) = select($_[0]);
155 local($prev) = $FORMAT_TOP_NAME;
156 $FORMAT_TOP_NAME = $_[1] if @_ > 1;
161 sub format_line_break_characters {
162 local($old) = select($_[0]);
163 local($prev) = $FORMAT_LINE_BREAK_CHARACTERS;
164 $FORMAT_LINE_BREAK_CHARACTERS = $_[1] if @_ > 1;
169 sub format_formfeed {
170 local($old) = select($_[0]);
171 local($prev) = $FORMAT_FORMFEED;
172 $FORMAT_FORMFEED = $_[1] if @_ > 1;
178 # --- cacheout functions ---
180 # Open in their package.
183 my $pack = caller(1);
184 open(*{$pack . '::' . $_[0]}, $_[1]);
188 my $pack = caller(1);
189 close(*{$pack . '::' . $_[0]});
192 # But only this sub name is visible to them.
196 if (!$cacheout_maxopen){
197 if (open(PARAM,'/usr/include/sys/param.h')) {
200 $cacheout_maxopen = $1 - 4
201 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
205 $cacheout_maxopen = 16 unless $cacheout_maxopen;
207 if (!$isopen{$file}) {
208 if (++$cacheout_numopen > $cacheout_maxopen) {
209 local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
210 splice(@lru, $cacheout_maxopen / 3);
211 $cacheout_numopen -= @lru;
212 for (@lru) { &cacheout_close($_); delete $isopen{$_}; }
214 &cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file)
215 || croak("Can't create $file: $!");
217 $isopen{$file} = ++$cacheout_seq;
221 $cacheout_numopen = 0;