File Coverage

blib/lib/IO/Mux.pm

Criterion	Covered	Total	%
statement	86	88	97.7
branch	22	24	91.6
condition			n/a
subroutine	20	20	100.0
pod	3	3	100.0
total	131	135	97.0

package IO::Mux ;

use 5.008 ;
use strict ;
use Symbol ;
use IO::Mux::Handle ;
use IO::Mux::Packet ;
use IO::Mux::Buffer ;
use IO::Handle ;
use IO::Select ;
use Carp ;


our $VERSION = '0.08' ;


sub new {
	my $class = shift ;
	my $fh = shift ;

	my $this = {} ;
	if (UNIVERSAL::isa($fh, 'GLOB')){
		# Make sure we save the actual IO bit, not the entire GLOB ref, because
		# one typical usage could be to place \*STDOUT in a IO::Mux object and then
		# do: *STDOUT = $mux. If we save the GLOB ref, that will create infinite
		# recursion as the GLOB is deferenced each time to get the IO bit.
		$this->{'glob'} = $fh ;
		$fh = *{$fh}{IO} ;
	}
	$fh->autoflush(1) ;

	$this->{fh} = $fh ;
	$this->{buffers} = {} ;
	$this->{'select'} = new IO::Select($fh) ;

	return bless($this, $class) ;
}


sub get_handle {
	my $this = shift ;

	return (defined($this->{'glob'}) ? $this->{'glob'} : $this->{fh}) ;
}


sub _get_handle {
	my $this = shift ;

	return $this->{fh} ;
}


sub new_handle {
	my $this = shift ;

	return new IO::Mux::Handle($this) ;
}


sub _get_buffer {
	my $this = shift ;
	my $id = shift ;

	if (! $this->_buffer_exists($id)){
		$this->{buffers}->{$id} = new IO::Mux::Buffer() ;
	}

	return $this->{buffers}->{$id} ;
}


sub _buffer_exists {
	my $this = shift ;
	my $id = shift ;

	return defined($this->{buffers}->{$id}) ;
}


sub _kill_buffer {
	my $this = shift ;
	my $id = shift ;

	delete $this->{buffers}->{$id} ;
}


sub _read {
	my $this = shift ;
	my $id = shift ;
	my $blocking = shift ;

	my $p = undef ;
	while (! defined($p)){
		my $tp = $this->_read_packet($blocking) ;
		if (! defined($tp)){
			return undef ;
		}
		elsif (! $tp){
			return 0 ;
		}
		elsif ($tp == -1){
			# No packet available in non-blocking mode.
			return -1 ;
		}
		else {
			if ($tp->get_id() eq $id){
				if (! $tp->is_eof()){
					$p = $tp ;
				}
				else {
					return 0 ;
				}
			}
		}
	}

	return $p->get_length() ;
}


sub _is_packet_available {
	my $this = shift ;

	my @ready = $this->{'select'}->can_read(0) ;

	return scalar(@ready) ;
}


# Returns a packet, 0 on real handle EOF or undef on error.
sub _read_packet {
	my $this = shift ;
	my $blocking = shift ;

	if (! $blocking){
		return -1 unless $this->_is_packet_available() ;
	}

	my $p = IO::Mux::Packet->read($this->_get_handle()) ;
	if (! defined($p)){
		return undef ;
	}
	elsif (! $p){
		return 0 ;
	}
	else {
		# Append the packet data to the correct buffer
		my $buf = $this->_get_buffer($p->get_id()) ;
		$buf->push_packet($p) ;

		return $p ;
	}
}


sub _write {
	my $this = shift ;
	my $packet = shift ;

	return $packet->write($this->_get_handle()) ;
}



1 ;
__END__