view release on metacpan or  search on metacpan

lib/Image/BioChrome.pm  view on Meta::CPAN

#============================================================================
#
# write_file 
#
#============================================================================

sub write_file {
	my $self = shift;
	my $file = shift || return;

	print STDERR "$MOD: write_file [$file]\n" if $DEBUG;

	# validate the filename 


	# process our internal data to re-write the colors
	$self->_color() if $self->{ colors };
	$self->_alpha() if $self->{ alphas };

	# the default is to copy the image data
	$self->{ output_data } = $self->{ data } unless $self->{ output_data };

	my $base = dirname($file);
	
	# check that the directory exists
	unless (-d $base) {

		# eval this as problems in directory creation can cause a die
		eval {
			mkpath($base) || die "Failed to make directory: $base\n";
		};

		die "Failed to make directory\n" if $@;
	}

	# create a temporary file
	my($fh, $temp) = tempfile();

	binmode($fh);
	print $fh $self->{ output_data };
	close($fh);

	# tidy out internal state
	delete $self->{ output_data };

	# move the temporary file to the destination
	move($temp, $file) || do {
		unlink($temp);
		die "Failed to move temporary file\n";
	};


	if ($self->{ preserve }) {

		my $uid  = $self->{ file }->{ uid };
		my $gid  = $self->{ file }->{ gid };
		my $mode = $self->{ file }->{ mode };

	    chown($uid, $gid, $file) || do {
			warn "chown($file): $!\n" if $VERBOSE;
		};

	    chmod($mode, $file) || do {
			warn "chmod($file): $!\n" if $VERBOSE;
		};
	}

	return;
}


#============================================================================
#
# reset_file
#
# reset the file to it's original state
#
#============================================================================

sub reset_file {
	my $self = shift;

	warn "reset_file is deprecated\n";
	# file now automatically reset do nothing
	# $self->_read_file();
}


#============================================================================
#============================================================================
#
# INTERNAL METHODS BELOW
#
#============================================================================
#============================================================================

#============================================================================
#
# _read_file 
#
#============================================================================

sub _read_file {
	my $self = shift;

	my $file = $self->{ src_file };
	my $part;

	$self->{ data } = '';

	local *FILE;

	open(FILE, $file) || do {
		die "Failed to open file\n";
		print STDERR "$MOD: failed to open $file: $!\n";
		return;
	};

    # stat the file so we can preserve mode and ownership
    my ($mode, $uid, $gid, $time);