view release on metacpan or  search on metacpan

inc/File/Slurp.pm  view on Meta::CPAN

		elsif ( $^O =~ /inux/ ) {
			*O_APPEND = sub { 1024 };
			*O_CREAT = sub { 64 };
			*O_EXCL = sub { 128 };
		}
		elsif ( $^O =~ /BSD/i ) {
			*O_APPEND = sub { 8 };
			*O_CREAT = sub { 512 };
			*O_EXCL = sub { 2048 };
		}
	}
}

# print "OS [$^O]\n" ;

# print "O_BINARY = ", O_BINARY(), "\n" ;
# print "O_RDONLY = ", O_RDONLY(), "\n" ;
# print "O_WRONLY = ", O_WRONLY(), "\n" ;
# print "O_APPEND = ", O_APPEND(), "\n" ;
# 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.13';

*slurp = \&read_file ;

sub read_file {

	my( $file_name, %args ) = @_ ;

# set the buffer to either the passed in one or ours and init it to the null
# string

	my $buf ;
	my $buf_ref = $args{'buf_ref'} || \$buf ;
	${$buf_ref} = '' ;

	my( $read_fh, $size_left, $blk_size ) ;

# check if we are reading from a handle (glob ref or IO:: object)

	if ( ref $file_name ) {

# slurping a handle so use it and don't open anything.
# set the block size so we know it is a handle and read that amount

		$read_fh = $file_name ;
		$blk_size = $args{'blk_size'} || 1024 * 1024 ;
		$size_left = $blk_size ;

# DEEP DARK MAGIC. this checks the UNTAINT IO flag of a
# glob/handle. only the DATA handle is untainted (since it is from
# trusted data in the source file). this allows us to test if this is
# the DATA handle and then to do a sysseek to make sure it gets
# slurped correctly. on some systems, the buffered i/o pointer is not
# left at the same place as the fd pointer. this sysseek makes them
# the same so slurping with sysread will work.

		eval{ require B } ;

		if ( $@ ) {

			@_ = ( \%args, <<ERR ) ;
Can't find B.pm with this Perl: $!.
That module is needed to slurp the DATA handle.
ERR
			goto &_error ;
		}

		if ( B::svref_2object( $read_fh )->IO->IoFLAGS & 16 ) {

# set the seek position to the current tell.

			sysseek( $read_fh, tell( $read_fh ), SEEK_SET ) ||
				croak "sysseek $!" ;
		}
	}
	else {

# 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 ;

# open the file and handle any error

		$read_fh = gensym ;
		unless ( sysopen( $read_fh, $file_name, $mode ) ) {
			@_ = ( \%args, "read_file '$file_name' - sysopen: $!");
			goto &_error ;
		}

# get the size of the file for use in the read loop

		$size_left = -s $read_fh ;

		unless( $size_left ) {

			$blk_size = $args{'blk_size'} || 1024 * 1024 ;
			$size_left = $blk_size ;
		}
	}

# infinite read loop. we exit when we are done slurping

	while( 1 ) {

# do the read and see how much we got

		my $read_cnt = sysread( $read_fh, ${$buf_ref},