File Coverage

blib/lib/File/Replace/SingleHandle.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	14	14	100.0
condition	6	6	100.0
subroutine	14	14	100.0
pod	0	3	0.0
total	85	88	96.5

#!perl
package # hide from pause
	File::Replace::SingleHandle;
use warnings;
use strict;
use Carp;
use warnings::register;
use Scalar::Util qw/blessed weaken/;

# For AUTHOR, COPYRIGHT, AND LICENSE see the bottom of this file

our $VERSION = '0.16';

## no critic (RequireFinalReturn, RequireArgUnpacking)

BEGIN {
	require Tie::Handle::Base;
	our @ISA = qw/ Tie::Handle::Base /;  ## no critic (ProhibitExplicitISA)
}

sub TIEHANDLE {
	@_==3 or croak __PACKAGE__."->TIEHANDLE: bad number of args";
	my ($class,$repl,$mode) = @_;
	croak "$class->TIEHANDLE: argument must be a File::Replace object"
		unless blessed($repl) && $repl->isa('File::Replace');
	my ($innerhandle,$other);
	if ($mode eq 'in') {
		$innerhandle = $repl->in_fh;
		$other   = $repl->out_fh; }
	elsif ($mode eq 'out') {
		$innerhandle = $repl->out_fh;
		$other   = $repl->in_fh; }
	elsif ($mode eq 'onlyout') {
		$innerhandle = $repl->out_fh; }
	else { croak "bad mode" }
	my $self = $class->SUPER::TIEHANDLE($innerhandle);
	$self->{repl}  = $repl;
	$self->{other} = $other;
	weaken( $self->{other} );
	return $self;
}

sub replace { return shift->{repl} }
sub in_fh   { return shift->{repl}->in_fh }
sub out_fh  { return shift->{repl}->out_fh }

sub OPEN { croak "Can't reopen a ".ref($_[0])." handle" }

sub CLOSE {
	my $self = shift;
	if ( defined($self->{other}) && defined(fileno($self->{other})) ) {
		# the other file is still open, so just close this one
		my $rv = $self->SUPER::CLOSE()
			or croak "couldn't close handle: $!";
		return $rv;
	}
	else { # the other file is closed, trigger the replacement now
		return !!$self->{repl}->finish }
}

sub UNTIE {
	my $self = shift;
	warnings::warnif("Please don't untie ".ref($self)." handles");
	$self->{other} = undef;
	$self->{repl}  = undef;
	$self->SUPER::UNTIE(@_);
}

sub DESTROY {
	my $self = shift;
	# File::Replace destructor will warn on unclosed file
	$self->{other} = undef;
	$self->{repl}  = undef;
	$self->SUPER::DESTROY(@_);
}

1;
__END__