8 use Fcntl qw( :DEFAULT ) ;
9 use POSIX qw( :fcntl_h ) ;
13 use vars qw( %EXPORT_TAGS @EXPORT_OK $VERSION @EXPORT ) ;
15 %EXPORT_TAGS = ( 'all' => [
16 qw( read_file write_file overwrite_file append_file read_dir ) ] ) ;
18 @EXPORT = ( @{ $EXPORT_TAGS{'all'} } );
19 @EXPORT_OK = qw( slurp ) ;
23 our $max_fast_slurp_size = 1024 * 100 ;
25 my $is_win32 = $^O =~ /win32/i ;
27 # Install subs for various constants that aren't set in older perls
28 # (< 5.005). Fcntl on old perls uses Exporter to define subs without a
29 # () prototype These can't be overridden with the constant pragma or
30 # we get a prototype mismatch. Hence this less than aesthetically
31 # appealing BEGIN block:
34 unless( defined &SEEK_SET ) {
35 *SEEK_SET = sub { 0 };
36 *SEEK_CUR = sub { 1 };
37 *SEEK_END = sub { 2 };
40 unless( defined &O_BINARY ) {
41 *O_BINARY = sub { 0 };
42 *O_RDONLY = sub { 0 };
43 *O_WRONLY = sub { 1 };
46 unless ( defined &O_APPEND ) {
48 if ( $^O =~ /olaris/ ) {
49 *O_APPEND = sub { 8 };
50 *O_CREAT = sub { 256 };
51 *O_EXCL = sub { 1024 };
53 elsif ( $^O =~ /inux/ ) {
54 *O_APPEND = sub { 1024 };
55 *O_CREAT = sub { 64 };
56 *O_EXCL = sub { 128 };
58 elsif ( $^O =~ /BSD/i ) {
59 *O_APPEND = sub { 8 };
60 *O_CREAT = sub { 512 };
61 *O_EXCL = sub { 2048 };
66 # print "OS [$^O]\n" ;
68 # print "O_BINARY = ", O_BINARY(), "\n" ;
69 # print "O_RDONLY = ", O_RDONLY(), "\n" ;
70 # print "O_WRONLY = ", O_WRONLY(), "\n" ;
71 # print "O_APPEND = ", O_APPEND(), "\n" ;
72 # print "O_CREAT ", O_CREAT(), "\n" ;
73 # print "O_EXCL ", O_EXCL(), "\n" ;
76 *slurp = \&read_file ;
80 my( $file_name, %args ) = @_ ;
82 if ( !ref $file_name && 0 &&
83 -e $file_name && -s _ < $max_fast_slurp_size && ! %args && !wantarray ) {
87 unless( open( FH, $file_name ) ) {
89 @_ = ( \%args, "read_file '$file_name' - sysopen: $!");
93 my $read_cnt = sysread( FH, my $buf, -s _ ) ;
95 unless ( defined $read_cnt ) {
97 # handle the read error
100 "read_file '$file_name' - small sysread: $!");
107 # set the buffer to either the passed in one or ours and init it to the null
111 my $buf_ref = $args{'buf_ref'} || \$buf ;
114 my( $read_fh, $size_left, $blk_size ) ;
116 # check if we are reading from a handle (glob ref or IO:: object)
118 if ( ref $file_name ) {
120 # slurping a handle so use it and don't open anything.
121 # set the block size so we know it is a handle and read that amount
123 $read_fh = $file_name ;
124 $blk_size = $args{'blk_size'} || 1024 * 1024 ;
125 $size_left = $blk_size ;
127 # DEEP DARK MAGIC. this checks the UNTAINT IO flag of a
128 # glob/handle. only the DATA handle is untainted (since it is from
129 # trusted data in the source file). this allows us to test if this is
130 # the DATA handle and then to do a sysseek to make sure it gets
131 # slurped correctly. on some systems, the buffered i/o pointer is not
132 # left at the same place as the fd pointer. this sysseek makes them
133 # the same so slurping with sysread will work.
139 @_ = ( \%args, <<ERR ) ;
140 Can't find B.pm with this Perl: $!.
141 That module is needed to slurp the DATA handle.
146 if ( B::svref_2object( $read_fh )->IO->IoFLAGS & 16 ) {
148 # set the seek position to the current tell.
150 sysseek( $read_fh, tell( $read_fh ), SEEK_SET ) ||
156 # a regular file. set the sysopen mode
158 my $mode = O_RDONLY ;
160 #printf "RD: BINARY %x MODE %x\n", O_BINARY, $mode ;
162 # open the file and handle any error
165 unless ( sysopen( $read_fh, $file_name, $mode ) ) {
166 @_ = ( \%args, "read_file '$file_name' - sysopen: $!");
170 if ( my $binmode = $args{'binmode'} ) {
171 binmode( $read_fh, $binmode ) ;
174 # get the size of the file for use in the read loop
176 $size_left = -s $read_fh ;
178 #print "SIZE $size_left\n" ;
181 # we need a blk_size if the size is 0 so we can handle pseudofiles like in
182 # /proc. these show as 0 size but have data to be slurped.
184 unless( $size_left ) {
186 $blk_size = $args{'blk_size'} || 1024 * 1024 ;
187 $size_left = $blk_size ;
192 # if ( $size_left < 10000 && keys %args == 0 && !wantarray ) {
194 # #print "OPT\n" and $printed++ unless $printed ;
196 # my $read_cnt = sysread( $read_fh, my $buf, $size_left ) ;
198 # unless ( defined $read_cnt ) {
200 # # handle the read error
202 # @_ = ( \%args, "read_file '$file_name' - small2 sysread: $!");
209 # infinite read loop. we exit when we are done slurping
213 # do the read and see how much we got
215 my $read_cnt = sysread( $read_fh, ${$buf_ref},
216 $size_left, length ${$buf_ref} ) ;
218 unless ( defined $read_cnt ) {
220 # handle the read error
222 @_ = ( \%args, "read_file '$file_name' - loop sysread: $!");
226 # good read. see if we hit EOF (nothing left to read)
228 last if $read_cnt == 0 ;
230 # loop if we are slurping a handle. we don't track $size_left then.
234 # count down how much we read and loop if we have more to read.
236 $size_left -= $read_cnt ;
237 last if $size_left <= 0 ;
240 # fix up cr/lf to be a newline if this is a windows text file
242 ${$buf_ref} =~ s/\015\012/\n/g if $is_win32 && !$args{'binmode'} ;
244 # this is the 5 returns in a row. each handles one possible
245 # combination of caller context and requested return type
248 $sep = '\n\n+' if defined $sep && $sep eq '' ;
250 # caller wants to get an array ref of lines
252 # this split doesn't work since it tries to use variable length lookbehind
253 # the m// line works.
254 # return [ split( m|(?<=$sep)|, ${$buf_ref} ) ] if $args{'array_ref'} ;
255 return [ length(${$buf_ref}) ? ${$buf_ref} =~ /(.*?$sep|.+)/sg : () ]
256 if $args{'array_ref'} ;
258 # caller wants a list of lines (normal list context)
260 # same problem with this split as before.
261 # return split( m|(?<=$sep)|, ${$buf_ref} ) if wantarray ;
262 return length(${$buf_ref}) ? ${$buf_ref} =~ /(.*?$sep|.+)/sg : ()
265 # caller wants a scalar ref to the slurped text
267 return $buf_ref if $args{'scalar_ref'} ;
269 # caller wants a scalar with the slurped text (normal scalar context)
271 return ${$buf_ref} if defined wantarray ;
273 # caller passed in an i/o buffer by reference (normal void context)
280 my $file_name = shift ;
282 # get the optional argument hash ref from @_ or an empty hash ref.
284 my $args = ( ref $_[0] eq 'HASH' ) ? shift : {} ;
286 my( $buf_ref, $write_fh, $no_truncate, $orig_file_name, $data_is_ref ) ;
288 # get the buffer ref - it depends on how the data is passed into write_file
289 # after this if/else $buf_ref will have a scalar ref to the data.
291 if ( ref $args->{'buf_ref'} eq 'SCALAR' ) {
293 # a scalar ref passed in %args has the data
294 # note that the data was passed by ref
296 $buf_ref = $args->{'buf_ref'} ;
299 elsif ( ref $_[0] eq 'SCALAR' ) {
301 # the first value in @_ is the scalar ref to the data
302 # note that the data was passed by ref
307 elsif ( ref $_[0] eq 'ARRAY' ) {
309 # the first value in @_ is the array ref to the data so join it.
311 ${$buf_ref} = join '', @{$_[0]} ;
315 # good old @_ has all the data so join it.
317 ${$buf_ref} = join '', @_ ;
320 # see if we were passed a open handle to spew to.
322 if ( ref $file_name ) {
324 # we have a handle. make sure we don't call truncate on it.
326 $write_fh = $file_name ;
331 # spew to regular file.
333 if ( $args->{'atomic'} ) {
335 # in atomic mode, we spew to a temp file so make one and save the original
337 $orig_file_name = $file_name ;
338 $file_name .= ".$$" ;
341 # set the mode for the sysopen
343 my $mode = O_WRONLY | O_CREAT ;
344 $mode |= O_APPEND if $args->{'append'} ;
345 $mode |= O_EXCL if $args->{'no_clobber'} ;
347 my $perms = $args->{perms} ;
348 $perms = 0666 unless defined $perms ;
350 #printf "WR: BINARY %x MODE %x\n", O_BINARY, $mode ;
352 # open the file and handle any error.
355 unless ( sysopen( $write_fh, $file_name, $mode, $perms ) ) {
356 @_ = ( $args, "write_file '$file_name' - sysopen: $!");
361 if ( my $binmode = $args->{'binmode'} ) {
362 binmode( $write_fh, $binmode ) ;
365 sysseek( $write_fh, 0, SEEK_END ) if $args->{'append'} ;
368 #print 'WR before data ', unpack( 'H*', ${$buf_ref}), "\n" ;
370 # fix up newline to write cr/lf if this is a windows text file
372 if ( $is_win32 && !$args->{'binmode'} ) {
374 # copy the write data if it was passed by ref so we don't clobber the
376 $buf_ref = \do{ my $copy = ${$buf_ref}; } if $data_is_ref ;
377 ${$buf_ref} =~ s/\n/\015\012/g ;
380 #print 'after data ', unpack( 'H*', ${$buf_ref}), "\n" ;
382 # get the size of how much we are writing and init the offset into that buffer
384 my $size_left = length( ${$buf_ref} ) ;
387 # loop until we have no more data left to write
391 # do the write and track how much we just wrote
393 my $write_cnt = syswrite( $write_fh, ${$buf_ref},
394 $size_left, $offset ) ;
396 unless ( defined $write_cnt ) {
399 @_ = ( $args, "write_file '$file_name' - syswrite: $!");
403 # track much left to write and where to write from in the buffer
405 $size_left -= $write_cnt ;
406 $offset += $write_cnt ;
408 } while( $size_left > 0 ) ;
410 # we truncate regular files in case we overwrite a long file with a shorter file
411 # so seek to the current position to get it (same as tell()).
414 sysseek( $write_fh, 0, SEEK_CUR ) ) unless $no_truncate ;
418 # handle the atomic mode - move the temp file to the original filename.
420 if ( $args->{'atomic'} && !rename( $file_name, $orig_file_name ) ) {
423 @_ = ( $args, "write_file '$file_name' - rename: $!" ) ;
430 # this is for backwards compatibility with the previous File::Slurp module.
431 # write_file always overwrites an existing file
433 *overwrite_file = \&write_file ;
435 # the current write_file has an append mode so we use that. this
436 # supports the same API with an optional second argument which is a
437 # hash ref of options.
441 # get the optional args hash ref
443 if ( ref $args eq 'HASH' ) {
445 # we were passed an args ref so just mark the append mode
447 $args->{append} = 1 ;
451 # no args hash so insert one with the append mode
453 splice( @_, 1, 0, { append => 1 } ) ;
456 # magic goto the main write_file sub. this overlays the sub without touching
462 # basic wrapper around opendir/readdir
466 my ($dir, %args ) = @_;
468 # this handle will be destroyed upon return
472 # open the dir and handle any errors
474 unless ( opendir( DIRH, $dir ) ) {
476 @_ = ( \%args, "read_dir '$dir' - opendir: $!" ) ;
480 my @dir_entries = readdir(DIRH) ;
482 @dir_entries = grep( $_ ne "." && $_ ne "..", @dir_entries )
483 unless $args{'keep_dot_dot'} ;
485 return @dir_entries if wantarray ;
486 return \@dir_entries ;
489 # error handling section
491 # all the error handling uses magic goto so the caller will get the
492 # error message as if from their code and not this module. if we just
493 # did a call on the error code, the carp/croak would report it from
494 # this module since the error sub is one level down on the call stack
495 # from read_file/write_file/read_dir.
505 my( $args, $err_msg ) = @_ ;
507 # get the error function to use
509 my $func = $err_func{ $args->{'err_mode'} || 'croak' } ;
511 # if we didn't find it in our error function hash, they must have set
512 # it to quiet and we don't do anything.
514 return unless $func ;
516 # call the carp/croak function
518 $func->($err_msg) if $func ;
520 # return a hard undef (in list context this will be a single value of
521 # undef which is not a legal in-band value)
531 File::Slurp - Efficient Reading/Writing of Complete Files
537 my $text = read_file( 'filename' ) ;
538 my @lines = read_file( 'filename' ) ;
540 write_file( 'filename', @lines ) ;
542 use File::Slurp qw( slurp ) ;
544 my $text = slurp( 'filename' ) ;
549 This module provides subs that allow you to read or write entire files
550 with one simple call. They are designed to be simple to use, have
551 flexible ways to pass in or get the file contents and to be very
552 efficient. There is also a sub to read in all the files in a
553 directory other than C<.> and C<..>
555 These slurp/spew subs work for files, pipes and
556 sockets, and stdio, pseudo-files, and DATA.
560 This sub reads in an entire file and returns its contents to the
561 caller. In list context it will return a list of lines (using the
562 current value of $/ as the separator including support for paragraph
563 mode when it is set to ''). In scalar context it returns the entire
564 file as a single scalar.
566 my $text = read_file( 'filename' ) ;
567 my @lines = read_file( 'filename' ) ;
569 The first argument to C<read_file> is the filename and the rest of the
570 arguments are key/value pairs which are optional and which modify the
571 behavior of the call. Other than binmode the options all control how
572 the slurped file is returned to the caller.
574 If the first argument is a file handle reference or I/O object (if ref
575 is true), then that handle is slurped in. This mode is supported so
576 you slurp handles such as C<DATA>, C<STDIN>. See the test handle.t
577 for an example that does C<open( '-|' )> and child process spews data
578 to the parant which slurps it in. All of the options that control how
579 the data is returned to the caller still work in this case.
581 NOTE: as of version 9999.06, read_file works correctly on the C<DATA>
582 handle. It used to need a sysseek workaround but that is now handled
583 when needed by the module itself.
585 You can optionally request that C<slurp()> is exported to your code. This
586 is an alias for read_file and is meant to be forward compatible with
587 Perl 6 (which will have slurp() built-in).
593 If you set the binmode option, then the option will be passed to a
594 binmode call on the opened filehandle.
596 my $bin_data = read_file( $bin_file, binmode => ':raw' ) ;
597 my $utf_text = read_file( $bin_file, binmode => ':utf8' ) ;
601 If this boolean option is set, the return value (only in scalar
602 context) will be an array reference which contains the lines of the
603 slurped file. The following two calls are equivalent:
605 my $lines_ref = read_file( $bin_file, array_ref => 1 ) ;
606 my $lines_ref = [ read_file( $bin_file ) ] ;
610 If this boolean option is set, the return value (only in scalar context)
611 will be an scalar reference to a string which is the contents of the
612 slurped file. This will usually be faster than returning the plain
613 scalar. It will also save memory as it will not make a copy of the file
616 my $text_ref = read_file( $bin_file, scalar_ref => 1 ) ;
620 The perms option sets the permissions of newly-created files. This value
621 is modified by your process's umask and defaults to 0666 (same as
624 NOTE: this option is new as of File::Slurp version 9999.14;
629 You can use this option to pass in a scalar reference and the slurped
630 file contents will be stored in the scalar. This can be used in
631 conjunction with any of the other options. This saves an extra copy of
632 the slurped file and can lower ram usage vs returning the file.
634 my $text_ref = read_file( $bin_file, buf_ref => \$buffer,
636 my @lines = read_file( $bin_file, buf_ref => \$buffer ) ;
640 You can use this option to set the block size used when slurping from an already open handle (like \*STDIN). It defaults to 1MB.
642 my $text_ref = read_file( $bin_file, blk_size => 10_000_000,
647 You can use this option to control how read_file behaves when an error
648 occurs. This option defaults to 'croak'. You can set it to 'carp' or
649 to 'quiet to have no error handling. This code wants to carp and then
650 read abother file if it fails.
652 my $text_ref = read_file( $file, err_mode => 'carp' ) ;
653 unless ( $text_ref ) {
655 # read a different file but croak if not found
656 $text_ref = read_file( $another_file ) ;
659 # process ${$text_ref}
663 This sub writes out an entire file in one call.
665 write_file( 'filename', @data ) ;
667 The first argument to C<write_file> is the filename. The next argument
668 is an optional hash reference and it contains key/values that can
669 modify the behavior of C<write_file>. The rest of the argument list is
670 the data to be written to the file.
672 write_file( 'filename', {append => 1 }, @data ) ;
673 write_file( 'filename', {binmode => ':raw' }, $buffer ) ;
675 As a shortcut if the first data argument is a scalar or array
676 reference, it is used as the only data to be written to the file. Any
677 following arguments in @_ are ignored. This is a faster way to pass in
678 the output to be written to the file and is equivilent to the
679 C<buf_ref> option. These following pairs are equivilent but the pass
680 by reference call will be faster in most cases (especially with larger
683 write_file( 'filename', \$buffer ) ;
684 write_file( 'filename', $buffer ) ;
686 write_file( 'filename', \@lines ) ;
687 write_file( 'filename', @lines ) ;
689 If the first argument is a file handle reference or I/O object (if ref
690 is true), then that handle is slurped in. This mode is supported so
691 you spew to handles such as \*STDOUT. See the test handle.t for an
692 example that does C<open( '-|' )> and child process spews data to the
693 parant which slurps it in. All of the options that control how the
694 data is passes into C<write_file> still work in this case.
696 C<write_file> returns 1 upon successfully writing the file or undef if
697 it encountered an error.
703 If you set the binmode option, then the file will be written in binary
706 write_file( $bin_file, {binmode => ':raw'}, @data ) ;
708 NOTE: this actually sets the O_BINARY mode flag for sysopen. It
709 probably should call binmode and pass its argument to support other
714 You can use this option to pass in a scalar reference which has the
715 data to be written. If this is set then any data arguments (including
716 the scalar reference shortcut) in @_ will be ignored. These are
719 write_file( $bin_file, { buf_ref => \$buffer } ) ;
720 write_file( $bin_file, \$buffer ) ;
721 write_file( $bin_file, $buffer ) ;
725 If you set this boolean option, the file will be written to in an
726 atomic fashion. A temporary file name is created by appending the pid
727 ($$) to the file name argument and that file is spewed to. After the
728 file is closed it is renamed to the original file name (and rename is
729 an atomic operation on most OS's). If the program using this were to
730 crash in the middle of this, then the file with the pid suffix could
735 If you set this boolean option, the data will be written at the end of
736 the current file. Internally this sets the sysopen mode flag O_APPEND.
738 write_file( $file, {append => 1}, @data ) ;
740 C<write_file> croaks if it cannot open the file. It returns true if it
741 succeeded in writing out the file and undef if there was an error.
745 If you set this boolean option, an existing file will not be overwritten.
747 write_file( $file, {no_clobber => 1}, @data ) ;
751 You can use this option to control how C<write_file> behaves when an
752 error occurs. This option defaults to 'croak'. You can set it to
753 'carp' or to 'quiet' to have no error handling other than the return
754 value. If the first call to C<write_file> fails it will carp and then
755 write to another file. If the second call to C<write_file> fails, it
758 unless ( write_file( $file, { err_mode => 'carp', \$data ) ;
760 # write a different file but croak if not found
761 write_file( $other_file, \$data ) ;
764 =head2 overwrite_file
766 This sub is just a typeglob alias to write_file since write_file
767 always overwrites an existing file. This sub is supported for
768 backwards compatibility with the original version of this module. See
769 write_file for its API and behavior.
773 This sub will write its data to the end of the file. It is a wrapper
774 around write_file and it has the same API so see that for the full
775 documentation. These calls are equivilent:
777 append_file( $file, @data ) ;
778 write_file( $file, {append => 1}, @data ) ;
782 This sub reads all the file names from directory and returns them to
783 the caller but C<.> and C<..> are removed by default.
785 my @files = read_dir( '/path/to/dir' ) ;
787 It croaks if it cannot open the directory.
789 In a list context C<read_dir> returns a list of the entries in the
790 directory. In a scalar context it returns an array reference which has
795 If this boolean option is set, C<.> and C<..> are not removed from the
798 my @all_files = read_dir( '/path/to/dir', keep_dot_dot => 1 ) ;
802 read_file write_file overwrite_file append_file read_dir
810 An article on file slurping in extras/slurp_article.pod. There is
811 also a benchmarking script in extras/slurp_bench.pl.
815 If run under Perl 5.004, slurping from the DATA handle will fail as
816 that requires B.pm which didn't get into core until 5.005.
820 Uri Guttman, E<lt>uri@stemsystems.comE<gt>