6 use Fcntl qw( :DEFAULT ) ;
7 use POSIX qw( :fcntl_h ) ;
11 use vars qw( %EXPORT_TAGS @EXPORT_OK $VERSION @EXPORT ) ;
13 %EXPORT_TAGS = ( 'all' => [
14 qw( read_file write_file overwrite_file append_file read_dir ) ] ) ;
16 @EXPORT = ( @{ $EXPORT_TAGS{'all'} } );
17 @EXPORT_OK = qw( slurp ) ;
21 my $is_win32 = $^O =~ /win32/i ;
23 # Install subs for various constants that aren't set in older perls
24 # (< 5.005). Fcntl on old perls uses Exporter to define subs without a
25 # () prototype These can't be overridden with the constant pragma or
26 # we get a prototype mismatch. Hence this less than aesthetically
27 # appealing BEGIN block:
30 unless( eval { defined SEEK_SET() } ) {
31 *SEEK_SET = sub { 0 };
32 *SEEK_CUR = sub { 1 };
33 *SEEK_END = sub { 2 };
36 unless( eval { defined O_BINARY() } ) {
37 *O_BINARY = sub { 0 };
38 *O_RDONLY = sub { 0 };
39 *O_WRONLY = sub { 1 };
42 unless ( eval { defined O_APPEND() } ) {
44 if ( $^O =~ /olaris/ ) {
45 *O_APPEND = sub { 8 };
46 *O_CREAT = sub { 256 };
47 *O_EXCL = sub { 1024 };
49 elsif ( $^O =~ /inux/ ) {
50 *O_APPEND = sub { 1024 };
51 *O_CREAT = sub { 64 };
52 *O_EXCL = sub { 128 };
54 elsif ( $^O =~ /BSD/i ) {
55 *O_APPEND = sub { 8 };
56 *O_CREAT = sub { 512 };
57 *O_EXCL = sub { 2048 };
62 # print "OS [$^O]\n" ;
64 # print "O_BINARY = ", O_BINARY(), "\n" ;
65 # print "O_RDONLY = ", O_RDONLY(), "\n" ;
66 # print "O_WRONLY = ", O_WRONLY(), "\n" ;
67 # print "O_APPEND = ", O_APPEND(), "\n" ;
68 # print "O_CREAT ", O_CREAT(), "\n" ;
69 # print "O_EXCL ", O_EXCL(), "\n" ;
72 *slurp = \&read_file ;
76 my( $file_name, %args ) = @_ ;
78 # set the buffer to either the passed in one or ours and init it to the null
82 my $buf_ref = $args{'buf_ref'} || \$buf ;
85 my( $read_fh, $size_left, $blk_size ) ;
87 # check if we are reading from a handle (glob ref or IO:: object)
89 if ( ref $file_name ) {
91 # slurping a handle so use it and don't open anything.
92 # set the block size so we know it is a handle and read that amount
94 $read_fh = $file_name ;
95 $blk_size = $args{'blk_size'} || 1024 * 1024 ;
96 $size_left = $blk_size ;
98 # DEEP DARK MAGIC. this checks the UNTAINT IO flag of a
99 # glob/handle. only the DATA handle is untainted (since it is from
100 # trusted data in the source file). this allows us to test if this is
101 # the DATA handle and then to do a sysseek to make sure it gets
102 # slurped correctly. on some systems, the buffered i/o pointer is not
103 # left at the same place as the fd pointer. this sysseek makes them
104 # the same so slurping with sysread will work.
110 @_ = ( \%args, <<ERR ) ;
111 Can't find B.pm with this Perl: $!.
112 That module is needed to slurp the DATA handle.
117 if ( B::svref_2object( $read_fh )->IO->IoFLAGS & 16 ) {
119 # set the seek position to the current tell.
121 sysseek( $read_fh, tell( $read_fh ), SEEK_SET ) ||
127 # a regular file. set the sysopen mode
129 my $mode = O_RDONLY ;
130 $mode |= O_BINARY if $args{'binmode'} ;
132 #printf "RD: BINARY %x MODE %x\n", O_BINARY, $mode ;
134 # open the file and handle any error
137 unless ( sysopen( $read_fh, $file_name, $mode ) ) {
138 @_ = ( \%args, "read_file '$file_name' - sysopen: $!");
142 # get the size of the file for use in the read loop
144 $size_left = -s $read_fh ;
146 unless( $size_left ) {
148 $blk_size = $args{'blk_size'} || 1024 * 1024 ;
149 $size_left = $blk_size ;
153 # infinite read loop. we exit when we are done slurping
157 # do the read and see how much we got
159 my $read_cnt = sysread( $read_fh, ${$buf_ref},
160 $size_left, length ${$buf_ref} ) ;
162 if ( defined $read_cnt ) {
164 # good read. see if we hit EOF (nothing left to read)
166 last if $read_cnt == 0 ;
168 # loop if we are slurping a handle. we don't track $size_left then.
172 # count down how much we read and loop if we have more to read.
173 $size_left -= $read_cnt ;
174 last if $size_left <= 0 ;
178 # handle the read error
180 @_ = ( \%args, "read_file '$file_name' - sysread: $!");
184 # fix up cr/lf to be a newline if this is a windows text file
186 ${$buf_ref} =~ s/\015\012/\n/g if $is_win32 && !$args{'binmode'} ;
188 # this is the 5 returns in a row. each handles one possible
189 # combination of caller context and requested return type
192 $sep = '\n\n+' if defined $sep && $sep eq '' ;
194 # caller wants to get an array ref of lines
196 # this split doesn't work since it tries to use variable length lookbehind
197 # the m// line works.
198 # return [ split( m|(?<=$sep)|, ${$buf_ref} ) ] if $args{'array_ref'} ;
199 return [ length(${$buf_ref}) ? ${$buf_ref} =~ /(.*?$sep|.+)/sg : () ]
200 if $args{'array_ref'} ;
202 # caller wants a list of lines (normal list context)
204 # same problem with this split as before.
205 # return split( m|(?<=$sep)|, ${$buf_ref} ) if wantarray ;
206 return length(${$buf_ref}) ? ${$buf_ref} =~ /(.*?$sep|.+)/sg : ()
209 # caller wants a scalar ref to the slurped text
211 return $buf_ref if $args{'scalar_ref'} ;
213 # caller wants a scalar with the slurped text (normal scalar context)
215 return ${$buf_ref} if defined wantarray ;
217 # caller passed in an i/o buffer by reference (normal void context)
224 my $file_name = shift ;
226 # get the optional argument hash ref from @_ or an empty hash ref.
228 my $args = ( ref $_[0] eq 'HASH' ) ? shift : {} ;
230 my( $buf_ref, $write_fh, $no_truncate, $orig_file_name, $data_is_ref ) ;
232 # get the buffer ref - it depends on how the data is passed into write_file
233 # after this if/else $buf_ref will have a scalar ref to the data.
235 if ( ref $args->{'buf_ref'} eq 'SCALAR' ) {
237 # a scalar ref passed in %args has the data
238 # note that the data was passed by ref
240 $buf_ref = $args->{'buf_ref'} ;
243 elsif ( ref $_[0] eq 'SCALAR' ) {
245 # the first value in @_ is the scalar ref to the data
246 # note that the data was passed by ref
251 elsif ( ref $_[0] eq 'ARRAY' ) {
253 # the first value in @_ is the array ref to the data so join it.
255 ${$buf_ref} = join '', @{$_[0]} ;
259 # good old @_ has all the data so join it.
261 ${$buf_ref} = join '', @_ ;
264 # see if we were passed a open handle to spew to.
266 if ( ref $file_name ) {
268 # we have a handle. make sure we don't call truncate on it.
270 $write_fh = $file_name ;
275 # spew to regular file.
277 if ( $args->{'atomic'} ) {
279 # in atomic mode, we spew to a temp file so make one and save the original
281 $orig_file_name = $file_name ;
282 $file_name .= ".$$" ;
285 # set the mode for the sysopen
287 my $mode = O_WRONLY | O_CREAT ;
288 $mode |= O_BINARY if $args->{'binmode'} ;
289 $mode |= O_APPEND if $args->{'append'} ;
290 $mode |= O_EXCL if $args->{'no_clobber'} ;
292 #printf "WR: BINARY %x MODE %x\n", O_BINARY, $mode ;
294 # open the file and handle any error.
297 unless ( sysopen( $write_fh, $file_name, $mode ) ) {
298 @_ = ( $args, "write_file '$file_name' - sysopen: $!");
303 sysseek( $write_fh, 0, SEEK_END ) if $args->{'append'} ;
306 #print 'WR before data ', unpack( 'H*', ${$buf_ref}), "\n" ;
308 # fix up newline to write cr/lf if this is a windows text file
310 if ( $is_win32 && !$args->{'binmode'} ) {
312 # copy the write data if it was passed by ref so we don't clobber the
314 $buf_ref = \do{ my $copy = ${$buf_ref}; } if $data_is_ref ;
315 ${$buf_ref} =~ s/\n/\015\012/g ;
318 #print 'after data ', unpack( 'H*', ${$buf_ref}), "\n" ;
320 # get the size of how much we are writing and init the offset into that buffer
322 my $size_left = length( ${$buf_ref} ) ;
325 # loop until we have no more data left to write
329 # do the write and track how much we just wrote
331 my $write_cnt = syswrite( $write_fh, ${$buf_ref},
332 $size_left, $offset ) ;
334 unless ( defined $write_cnt ) {
337 @_ = ( $args, "write_file '$file_name' - syswrite: $!");
341 # track much left to write and where to write from in the buffer
343 $size_left -= $write_cnt ;
344 $offset += $write_cnt ;
346 } while( $size_left > 0 ) ;
348 # we truncate regular files in case we overwrite a long file with a shorter file
349 # so seek to the current position to get it (same as tell()).
352 sysseek( $write_fh, 0, SEEK_CUR ) ) unless $no_truncate ;
356 # handle the atomic mode - move the temp file to the original filename.
358 rename( $file_name, $orig_file_name ) if $args->{'atomic'} ;
363 # this is for backwards compatibility with the previous File::Slurp module.
364 # write_file always overwrites an existing file
366 *overwrite_file = \&write_file ;
368 # the current write_file has an append mode so we use that. this
369 # supports the same API with an optional second argument which is a
370 # hash ref of options.
374 # get the optional args hash ref
376 if ( ref $args eq 'HASH' ) {
378 # we were passed an args ref so just mark the append mode
380 $args->{append} = 1 ;
384 # no args hash so insert one with the append mode
386 splice( @_, 1, 0, { append => 1 } ) ;
389 # magic goto the main write_file sub. this overlays the sub without touching
395 # basic wrapper around opendir/readdir
399 my ($dir, %args ) = @_;
401 # this handle will be destroyed upon return
405 # open the dir and handle any errors
407 unless ( opendir( DIRH, $dir ) ) {
409 @_ = ( \%args, "read_dir '$dir' - opendir: $!" ) ;
413 my @dir_entries = readdir(DIRH) ;
415 @dir_entries = grep( $_ ne "." && $_ ne "..", @dir_entries )
416 unless $args{'keep_dot_dot'} ;
418 return @dir_entries if wantarray ;
419 return \@dir_entries ;
422 # error handling section
424 # all the error handling uses magic goto so the caller will get the
425 # error message as if from their code and not this module. if we just
426 # did a call on the error code, the carp/croak would report it from
427 # this module since the error sub is one level down on the call stack
428 # from read_file/write_file/read_dir.
438 my( $args, $err_msg ) = @_ ;
440 # get the error function to use
442 my $func = $err_func{ $args->{'err_mode'} || 'croak' } ;
444 # if we didn't find it in our error function hash, they must have set
445 # it to quiet and we don't do anything.
447 return unless $func ;
449 # call the carp/croak function
453 # return a hard undef (in list context this will be a single value of
454 # undef which is not a legal in-band value)
464 File::Slurp - Efficient Reading/Writing of Complete Files
470 my $text = read_file( 'filename' ) ;
471 my @lines = read_file( 'filename' ) ;
473 write_file( 'filename', @lines ) ;
475 use File::Slurp qw( slurp ) ;
477 my $text = slurp( 'filename' ) ;
482 This module provides subs that allow you to read or write entire files
483 with one simple call. They are designed to be simple to use, have
484 flexible ways to pass in or get the file contents and to be very
485 efficient. There is also a sub to read in all the files in a
486 directory other than C<.> and C<..>
488 These slurp/spew subs work for files, pipes and
489 sockets, and stdio, pseudo-files, and DATA.
493 This sub reads in an entire file and returns its contents to the
494 caller. In list context it will return a list of lines (using the
495 current value of $/ as the separator including support for paragraph
496 mode when it is set to ''). In scalar context it returns the entire
497 file as a single scalar.
499 my $text = read_file( 'filename' ) ;
500 my @lines = read_file( 'filename' ) ;
502 The first argument to C<read_file> is the filename and the rest of the
503 arguments are key/value pairs which are optional and which modify the
504 behavior of the call. Other than binmode the options all control how
505 the slurped file is returned to the caller.
507 If the first argument is a file handle reference or I/O object (if ref
508 is true), then that handle is slurped in. This mode is supported so
509 you slurp handles such as C<DATA>, C<STDIN>. See the test handle.t
510 for an example that does C<open( '-|' )> and child process spews data
511 to the parant which slurps it in. All of the options that control how
512 the data is returned to the caller still work in this case.
514 NOTE: as of version 9999.06, read_file works correctly on the C<DATA>
515 handle. It used to need a sysseek workaround but that is now handled
516 when needed by the module itself.
518 You can optionally request that C<slurp()> is exported to your code. This
519 is an alias for read_file and is meant to be forward compatible with
520 Perl 6 (which will have slurp() built-in).
526 If you set the binmode option, then the file will be slurped in binary
529 my $bin_data = read_file( $bin_file, binmode => ':raw' ) ;
531 NOTE: this actually sets the O_BINARY mode flag for sysopen. It
532 probably should call binmode and pass its argument to support other
537 If this boolean option is set, the return value (only in scalar
538 context) will be an array reference which contains the lines of the
539 slurped file. The following two calls are equivalent:
541 my $lines_ref = read_file( $bin_file, array_ref => 1 ) ;
542 my $lines_ref = [ read_file( $bin_file ) ] ;
546 If this boolean option is set, the return value (only in scalar
547 context) will be an scalar reference to a string which is the contents
548 of the slurped file. This will usually be faster than returning the
551 my $text_ref = read_file( $bin_file, scalar_ref => 1 ) ;
555 You can use this option to pass in a scalar reference and the slurped
556 file contents will be stored in the scalar. This can be used in
557 conjunction with any of the other options.
559 my $text_ref = read_file( $bin_file, buf_ref => \$buffer,
561 my @lines = read_file( $bin_file, buf_ref => \$buffer ) ;
565 You can use this option to set the block size used when slurping from an already open handle (like \*STDIN). It defaults to 1MB.
567 my $text_ref = read_file( $bin_file, blk_size => 10_000_000,
572 You can use this option to control how read_file behaves when an error
573 occurs. This option defaults to 'croak'. You can set it to 'carp' or
574 to 'quiet to have no error handling. This code wants to carp and then
575 read abother file if it fails.
577 my $text_ref = read_file( $file, err_mode => 'carp' ) ;
578 unless ( $text_ref ) {
580 # read a different file but croak if not found
581 $text_ref = read_file( $another_file ) ;
584 # process ${$text_ref}
588 This sub writes out an entire file in one call.
590 write_file( 'filename', @data ) ;
592 The first argument to C<write_file> is the filename. The next argument
593 is an optional hash reference and it contains key/values that can
594 modify the behavior of C<write_file>. The rest of the argument list is
595 the data to be written to the file.
597 write_file( 'filename', {append => 1 }, @data ) ;
598 write_file( 'filename', {binmode => ':raw' }, $buffer ) ;
600 As a shortcut if the first data argument is a scalar or array
601 reference, it is used as the only data to be written to the file. Any
602 following arguments in @_ are ignored. This is a faster way to pass in
603 the output to be written to the file and is equivilent to the
604 C<buf_ref> option. These following pairs are equivilent but the pass
605 by reference call will be faster in most cases (especially with larger
608 write_file( 'filename', \$buffer ) ;
609 write_file( 'filename', $buffer ) ;
611 write_file( 'filename', \@lines ) ;
612 write_file( 'filename', @lines ) ;
614 If the first argument is a file handle reference or I/O object (if ref
615 is true), then that handle is slurped in. This mode is supported so
616 you spew to handles such as \*STDOUT. See the test handle.t for an
617 example that does C<open( '-|' )> and child process spews data to the
618 parant which slurps it in. All of the options that control how the
619 data is passes into C<write_file> still work in this case.
621 C<write_file> returns 1 upon successfully writing the file or undef if
622 it encountered an error.
628 If you set the binmode option, then the file will be written in binary
631 write_file( $bin_file, {binmode => ':raw'}, @data ) ;
633 NOTE: this actually sets the O_BINARY mode flag for sysopen. It
634 probably should call binmode and pass its argument to support other
639 You can use this option to pass in a scalar reference which has the
640 data to be written. If this is set then any data arguments (including
641 the scalar reference shortcut) in @_ will be ignored. These are
644 write_file( $bin_file, { buf_ref => \$buffer } ) ;
645 write_file( $bin_file, \$buffer ) ;
646 write_file( $bin_file, $buffer ) ;
650 If you set this boolean option, the file will be written to in an
651 atomic fashion. A temporary file name is created by appending the pid
652 ($$) to the file name argument and that file is spewed to. After the
653 file is closed it is renamed to the original file name (and rename is
654 an atomic operation on most OS's). If the program using this were to
655 crash in the middle of this, then the file with the pid suffix could
660 If you set this boolean option, the data will be written at the end of
663 write_file( $file, {append => 1}, @data ) ;
665 C<write_file> croaks if it cannot open the file. It returns true if it
666 succeeded in writing out the file and undef if there was an
667 error. (Yes, I know if it croaks it can't return anything but that is
668 for when I add the options to select the error handling mode).
672 If you set this boolean option, an existing file will not be overwritten.
674 write_file( $file, {no_clobber => 1}, @data ) ;
678 You can use this option to control how C<write_file> behaves when an
679 error occurs. This option defaults to 'croak'. You can set it to
680 'carp' or to 'quiet' to have no error handling other than the return
681 value. If the first call to C<write_file> fails it will carp and then
682 write to another file. If the second call to C<write_file> fails, it
685 unless ( write_file( $file, { err_mode => 'carp', \$data ) ;
687 # write a different file but croak if not found
688 write_file( $other_file, \$data ) ;
691 =head2 overwrite_file
693 This sub is just a typeglob alias to write_file since write_file
694 always overwrites an existing file. This sub is supported for
695 backwards compatibility with the original version of this module. See
696 write_file for its API and behavior.
700 This sub will write its data to the end of the file. It is a wrapper
701 around write_file and it has the same API so see that for the full
702 documentation. These calls are equivilent:
704 append_file( $file, @data ) ;
705 write_file( $file, {append => 1}, @data ) ;
709 This sub reads all the file names from directory and returns them to
710 the caller but C<.> and C<..> are removed by default.
712 my @files = read_dir( '/path/to/dir' ) ;
714 It croaks if it cannot open the directory.
716 In a list context C<read_dir> returns a list of the entries in the
717 directory. In a scalar context it returns an array reference which has
722 If this boolean option is set, C<.> and C<..> are not removed from the
725 my @all_files = read_dir( '/path/to/dir', keep_dot_dot => 1 ) ;
729 read_file write_file overwrite_file append_file read_dir
733 An article on file slurping in extras/slurp_article.pod. There is
734 also a benchmarking script in extras/slurp_bench.pl.
738 If run under Perl 5.004, slurping from the DATA handle will fail as
739 that requires B.pm which didn't get into core until 5.005.
743 Uri Guttman, E<lt>uri@stemsystems.comE<gt>