File Coverage

blib/lib/POE/Filter/ErrorProof.pm

Criterion	Covered	Total	%
statement	9	90	10.0
branch	0	36	0.0
condition			n/a
subroutine	3	12	25.0
pod	6	7	85.7
total	18	145	12.4

package POE::Filter::ErrorProof;

use 5.000;
use strict;

use vars qw($VERSION @ISA);
$VERSION = '0.01';
@ISA = qw(POE::Filter);

sub new {
	my ($type, $filter, $errorsock) = @_;
	if(!defined($filter)) {
		$filter = new POE::Filter::Stream;
	}

	my $outputErrors;
	if(!defined($errorsock)) {
		$outputErrors = 0;
	} elsif(ref($errorsock) eq "GLOB") {
		$outputErrors = 1;
	} elsif(ref($errorsock) eq "POE::Wheel::ReadWrite") {
		$outputErrors = 2;
	} elsif($errorsock == 1) {
		$outputErrors = 1;
		$errorsock = \*STDERR;
	}

	$type = ref($type) if ref($type);
	my $self = {
		filter => $filter,
		outputErrors => $outputErrors,
		errorsock => $errorsock,
		output => sub {
			my $self = shift; my $error = shift;
			my $oe = $self->{outputErrors};
			if($oe == 1) {
				my $sock = $self->{errorsock};
				print $sock $error;
			} elsif($oe == 2) {
				$self->{errorsock}->put($error);
			}
		},
	};
	bless $self, $type;
	return $self;
}

sub clone {
	my ($self) = @_;
	my $filter;
	eval {
		if($self->{filter}->can('clone')) {
			$filter = $self->{filter}->clone();
		} else {
			$filter = $self->{filter};
		}
	};
	if($@) {
		$self->{output}->($self, $@);
		return undef;
	}
	my $clone = {
		filter => $filter,
	};
	bless $clone, ref $self;
	return $clone;
}

sub DESTROY {
	my ($self) = @_;
	my $outp;
	eval {
		$outp = $self->{filter}->DESTROY() if($self->{filter}->can('DESTROY'));
	};
	if($@) {
		$self->{output}->($self, $@);
		return undef;
	}
	return $outp;
}

sub reset {
	my ($self) = @_;
	my $outp;
	eval {
		$outp = $self->{filter}->reset() if($self->{filter}->can('reset'));
	};
	if($@) {
		$self->{output}->($self, $@);
		return undef;
	}
	return $outp;
}

sub get_one_start {
	my ($self, $stream) = @_;
	my $outp;
	eval {
		$outp = $self->{filter}->get_one_start($stream);
	};
	if($@) {
		$self->{output}->($self, $@);
		return undef;
	}
	return $outp;
}

sub get_one {
	my ($self) = @_;
	my $outp;
	eval {
		$outp = $self->{filter}->get_one();
	};
	if($@) {
		$self->{output}->($self, $@);
		return [];
	}
	return $outp;
}

sub put {
	my ($self, $chunks) = @_;
	my $outp;
	eval {
		$outp = $self->{filter}->put();
	};
	if($@) {
		$self->{output}->($self, $@);
		return [];
	}
	return $outp;
}

sub get_pending {
	my ($self) = @_;
	my $outp;
	eval {
		$outp = $self->{filter}->get_pending();
	};
	if($@) {
		$self->{output}->($self, $@);
		return undef;
	}
	return $outp;
}



1;
__END__