lib/FileHandle.pm

   1 package FileHandle;
   2
   3 # Note that some additional FileHandle methods are defined in POSIX.pm.
   4
   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
  54 require 5.000;
  55 use English;
  56 use Exporter;
  57
  58 @ISA = qw(Exporter);
  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
  73     cacheout
  74 );
  75
  76 sub print {
  77     local($this) = shift;
  78     print $this @_;
  79 }
  80
  81 sub autoflush {
  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
 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
 223 1;