view release on metacpan or  search on metacpan

lib/AnyEvent/Connection/Raw.pm  view on Meta::CPAN

package #hide
	AnyEvent::Connection::Raw;

use common::sense 2;m{
use strict;
use warnings;
};
use Object::Event 1.21;
use base 'Object::Event';
use AnyEvent::Handle;
use AnyEvent::Connection::Util;
use Scalar::Util qw(weaken);
use Carp;
# @rewrite s/^# //;
# use Devel::Leak::Cb;

sub _call_waiting {
	my $me = shift;
	for my $k (keys %{ $me->{waitingcb} }) {
		warn "call waiting $k with @_" if $me->{debug};
		if ($me->{waitingcb}{$k}) {
			$me->{waitingcb}{$k}->(undef, @_);
		}
		delete $me->{waitingcb}{$k};
	}
}

sub new {
	my $pkg = shift;
	my $self = $pkg->SUPER::new(@_);
	$self->{nl} = "\015\012" unless defined $self->{nl};
	$self->{debug} = 0 unless defined $self->{debug};
	weaken(my $me = $self);
	# @rewrite s/sub /cb 'conn.cb.eof' /;
	$self->{cb}{eof} = sub {
		$me or return;
		#local *__ANON__ = 'conn.cb.eof';
		warn "[\U$me->{side}\E] Eof on handle";
		delete $me->{h};
		$me->event('disconnect');
		$me->_call_waiting("EOF from handle");
	} ;
	# @rewrite s/sub /cb 'conn.cb.err' /;
	$self->{cb}{err} = sub {
		$me or return;
		#local *__ANON__ = 'conn.cb.err';
		#use Carp;Carp::cluck((0+$!).": $!");
		my $e = "$!";
		if ( $me->{destroying} ) {
			warn "err on destroy";
			$e = "Connection closed";
		} else {
			#warn "[\U$me->{side}\E] Error on handle: $e"; # uncomment
		}
		delete $me->{h};
		$self->event( disconnect => "Error: $e" );
		$me->_call_waiting($e);
	};
	$self->{timeout} ||= 30;
	$self->{h} = AnyEvent::Handle->new(
		fh        => $self->{fh},
		autocork  => 1,
		keepalive => 1,
		on_eof    => $self->{cb}{eof},
		on_error  => $self->{cb}{err},
	);
	$self;
}

sub destroy {
	my ($self) = @_;
	$self->DESTROY;
	bless $self, "AnyEvent::Connection::Raw::destroyed";
}
*close = \&destroy;
sub AnyEvent::Connection::Raw::destroyed::AUTOLOAD {}
sub DESTROY {
	my $self = shift;
	warn "(".int($self).") Destroying AE::CNN::Raw" if $self->{debug};
	delete $self->{fh};
	$self->_call_waiting("destroying connection");
	$self->{h} and $self->{h}->destroy;
	delete $self->{h};
	%$self = ();
	return;
}

sub push_write {
	my $self = shift;
	$self->{h} or return;