X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXChannel.pm;h=517372fa9446b49aba4799c3528483dddb203381;hb=34b7ed3f88da5b993281b7c1ee9af699e1b9b54b;hp=958fe61860b3cb69122df0101fe8741c6afcc805;hpb=a48eea32af123b571889f70a3e7cef8e157cf389;p=spider.git

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 958fe618..517372fa 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -125,6 +125,7 @@ $count = 0;
 		  inqueue => '9,Input Queue,parray',
 		  next_pc92_update => '9,Next PC92 Update,atime',
 		  next_pc92_keepalive => '9,Next PC92 KeepAlive,atime',
+		  anyevents => '9,outstanding AnyEvent handles,parray',
 		 );
 
 $maxerrors = 20;				# the maximum number of concurrent errors allowed before disconnection
@@ -147,11 +148,16 @@ sub alloc
 {
 	my ($pkg, $call, $conn, $user) = @_;
 	my $self = {};
-  
+
 	die "trying to create a duplicate channel for $call" if $channels{$call};
+	bless $self, $pkg;
+
 	$self->{call} = $call;
 	$self->{priv} = 0;
-	$self->{conn} = $conn if defined $conn;	# if this isn't defined then it must be a list
+	if (defined $conn && ref $conn) { # if this isn't defined then it must be a list
+		$self->{conn} = $conn;
+		$conn->set_on_eof(sub {$self->disconnect});
+	}
 	if (defined $user) {
 		$self->{user} = $user;
 		$self->{lang} = $user->lang;
@@ -174,10 +180,10 @@ sub alloc
 		$self->{cq} = $dxcc[1]->cq;						
 	}
 	$self->{inqueue} = [];
+	$self->{anyevents} = [];
 
 	$count++;
 	dbg("DXChannel $self->{call} created ($count)") if isdbg('chan');
-	bless $self, $pkg; 
 	return $channels{$call} = $self;
 }
 
@@ -202,7 +208,9 @@ sub rebless
 {
 	my $self = shift;
 	my $class = shift;
-	return $channels{$self->{call}} = bless $self, $class;
+	my $new = bless $self, $class;
+	$new->{conn}->on_eof(sub {$new->disconnect});
+	return $channels{$self->{call}} = $new;
 }
 
 sub rec	
@@ -386,9 +394,9 @@ sub send_now
 #		chomp;
         my @lines = split /\n/;
 		for (@lines) {
+			dbg("-> $sort $call $_") if $sort ne 'L' && isdbg('chan');
 			$conn->send_now("$sort$call|$_");
 			# debug log it, but not if it is a log message
-			dbg("-> $sort $call $_") if $sort ne 'L' && isdbg('chan');
 		}
 	}
 	$self->{t} = time;
@@ -410,9 +418,9 @@ sub send_later
 #		chomp;
         my @lines = split /\n/;
 		for (@lines) {
+			dbg("-> $sort $call $_") if $sort ne 'L' && isdbg('chan');
 			$conn->send_later("$sort$call|$_");
 			# debug log it, but not if it is a log message
-			dbg("-> $sort $call $_") if $sort ne 'L' && isdbg('chan');
 		}
 	}
 	$self->{t} = time;
@@ -432,8 +440,8 @@ sub send						# this is always later and always data
 		for (ref $l ? @$l : $l) {
 			my @lines = split /\n/;
 			for (@lines) {
-				$conn->send_later("D$call|$_");
 				dbg("-> D $call $_") if isdbg('chan');
+				$conn->send_later("D$call|$_");
 			}
 		}
 	}
@@ -500,7 +508,7 @@ sub disconnect
 	my $user = $self->{user};
 	
 	$user->close() if defined $user;
-	$self->{conn}->disconnect if $self->{conn};
+	$self->{conn}->close_on_empty if $self->{conn};
 	$self->del();
 }
 
@@ -698,7 +706,7 @@ sub broadcast_list
 
 sub process
 {
-	foreach my $dxchan (get_all()) {
+	foreach my $dxchan (values %channels) {
 
 		while (my $data = shift @{$dxchan->{inqueue}}) {
 			my ($sort, $call, $line) = $dxchan->decode_input($data);
@@ -746,6 +754,25 @@ sub handle_xml
 	return $r;
 }
 
+sub anyevent_add
+{
+	my $self = shift;
+	my $handle = shift;
+	my $sort = shift || "unknown";
+
+	push @{$self->{anyevents}}, $handle;
+	dbg("anyevent: add $sort handle making " . scalar @{$self->{anyevents}} . " handles in use") if isdbg('anyevent');
+}
+
+sub anyevent_del
+{
+	my $self = shift;
+	my $handle = shift;
+	my $sort = shift || "unknown";
+	$self->{anyevents} = [ grep {$_ != $handle} @{$self->{anyevents}} ];
+	dbg("anyevent: delete $sort handle making " . scalar @{$self->{anyevents}} . " handles in use") if isdbg('anyevent');
+}
+
 #no strict;
 sub AUTOLOAD
 {