Commit | Line | Data |
8990e307 |
1 | package FileHandle; |
2 | |
a0d0e21e |
3 | # Note that some additional FileHandle methods are defined in POSIX.pm. |
4 | |
f06db76b |
5 | =head1 NAME |
6 | |
7 | FileHandle - supply object methods for filehandles |
8 | |
9 | cacheout - keep more files open than the system permits |
10 | |
11 | =head1 SYNOPSIS |
12 | |
13 | use FileHandle; |
14 | autoflush STDOUT 1; |
15 | |
16 | cacheout($path); |
17 | print $path @data; |
18 | |
19 | =head1 DESCRIPTION |
20 | |
21 | See L<perlvar> for complete descriptions of each of the following supported C<FileHandle> |
22 | methods: |
23 | |
24 | print |
25 | autoflush |
26 | output_field_separator |
27 | output_record_separator |
28 | input_record_separator |
29 | input_line_number |
30 | format_page_number |
31 | format_lines_per_page |
32 | format_lines_left |
33 | format_name |
34 | format_top_name |
35 | format_line_break_characters |
36 | format_formfeed |
37 | |
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. |
41 | |
42 | =head1 BUGS |
43 | |
44 | F<sys/param.h> lies with its C<NOFILE> define on some systems, |
45 | so you may have to set $cacheout::maxopen yourself. |
46 | |
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. |
51 | |
52 | =cut |
53 | |
a0d0e21e |
54 | require 5.000; |
55 | use English; |
56 | use Exporter; |
2304df62 |
57 | |
a0d0e21e |
58 | @ISA = qw(Exporter); |
2304df62 |
59 | @EXPORT = qw( |
60 | print |
61 | autoflush |
62 | output_field_separator |
63 | output_record_separator |
64 | input_record_separator |
65 | input_line_number |
66 | format_page_number |
67 | format_lines_per_page |
68 | format_lines_left |
69 | format_name |
70 | format_top_name |
71 | format_line_break_characters |
72 | format_formfeed |
a0d0e21e |
73 | cacheout |
2304df62 |
74 | ); |
8990e307 |
75 | |
76 | sub print { |
77 | local($this) = shift; |
78 | print $this @_; |
79 | } |
80 | |
2304df62 |
81 | sub autoflush { |
8990e307 |
82 | local($old) = select($_[0]); |
83 | local($prev) = $OUTPUT_AUTOFLUSH; |
84 | $OUTPUT_AUTOFLUSH = @_ > 1 ? $_[1] : 1; |
85 | select($old); |
86 | $prev; |
87 | } |
88 | |
89 | sub output_field_separator { |
90 | local($old) = select($_[0]); |
91 | local($prev) = $OUTPUT_FIELD_SEPARATOR; |
92 | $OUTPUT_FIELD_SEPARATOR = $_[1] if @_ > 1; |
93 | select($old); |
94 | $prev; |
95 | } |
96 | |
97 | sub output_record_separator { |
98 | local($old) = select($_[0]); |
99 | local($prev) = $OUTPUT_RECORD_SEPARATOR; |
100 | $OUTPUT_RECORD_SEPARATOR = $_[1] if @_ > 1; |
101 | select($old); |
102 | $prev; |
103 | } |
104 | |
105 | sub input_record_separator { |
106 | local($old) = select($_[0]); |
107 | local($prev) = $INPUT_RECORD_SEPARATOR; |
108 | $INPUT_RECORD_SEPARATOR = $_[1] if @_ > 1; |
109 | select($old); |
110 | $prev; |
111 | } |
112 | |
113 | sub input_line_number { |
114 | local($old) = select($_[0]); |
115 | local($prev) = $INPUT_LINE_NUMBER; |
116 | $INPUT_LINE_NUMBER = $_[1] if @_ > 1; |
117 | select($old); |
118 | $prev; |
119 | } |
120 | |
121 | sub format_page_number { |
122 | local($old) = select($_[0]); |
123 | local($prev) = $FORMAT_PAGE_NUMBER; |
124 | $FORMAT_PAGE_NUMBER = $_[1] if @_ > 1; |
125 | select($old); |
126 | $prev; |
127 | } |
128 | |
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; |
133 | select($old); |
134 | $prev; |
135 | } |
136 | |
137 | sub format_lines_left { |
138 | local($old) = select($_[0]); |
139 | local($prev) = $FORMAT_LINES_LEFT; |
140 | $FORMAT_LINES_LEFT = $_[1] if @_ > 1; |
141 | select($old); |
142 | $prev; |
143 | } |
144 | |
145 | sub format_name { |
146 | local($old) = select($_[0]); |
147 | local($prev) = $FORMAT_NAME; |
148 | $FORMAT_NAME = $_[1] if @_ > 1; |
149 | select($old); |
150 | $prev; |
151 | } |
152 | |
153 | sub format_top_name { |
154 | local($old) = select($_[0]); |
155 | local($prev) = $FORMAT_TOP_NAME; |
156 | $FORMAT_TOP_NAME = $_[1] if @_ > 1; |
157 | select($old); |
158 | $prev; |
159 | } |
160 | |
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; |
165 | select($old); |
166 | $prev; |
167 | } |
168 | |
169 | sub format_formfeed { |
170 | local($old) = select($_[0]); |
171 | local($prev) = $FORMAT_FORMFEED; |
172 | $FORMAT_FORMFEED = $_[1] if @_ > 1; |
173 | select($old); |
174 | $prev; |
175 | } |
176 | |
a0d0e21e |
177 | |
178 | # --- cacheout functions --- |
179 | |
180 | # Open in their package. |
181 | |
182 | sub cacheout_open { |
183 | my $pack = caller(1); |
184 | open(*{$pack . '::' . $_[0]}, $_[1]); |
185 | } |
186 | |
187 | sub cacheout_close { |
188 | my $pack = caller(1); |
189 | close(*{$pack . '::' . $_[0]}); |
190 | } |
191 | |
192 | # But only this sub name is visible to them. |
193 | |
194 | sub cacheout { |
195 | ($file) = @_; |
196 | if (!$cacheout_maxopen){ |
197 | if (open(PARAM,'/usr/include/sys/param.h')) { |
198 | local($.); |
199 | while (<PARAM>) { |
200 | $cacheout_maxopen = $1 - 4 |
201 | if /^\s*#\s*define\s+NOFILE\s+(\d+)/; |
202 | } |
203 | close PARAM; |
204 | } |
205 | $cacheout_maxopen = 16 unless $cacheout_maxopen; |
206 | } |
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{$_}; } |
213 | } |
214 | &cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file) |
215 | || croak("Can't create $file: $!"); |
216 | } |
217 | $isopen{$file} = ++$cacheout_seq; |
218 | } |
219 | |
220 | $cacheout_seq = 0; |
221 | $cacheout_numopen = 0; |
222 | |
8990e307 |
223 | 1; |