6 use POSIX qw( :fcntl_h ) ;
7 use Fcntl qw( :DEFAULT ) ;
10 my $is_win32 = $^O =~ /win32/i ;
12 # Install subs for various constants that aren't set in older perls
13 # (< 5.005). Fcntl on old perls uses Exporter to define subs without a
14 # () prototype These can't be overridden with the constant pragma or
15 # we get a prototype mismatch. Hence this less than aesthetically
16 # appealing BEGIN block:
19 unless( eval { defined SEEK_SET() } ) {
20 *SEEK_SET = sub { 0 };
21 *SEEK_CUR = sub { 1 };
22 *SEEK_END = sub { 2 };
25 unless( eval { defined O_BINARY() } ) {
26 *O_BINARY = sub { 0 };
27 *O_RDONLY = sub { 0 };
28 *O_WRONLY = sub { 1 };
31 unless ( eval { defined O_APPEND() } ) {
33 if ( $^O =~ /olaris/ ) {
34 *O_APPEND = sub { 8 };
35 *O_CREAT = sub { 256 };
36 *O_EXCL = sub { 1024 };
38 elsif ( $^O =~ /inux/ ) {
39 *O_APPEND = sub { 1024 };
40 *O_CREAT = sub { 64 };
41 *O_EXCL = sub { 128 };
43 elsif ( $^O =~ /BSD/i ) {
44 *O_APPEND = sub { 8 };
45 *O_CREAT = sub { 512 };
46 *O_EXCL = sub { 2048 };
51 # print "OS [$^O]\n" ;
53 # print "O_BINARY = ", O_BINARY(), "\n" ;
54 # print "O_RDONLY = ", O_RDONLY(), "\n" ;
55 # print "O_WRONLY = ", O_WRONLY(), "\n" ;
56 # print "O_APPEND = ", O_APPEND(), "\n" ;
57 # print "O_CREAT ", O_CREAT(), "\n" ;
58 # print "O_EXCL ", O_EXCL(), "\n" ;
61 use vars qw( %EXPORT_TAGS @EXPORT_OK $VERSION @EXPORT ) ;
63 %EXPORT_TAGS = ( 'all' => [
64 qw( read_file write_file overwrite_file append_file read_dir ) ] ) ;
66 @EXPORT = ( @{ $EXPORT_TAGS{'all'} } );
67 @EXPORT_OK = qw( slurp ) ;
71 *slurp = \&read_file ;
75 my( $file_name, %args ) = @_ ;
77 # set the buffer to either the passed in one or ours and init it to the null
81 my $buf_ref = $args{'buf_ref'} || \$buf ;
84 my( $read_fh, $size_left, $blk_size ) ;
86 # check if we are reading from a handle (glob ref or IO:: object)
88 if ( ref $file_name ) {
90 # slurping a handle so use it and don't open anything.
91 # set the block size so we know it is a handle and read that amount
93 $read_fh = $file_name ;
94 $blk_size = $args{'blk_size'} || 1024 * 1024 ;
95 $size_left = $blk_size ;
97 # DEEP DARK MAGIC. this checks the UNTAINT IO flag of a
98 # glob/handle. only the DATA handle is untainted (since it is from
99 # trusted data in the source file). this allows us to test if this is
100 # the DATA handle and then to do a sysseek to make sure it gets
101 # slurped correctly. on some systems, the buffered i/o pointer is not
102 # left at the same place as the fd pointer. this sysseek makes them
103 # the same so slurping with sysread will work.
109 @_ = ( \%args, <<ERR ) ;
110 Can't find B.pm with this Perl: $!.
111 That module is needed to slurp the DATA handle.
116 if ( B::svref_2object( $read_fh )->IO->IoFLAGS & 16 ) {
118 # set the seek position to the current tell.
120 sysseek( $read_fh, tell( $read_fh ), SEEK_SET ) ||
126 # a regular file. set the sysopen mode
128 my $mode = O_RDONLY ;
129 $mode |= O_BINARY if $args{'binmode'} ;
131 #printf "RD: BINARY %x MODE %x\n", O_BINARY, $mode ;
133 # open the file and handle any error
136 unless ( sysopen( $read_fh, $file_name, $mode ) ) {
137 @_ = ( \%args, "read_file '$file_name' - sysopen: $!");
141 # get the size of the file for use in the read loop
143 $size_left = -s $read_fh ;
145 unless( $size_left ) {
147 $blk_size = $args{'blk_size'} || 1024 * 1024 ;
148 $size_left = $blk_size ;
152 # infinite read loop. we exit when we are done slurping
156 # do the read and see how much we got
158 my $read_cnt = sysread( $read_fh, ${$buf_ref},
159 $size_left, length ${$buf_ref} ) ;
161 if ( defined $read_cnt ) {
163 # good read. see if we hit EOF (nothing left to read)
165 last if $read_cnt == 0 ;
167 # loop if we are slurping a handle. we don't track $size_left then.
171 # count down how much we read and loop if we have more to read.
172 $size_left -= $read_cnt ;
173 last if $size_left <= 0 ;
177 # handle the read error
179 @_ = ( \%args, "read_file '$file_name' - sysread: $!");
183 # fix up cr/lf to be a newline if this is a windows text file
185 ${$buf_ref} =~ s/\015\012/\n/g if $is_win32 && !$args{'binmode'} ;
187 # this is the 5 returns in a row. each handles one possible
188 # combination of caller context and requested return type
191 $sep = '\n\n+' if defined $sep && $sep eq '' ;
193 # caller wants to get an array ref of lines
195 # this split doesn't work since it tries to use variable length lookbehind
196 # the m// line works.
197 # return [ split( m|(?<=$sep)|, ${$buf_ref} ) ] if $args{'array_ref'} ;
198 return [ length(${$buf_ref}) ? ${$buf_ref} =~ /(.*?$sep|.+)/sg : () ]
199 if $args{'array_ref'} ;
201 # caller wants a list of lines (normal list context)
203 # same problem with this split as before.
204 # return split( m|(?<=$sep)|, ${$buf_ref} ) if wantarray ;
205 return length(${$buf_ref}) ? ${$buf_ref} =~ /(.*?$sep|.+)/sg : ()
208 # caller wants a scalar ref to the slurped text
210 return $buf_ref if $args{'scalar_ref'} ;
212 # caller wants a scalar with the slurped text (normal scalar context)
214 return ${$buf_ref} if defined wantarray ;
216 # caller passed in an i/o buffer by reference (normal void context)
223 my $file_name = shift ;
225 # get the optional argument hash ref from @_ or an empty hash ref.
227 my $args = ( ref $_[0] eq 'HASH' ) ? shift : {} ;
229 my( $buf_ref, $write_fh, $no_truncate, $orig_file_name, $data_is_ref ) ;
231 # get the buffer ref - it depends on how the data is passed into write_file
232 # after this if/else $buf_ref will have a scalar ref to the data.
234 if ( ref $args->{'buf_ref'} eq 'SCALAR' ) {
236 # a scalar ref passed in %args has the data
237 # note that the data was passed by ref
239 $buf_ref = $args->{'buf_ref'} ;
242 elsif ( ref $_[0] eq 'SCALAR' ) {
244 # the first value in @_ is the scalar ref to the data
245 # note that the data was passed by ref
250 elsif ( ref $_[0] eq 'ARRAY' ) {
252 # the first value in @_ is the array ref to the data so join it.
254 ${$buf_ref} = join '', @{$_[0]} ;
258 # good old @_ has all the data so join it.
260 ${$buf_ref} = join '', @_ ;
263 # see if we were passed a open handle to spew to.
265 if ( ref $file_name ) {
267 # we have a handle. make sure we don't call truncate on it.
269 $write_fh = $file_name ;
274 # spew to regular file.
276 if ( $args->{'atomic'} ) {
278 # in atomic mode, we spew to a temp file so make one and save the original
280 $orig_file_name = $file_name ;
281 $file_name .= ".$$" ;
284 # set the mode for the sysopen
286 my $mode = O_WRONLY | O_CREAT ;
287 $mode |= O_BINARY if $args->{'binmode'} ;
288 $mode |= O_APPEND if $args->{'append'} ;
289 $mode |= O_EXCL if $args->{'no_clobber'} ;
291 #printf "WR: BINARY %x MODE %x\n", O_BINARY, $mode ;
293 # open the file and handle any error.
296 unless ( sysopen( $write_fh, $file_name, $mode ) ) {
297 @_ = ( $args, "write_file '$file_name' - sysopen: $!");
302 sysseek( $write_fh, 0, SEEK_END ) if $args->{'append'} ;
305 #print 'WR before data ', unpack( 'H*', ${$buf_ref}), "\n" ;
307 # fix up newline to write cr/lf if this is a windows text file
309 if ( $is_win32 && !$args->{'binmode'} ) {
311 # copy the write data if it was passed by ref so we don't clobber the
313 $buf_ref = \do{ my $copy = ${$buf_ref}; } if $data_is_ref ;
314 ${$buf_ref} =~ s/\n/\015\012/g ;
317 #print 'after data ', unpack( 'H*', ${$buf_ref}), "\n" ;
319 # get the size of how much we are writing and init the offset into that buffer
321 my $size_left = length( ${$buf_ref} ) ;
324 # loop until we have no more data left to write
328 # do the write and track how much we just wrote
330 my $write_cnt = syswrite( $write_fh, ${$buf_ref},
331 $size_left, $offset ) ;
333 unless ( defined $write_cnt ) {
336 @_ = ( $args, "write_file '$file_name' - syswrite: $!");
340 # track much left to write and where to write from in the buffer
342 $size_left -= $write_cnt ;
343 $offset += $write_cnt ;
345 } while( $size_left > 0 ) ;
347 # we truncate regular files in case we overwrite a long file with a shorter file
348 # so seek to the current position to get it (same as tell()).
351 sysseek( $write_fh, 0, SEEK_CUR ) ) unless $no_truncate ;
355 # handle the atomic mode - move the temp file to the original filename.
357 rename( $file_name, $orig_file_name ) if $args->{'atomic'} ;
362 # this is for backwards compatibility with the previous File::Slurp module.
363 # write_file always overwrites an existing file
365 *overwrite_file = \&write_file ;
367 # the current write_file has an append mode so we use that. this
368 # supports the same API with an optional second argument which is a
369 # hash ref of options.
373 # get the optional args hash ref
375 if ( ref $args eq 'HASH' ) {
377 # we were passed an args ref so just mark the append mode
379 $args->{append} = 1 ;
383 # no args hash so insert one with the append mode
385 splice( @_, 1, 0, { append => 1 } ) ;
388 # magic goto the main write_file sub. this overlays the sub without touching
394 # basic wrapper around opendir/readdir
398 my ($dir, %args ) = @_;
400 # this handle will be destroyed upon return
404 # open the dir and handle any errors
406 unless ( opendir( DIRH, $dir ) ) {
408 @_ = ( \%args, "read_dir '$dir' - opendir: $!" ) ;
412 my @dir_entries = readdir(DIRH) ;
414 @dir_entries = grep( $_ ne "." && $_ ne "..", @dir_entries )
415 unless $args{'keep_dot_dot'} ;
417 return @dir_entries if wantarray ;
418 return \@dir_entries ;
421 # error handling section
423 # all the error handling uses magic goto so the caller will get the
424 # error message as if from their code and not this module. if we just
425 # did a call on the error code, the carp/croak would report it from
426 # this module since the error sub is one level down on the call stack
427 # from read_file/write_file/read_dir.
437 my( $args, $err_msg ) = @_ ;
439 # get the error function to use
441 my $func = $err_func{ $args->{'err_mode'} || 'croak' } ;
443 # if we didn't find it in our error function hash, they must have set
444 # it to quiet and we don't do anything.
446 return unless $func ;
448 # call the carp/croak function
452 # return a hard undef (in list context this will be a single value of
453 # undef which is not a legal in-band value)
463 File::Slurp - Efficient Reading/Writing of Complete Files
469 my $text = read_file( 'filename' ) ;
470 my @lines = read_file( 'filename' ) ;
472 write_file( 'filename', @lines ) ;
474 use File::Slurp qw( slurp ) ;
476 my $text = slurp( 'filename' ) ;
481 This module provides subs that allow you to read or write entire files
482 with one simple call. They are designed to be simple to use, have
483 flexible ways to pass in or get the file contents and to be very
484 efficient. There is also a sub to read in all the files in a
485 directory other than C<.> and C<..>
487 These slurp/spew subs work for files, pipes and
488 sockets, and stdio, pseudo-files, and DATA.
492 This sub reads in an entire file and returns its contents to the
493 caller. In list context it will return a list of lines (using the
494 current value of $/ as the separator including support for paragraph
495 mode when it is set to ''). In scalar context it returns the entire
496 file as a single scalar.
498 my $text = read_file( 'filename' ) ;
499 my @lines = read_file( 'filename' ) ;
501 The first argument to C<read_file> is the filename and the rest of the
502 arguments are key/value pairs which are optional and which modify the
503 behavior of the call. Other than binmode the options all control how
504 the slurped file is returned to the caller.
506 If the first argument is a file handle reference or I/O object (if ref
507 is true), then that handle is slurped in. This mode is supported so
508 you slurp handles such as C<DATA>, C<STDIN>. See the test handle.t
509 for an example that does C<open( '-|' )> and child process spews data
510 to the parant which slurps it in. All of the options that control how
511 the data is returned to the caller still work in this case.
513 NOTE: as of version 9999.06, read_file works correctly on the C<DATA>
514 handle. It used to need a sysseek workaround but that is now handled
515 when needed by the module itself.
517 You can optionally request that C<slurp()> is exported to your code. This
518 is an alias for read_file and is meant to be forward compatible with
519 Perl 6 (which will have slurp() built-in).
525 If you set the binmode option, then the file will be slurped in binary
528 my $bin_data = read_file( $bin_file, binmode => ':raw' ) ;
530 NOTE: this actually sets the O_BINARY mode flag for sysopen. It
531 probably should call binmode and pass its argument to support other
536 If this boolean option is set, the return value (only in scalar
537 context) will be an array reference which contains the lines of the
538 slurped file. The following two calls are equivalent:
540 my $lines_ref = read_file( $bin_file, array_ref => 1 ) ;
541 my $lines_ref = [ read_file( $bin_file ) ] ;
545 If this boolean option is set, the return value (only in scalar
546 context) will be an scalar reference to a string which is the contents
547 of the slurped file. This will usually be faster than returning the
550 my $text_ref = read_file( $bin_file, scalar_ref => 1 ) ;
554 You can use this option to pass in a scalar reference and the slurped
555 file contents will be stored in the scalar. This can be used in
556 conjunction with any of the other options.
558 my $text_ref = read_file( $bin_file, buf_ref => \$buffer,
560 my @lines = read_file( $bin_file, buf_ref => \$buffer ) ;
564 You can use this option to set the block size used when slurping from an already open handle (like \*STDIN). It defaults to 1MB.
566 my $text_ref = read_file( $bin_file, blk_size => 10_000_000,
571 You can use this option to control how read_file behaves when an error
572 occurs. This option defaults to 'croak'. You can set it to 'carp' or
573 to 'quiet to have no error handling. This code wants to carp and then
574 read abother file if it fails.
576 my $text_ref = read_file( $file, err_mode => 'carp' ) ;
577 unless ( $text_ref ) {
579 # read a different file but croak if not found
580 $text_ref = read_file( $another_file ) ;
583 # process ${$text_ref}
587 This sub writes out an entire file in one call.
589 write_file( 'filename', @data ) ;
591 The first argument to C<write_file> is the filename. The next argument
592 is an optional hash reference and it contains key/values that can
593 modify the behavior of C<write_file>. The rest of the argument list is
594 the data to be written to the file.
596 write_file( 'filename', {append => 1 }, @data ) ;
597 write_file( 'filename', {binmode => ':raw' }, $buffer ) ;
599 As a shortcut if the first data argument is a scalar or array
600 reference, it is used as the only data to be written to the file. Any
601 following arguments in @_ are ignored. This is a faster way to pass in
602 the output to be written to the file and is equivilent to the
603 C<buf_ref> option. These following pairs are equivilent but the pass
604 by reference call will be faster in most cases (especially with larger
607 write_file( 'filename', \$buffer ) ;
608 write_file( 'filename', $buffer ) ;
610 write_file( 'filename', \@lines ) ;
611 write_file( 'filename', @lines ) ;
613 If the first argument is a file handle reference or I/O object (if ref
614 is true), then that handle is slurped in. This mode is supported so
615 you spew to handles such as \*STDOUT. See the test handle.t for an
616 example that does C<open( '-|' )> and child process spews data to the
617 parant which slurps it in. All of the options that control how the
618 data is passes into C<write_file> still work in this case.
620 C<write_file> returns 1 upon successfully writing the file or undef if
621 it encountered an error.
627 If you set the binmode option, then the file will be written in binary
630 write_file( $bin_file, {binmode => ':raw'}, @data ) ;
632 NOTE: this actually sets the O_BINARY mode flag for sysopen. It
633 probably should call binmode and pass its argument to support other
638 You can use this option to pass in a scalar reference which has the
639 data to be written. If this is set then any data arguments (including
640 the scalar reference shortcut) in @_ will be ignored. These are
643 write_file( $bin_file, { buf_ref => \$buffer } ) ;
644 write_file( $bin_file, \$buffer ) ;
645 write_file( $bin_file, $buffer ) ;
649 If you set this boolean option, the file will be written to in an
650 atomic fashion. A temporary file name is created by appending the pid
651 ($$) to the file name argument and that file is spewed to. After the
652 file is closed it is renamed to the original file name (and rename is
653 an atomic operation on most OS's). If the program using this were to
654 crash in the middle of this, then the file with the pid suffix could
659 If you set this boolean option, the data will be written at the end of
662 write_file( $file, {append => 1}, @data ) ;
664 C<write_file> croaks if it cannot open the file. It returns true if it
665 succeeded in writing out the file and undef if there was an
666 error. (Yes, I know if it croaks it can't return anything but that is
667 for when I add the options to select the error handling mode).
671 If you set this boolean option, an existing file will not be overwritten.
673 write_file( $file, {no_clobber => 1}, @data ) ;
677 You can use this option to control how C<write_file> behaves when an
678 error occurs. This option defaults to 'croak'. You can set it to
679 'carp' or to 'quiet' to have no error handling other than the return
680 value. If the first call to C<write_file> fails it will carp and then
681 write to another file. If the second call to C<write_file> fails, it
684 unless ( write_file( $file, { err_mode => 'carp', \$data ) ;
686 # write a different file but croak if not found
687 write_file( $other_file, \$data ) ;
690 =head2 overwrite_file
692 This sub is just a typeglob alias to write_file since write_file
693 always overwrites an existing file. This sub is supported for
694 backwards compatibility with the original version of this module. See
695 write_file for its API and behavior.
699 This sub will write its data to the end of the file. It is a wrapper
700 around write_file and it has the same API so see that for the full
701 documentation. These calls are equivilent:
703 append_file( $file, @data ) ;
704 write_file( $file, {append => 1}, @data ) ;
708 This sub reads all the file names from directory and returns them to
709 the caller but C<.> and C<..> are removed by default.
711 my @files = read_dir( '/path/to/dir' ) ;
713 It croaks if it cannot open the directory.
715 In a list context C<read_dir> returns a list of the entries in the
716 directory. In a scalar context it returns an array reference which has
721 If this boolean option is set, C<.> and C<..> are not removed from the
724 my @all_files = read_dir( '/path/to/dir', keep_dot_dot => 1 ) ;
728 read_file write_file overwrite_file append_file read_dir
732 An article on file slurping in extras/slurp_article.pod. There is
733 also a benchmarking script in extras/slurp_bench.pl.
737 If run under Perl 5.004, slurping from the DATA handle will fail as
738 that requires B.pm which didn't get into core until 5.005.
742 Uri Guttman, E<lt>uri@stemsystems.comE<gt>