view release on metacpan or  search on metacpan

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

	if (ref($opts->{buf_ref}) eq 'SCALAR') {
		# a scalar ref passed in %opts has the data
		# note that the data was passed by ref
		$buf_ref = $opts->{buf_ref};
		$data_is_ref = 1;
	}
	elsif (ref($_[0]) eq 'SCALAR') {
		# the first value in @_ is the scalar ref to the data
		# note that the data was passed by ref
		$buf_ref = shift;
		$data_is_ref = 1;
	}
	elsif (ref($_[0]) eq 'ARRAY') {
		# the first value in @_ is the array ref to the data so join it.
		${$buf_ref} = join '', @{$_[0]};
	}
	else {
		# good old @_ has all the data so join it.
		${$buf_ref} = join '', @_;
	}

	# seek and print
	seek($fh, 0, SEEK_END) if $opts->{append};
	print {$fh} ${$buf_ref};
	truncate($fh, tell($fh)) unless $no_truncate;
	close($fh);

	if ($opts->{atomic} && !rename($file_name, $orig_filename)) {
		@_ = ($opts, "write_file '$file_name' - rename: $!");
		goto &_error;
	}

	return 1;
}

# this is for backwards compatibility with the previous File::Slurp module.
# write_file always overwrites an existing file
*overwrite_file = \&write_file ;

# the current write_file has an append mode so we use that. this
# supports the same API with an optional second argument which is a
# hash ref of options.

sub append_file {

# get the optional opts hash ref
	my $opts = $_[1] ;
	if ( ref $opts eq 'HASH' ) {

# we were passed an opts ref so just mark the append mode

		$opts->{append} = 1 ;
	}
	else {

# no opts hash so insert one with the append mode

		splice( @_, 1, 0, { append => 1 } ) ;
	}

# magic goto the main write_file sub. this overlays the sub without touching
# the stack or @_

	goto &write_file
}

# prepend data to the beginning of a file

sub prepend_file {

	my $file_name = shift ;

#print "FILE $file_name\n" ;

	my $opts = ( ref $_[0] eq 'HASH' ) ? shift : {} ;

# delete unsupported options

	my @bad_opts =
		grep $_ ne 'err_mode' && $_ ne 'binmode', keys %{$opts} ;

	delete @{$opts}{@bad_opts} ;

	my $prepend_data = shift ;
	$prepend_data = '' unless defined $prepend_data ;
	$prepend_data = ${$prepend_data} if ref $prepend_data eq 'SCALAR' ;

#print "PRE [$prepend_data]\n" ;

	my $err_mode = delete $opts->{err_mode} ;
	$opts->{ err_mode } = 'croak' ;
	$opts->{ scalar_ref } = 1 ;

	my $existing_data = eval { read_file( $file_name, $opts ) } ;

	if ( $@ ) {

		@_ = ( { err_mode => $err_mode },
			"prepend_file '$file_name' - read_file: $!" ) ;
		goto &_error ;
	}

#print "EXIST [$$existing_data]\n" ;

	$opts->{atomic} = 1 ;
	my $write_result =
		eval { write_file( $file_name, $opts,
		       $prepend_data, $$existing_data ) ;
	} ;

	if ( $@ ) {

		@_ = ( { err_mode => $err_mode },
			"prepend_file '$file_name' - write_file: $!" ) ;
		goto &_error ;
	}

	return $write_result ;
}

# edit a file as a scalar in $_