package File::Slurp;
+my $printed ;
+
use strict;
use Carp ;
-use POSIX qw( :fcntl_h ) ;
use Fcntl qw( :DEFAULT ) ;
+use POSIX qw( :fcntl_h ) ;
use Symbol ;
+use base 'Exporter' ;
+use vars qw( %EXPORT_TAGS @EXPORT_OK $VERSION @EXPORT ) ;
+
+%EXPORT_TAGS = ( 'all' => [
+ qw( read_file write_file overwrite_file append_file read_dir ) ] ) ;
+
+@EXPORT = ( @{ $EXPORT_TAGS{'all'} } );
+@EXPORT_OK = qw( slurp ) ;
+
+$VERSION = '9999.14';
+
+our $max_fast_slurp_size = 1024 * 100 ;
+
my $is_win32 = $^O =~ /win32/i ;
# Install subs for various constants that aren't set in older perls
# appealing BEGIN block:
BEGIN {
- unless( eval { defined SEEK_SET() } ) {
+ unless( defined &SEEK_SET ) {
*SEEK_SET = sub { 0 };
*SEEK_CUR = sub { 1 };
*SEEK_END = sub { 2 };
}
- unless( eval { defined O_BINARY() } ) {
+ unless( defined &O_BINARY ) {
*O_BINARY = sub { 0 };
*O_RDONLY = sub { 0 };
*O_WRONLY = sub { 1 };
}
- unless ( eval { defined O_APPEND() } ) {
+ unless ( defined &O_APPEND ) {
if ( $^O =~ /olaris/ ) {
*O_APPEND = sub { 8 };
# print "O_CREAT ", O_CREAT(), "\n" ;
# print "O_EXCL ", O_EXCL(), "\n" ;
-use base 'Exporter' ;
-use vars qw( %EXPORT_TAGS @EXPORT_OK $VERSION @EXPORT ) ;
-
-%EXPORT_TAGS = ( 'all' => [
- qw( read_file write_file overwrite_file append_file read_dir ) ] ) ;
-
-@EXPORT = ( @{ $EXPORT_TAGS{'all'} } );
-@EXPORT_OK = qw( slurp ) ;
-
-$VERSION = '9999.12';
*slurp = \&read_file ;
my( $file_name, %args ) = @_ ;
+ if ( !ref $file_name && 0 &&
+ -e $file_name && -s _ < $max_fast_slurp_size && ! %args && !wantarray ) {
+
+ local( *FH ) ;
+
+ unless( open( FH, $file_name ) ) {
+
+ @_ = ( \%args, "read_file '$file_name' - sysopen: $!");
+ goto &_error ;
+ }
+
+ my $read_cnt = sysread( FH, my $buf, -s _ ) ;
+
+ unless ( defined $read_cnt ) {
+
+# handle the read error
+
+ @_ = ( \%args,
+ "read_file '$file_name' - small sysread: $!");
+ goto &_error ;
+ }
+
+ return $buf ;
+ }
+
# set the buffer to either the passed in one or ours and init it to the null
# string
# a regular file. set the sysopen mode
my $mode = O_RDONLY ;
- $mode |= O_BINARY if $args{'binmode'} ;
#printf "RD: BINARY %x MODE %x\n", O_BINARY, $mode ;
goto &_error ;
}
+ if ( my $binmode = $args{'binmode'} ) {
+ binmode( $read_fh, $binmode ) ;
+ }
+
# get the size of the file for use in the read loop
$size_left = -s $read_fh ;
+#print "SIZE $size_left\n" ;
+
+
+# we need a blk_size if the size is 0 so we can handle pseudofiles like in
+# /proc. these show as 0 size but have data to be slurped.
+
unless( $size_left ) {
$blk_size = $args{'blk_size'} || 1024 * 1024 ;
}
}
+
+# if ( $size_left < 10000 && keys %args == 0 && !wantarray ) {
+
+# #print "OPT\n" and $printed++ unless $printed ;
+
+# my $read_cnt = sysread( $read_fh, my $buf, $size_left ) ;
+
+# unless ( defined $read_cnt ) {
+
+# # handle the read error
+
+# @_ = ( \%args, "read_file '$file_name' - small2 sysread: $!");
+# goto &_error ;
+# }
+
+# return $buf ;
+# }
+
# infinite read loop. we exit when we are done slurping
while( 1 ) {
my $read_cnt = sysread( $read_fh, ${$buf_ref},
$size_left, length ${$buf_ref} ) ;
- if ( defined $read_cnt ) {
+ unless ( defined $read_cnt ) {
+
+# handle the read error
+
+ @_ = ( \%args, "read_file '$file_name' - loop sysread: $!");
+ goto &_error ;
+ }
# good read. see if we hit EOF (nothing left to read)
- last if $read_cnt == 0 ;
+ last if $read_cnt == 0 ;
# loop if we are slurping a handle. we don't track $size_left then.
- next if $blk_size ;
+ next if $blk_size ;
# count down how much we read and loop if we have more to read.
- $size_left -= $read_cnt ;
- last if $size_left <= 0 ;
- next ;
- }
-
-# handle the read error
- @_ = ( \%args, "read_file '$file_name' - sysread: $!");
- goto &_error ;
+ $size_left -= $read_cnt ;
+ last if $size_left <= 0 ;
}
# fix up cr/lf to be a newline if this is a windows text file
# set the mode for the sysopen
my $mode = O_WRONLY | O_CREAT ;
- $mode |= O_BINARY if $args->{'binmode'} ;
$mode |= O_APPEND if $args->{'append'} ;
$mode |= O_EXCL if $args->{'no_clobber'} ;
+ my $perms = $args->{perms} ;
+ $perms = 0666 unless defined $perms ;
+
#printf "WR: BINARY %x MODE %x\n", O_BINARY, $mode ;
# open the file and handle any error.
$write_fh = gensym ;
- unless ( sysopen( $write_fh, $file_name, $mode ) ) {
+ unless ( sysopen( $write_fh, $file_name, $mode, $perms ) ) {
@_ = ( $args, "write_file '$file_name' - sysopen: $!");
goto &_error ;
}
}
+ if ( my $binmode = $args->{'binmode'} ) {
+ binmode( $write_fh, $binmode ) ;
+ }
+
sysseek( $write_fh, 0, SEEK_END ) if $args->{'append'} ;
# handle the atomic mode - move the temp file to the original filename.
- rename( $file_name, $orig_file_name ) if $args->{'atomic'} ;
+ if ( $args->{'atomic'} && !rename( $file_name, $orig_file_name ) ) {
+
+
+ @_ = ( $args, "write_file '$file_name' - rename: $!" ) ;
+ goto &_error ;
+ }
return 1 ;
}
# call the carp/croak function
- $func->($err_msg) ;
+ $func->($err_msg) if $func ;
# return a hard undef (in list context this will be a single value of
# undef which is not a legal in-band value)
=head3 binmode
-If you set the binmode option, then the file will be slurped in binary
-mode.
+If you set the binmode option, then the option will be passed to a
+binmode call on the opened filehandle.
my $bin_data = read_file( $bin_file, binmode => ':raw' ) ;
-
-NOTE: this actually sets the O_BINARY mode flag for sysopen. It
-probably should call binmode and pass its argument to support other
-file modes.
+ my $utf_text = read_file( $bin_file, binmode => ':utf8' ) ;
=head3 array_ref
=head3 scalar_ref
-If this boolean option is set, the return value (only in scalar
-context) will be an scalar reference to a string which is the contents
-of the slurped file. This will usually be faster than returning the
-plain scalar.
+If this boolean option is set, the return value (only in scalar context)
+will be an scalar reference to a string which is the contents of the
+slurped file. This will usually be faster than returning the plain
+scalar. It will also save memory as it will not make a copy of the file
+to return.
my $text_ref = read_file( $bin_file, scalar_ref => 1 ) ;
+=head3 perms
+
+The perms option sets the permissions of newly-created files. This value
+is modified by your process's umask and defaults to 0666 (same as
+sysopen).
+
+NOTE: this option is new as of File::Slurp version 9999.14;
+
+
=head3 buf_ref
You can use this option to pass in a scalar reference and the slurped
file contents will be stored in the scalar. This can be used in
-conjunction with any of the other options.
+conjunction with any of the other options. This saves an extra copy of
+the slurped file and can lower ram usage vs returning the file.
my $text_ref = read_file( $bin_file, buf_ref => \$buffer,
array_ref => 1 ) ;
=head3 append
If you set this boolean option, the data will be written at the end of
-the current file.
+the current file. Internally this sets the sysopen mode flag O_APPEND.
write_file( $file, {append => 1}, @data ) ;
C<write_file> croaks if it cannot open the file. It returns true if it
-succeeded in writing out the file and undef if there was an
-error. (Yes, I know if it croaks it can't return anything but that is
-for when I add the options to select the error handling mode).
+succeeded in writing out the file and undef if there was an error.
=head3 no_clobber
read_file write_file overwrite_file append_file read_dir
+=head2 LICENSE
+
+ Same as Perl.
+
=head2 SEE ALSO
An article on file slurping in extras/slurp_article.pod. There is