X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXChannel.pm;h=8384567003685d54e1a5dfe155095e2a91e573db;hb=ec1b2a19fcc6539f071a766671b5fa5be8694362;hp=69a72abe9e1d4438118f991b5e3b86f515206099;hpb=8b21846900b9f840da86fef72e6ee86ac56cfb53;p=spider.git

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 69a72abe..83845670 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -80,11 +80,13 @@ $count = 0;
 		  wcyfilter => '5,WCY Filt-out',
 		  spotsfilter => '5,Spot Filt-out',
 		  routefilter => '5,Route Filt-out',
+		  pc92filter => '5,PC92 Route Filt-out',
 		  inannfilter => '5,Ann Filt-inp',
 		  inwwvfilter => '5,WWV Filt-inp',
 		  inwcyfilter => '5,WCY Filt-inp',
 		  inspotsfilter => '5,Spot Filt-inp',
 		  inroutefilter => '5,Route Filt-inp',
+		  inpc92filter => '5,PC92 Route Filt-inp',
 		  passwd => '9,Passwd List,yesno',
 		  pingint => '5,Ping Interval ',
 		  nopings => '5,Ping Obs Count',
@@ -123,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
@@ -145,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;
@@ -172,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;
 }
 
@@ -200,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	
@@ -384,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;
@@ -408,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;
@@ -430,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|$_");
 			}
 		}
 	}
@@ -498,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();
 }
 
@@ -696,18 +706,16 @@ sub broadcast_list
 
 sub process
 {
-	foreach my $dxchan (get_all()) {
-
+	foreach my $dxchan (values %channels) {
+		
+		next if $dxchan->{disconnecting};
+		
 		while (my $data = shift @{$dxchan->{inqueue}}) {
 			my ($sort, $call, $line) = $dxchan->decode_input($data);
 			next unless defined $sort;
 
 			# do the really sexy console interface bit! (Who is going to do the TK interface then?)
 			dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan');
-			if ($dxchan->{disconnecting}) {
-				dbg('In disconnection, ignored');
-				next;
-			}
 
 			# handle A records
 			my $user = $dxchan->user;
@@ -744,6 +752,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
 {