From: minima <minima>
Date: Wed, 23 Feb 2005 15:47:34 +0000 (+0000)
Subject: add interval processing
X-Git-Tag: R_1_52~157
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=de7f7dbbadcad48ba245f22db044b14954e18782;p=spider.git

add interval processing
---

diff --git a/perl/Aranea.pm b/perl/Aranea.pm
index 787fc538..3fb28072 100644
--- a/perl/Aranea.pm
+++ b/perl/Aranea.pm
@@ -36,12 +36,14 @@ use vars qw($VERSION $BRANCH);
 
 main::mkver($VERSION = q$Revision$);
 
-use vars qw(@ISA $ntpflag $dupeage);
+use vars qw(@ISA $ntpflag $dupeage $cf_interval $hello_interval);
 
 @ISA = qw(DXChannel);
 
 $ntpflag = 0;					# should be set in startup if NTP in use
 $dupeage = 12*60*60;			# duplicates stored half a day 
+$cf_interval = 30*60;			# interval between config broadcasts
+$hello_interval = 3*60*60;		# interval between hello broadcasts for me and local users
 
 my $seqno = 0;
 my $dayno = 0;
@@ -143,9 +145,11 @@ sub normal
 }
 
 #
-# periodic processing
+# periodic processing (every second)
 #
 
+my $lastmin = 0;
+
 sub process
 {
 
@@ -155,6 +159,40 @@ sub process
 		$dayno = $d;
 		$daystart = $main::systime - ($main::systime % 86400);
 	}
+	if ($main::systime >= $lastmin + 60) {
+		if ($lastmin) {
+			per_minute();
+			$lastmin = $main::systime;
+		}
+	}
+}
+
+sub per_minute
+{
+	# send hello and cf packages periodically
+	foreach my $dxchan (DXChannel::get_all()) {
+		next if $dxchan == $main::me;
+		next if $dxchan->is_aranea;
+		if ($main::systime > $dxchan->lasthello + $hello_interval) {
+			my $thing = Thingy::Hello->new(user => $dxchan->call, h => $dxchan->here);
+			$thing->broadcast($dxchan);
+			$dxchan->lasthello($main::systime);
+		}
+		if ($dxchan->is_node) {
+			if ($main::systime > $dxchan->lasthello + $hello_interval) {
+				my $call = $dxchan->call;
+				my $thing = Thingy::Rt->new(user => $call);
+				if (my $nref = Route::Node::get($call)) {
+					$thing->copy_pc16_data($nref);
+					$thing->broadcast($dxchan);
+					$dxchan->lastcf($main::systime);
+				} else {
+					dbg("Aranea::per_minute: Route::Node for $call disappeared");
+					$dxchan->disconnect;
+				}
+			}
+		}
+	}
 }
 
 sub disconnect
@@ -278,7 +316,7 @@ sub tdecode
 	my $s = shift;
 	$s =~ s/^'(.*)'$/$1/;
 	$s =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
-	return $s;
+	return length $s ? $s : '';
 }
 
 sub genmsg
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index f6a98cb1..31f912c6 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -119,6 +119,7 @@ $count = 0;
 		  inscript => '9,In a script,yesno',
 		  inqueue => '9,Input Queue,parray',
 		  lastcf => '1,Last CF Update,atime',
+		  lasthello => '1,Last Hello Update,atime',
 		 );
 
 use vars qw($VERSION $BRANCH);
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 937bbfea..72144d91 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -70,9 +70,6 @@ sub new
 	my $call = shift;
 	my @rout = $main::routeroot->add_user($call, Route::here(1));
 
-	# ALWAYS output the user
-	my $thing = Thingy::Hello->new(user => $call);
-	$thing->broadcast($self);
 	
 	my $ref = Route::User::get($call);
 	$main::me->route_pc16($main::mycall, undef, $main::routeroot, $ref) if $ref;
@@ -178,6 +175,11 @@ sub start
 		$user->lastoper($main::systime + ((int rand(10)) * 86400));
 	}
 
+	# ALWAYS output the user
+	my $thing = Thingy::Hello->new(user => $call, h => $self->{here});
+	$thing->broadcast($self);
+	$self->lasthello($main::systime);
+
 	# run a script send the output to the punter
 	my $script = new Script(lc $call) || new Script('user_default');
 	$script->run($self) if $script;
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 612e59b6..d09632e3 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -239,11 +239,6 @@ sub new
 	my $pkg = shift;
 	my $call = shift;
 	$main::routeroot->add($call, '5000', Route::here(1)) if $call ne $main::mycall;
-	if ($self->{call} ne $main::mycall) {
-		my $thing = Thingy::Hello->new(user=>$call);
-		$thing->broadcast($self);
-	}
-	
 	return $self;
 }
 
@@ -313,8 +308,10 @@ sub start
 	$self->state('init');
 	$self->{pc50_t} = $main::systime;
 
-	my $thing = Thingy::Hello->new(origin=>$main::mycall, user=>$call);
+	# ALWAYS output the hello
+	my $thing = Thingy::Hello->new(user => $call, h => $self->{here});
 	$thing->broadcast($self);
+	$self->lasthello($main::systime);
 	
 	# send info to all logged in thingies
 	$self->tell_login('loginn');
@@ -1113,7 +1110,9 @@ sub handle_20
 	$self->{lastping} = 0;
 	my $thing = Thingy::Rt->new(user=>$self->{call});
 	my $nref = Route::Node::get($self->{call});
-	$thing->broadcast if $thing->copy_pc16_data($nref);
+	$thing->copy_pc16_data($nref);
+	$thing->broadcast;
+	
 	$self->lastcf($main::systime);
 }
 		
@@ -1203,7 +1202,8 @@ sub handle_22
 	$self->{lastping} = 0;
 	my $thing = Thingy::Rt->new(user=>$self->{call});
 	my $nref = Route::Node::get($self->{call});
-	$thing->broadcast if $thing->copy_pc16_data($nref);
+	$thing->copy_pc16_data($nref);
+	$thing->broadcast;
 	$self->lastcf($main::systime);
 }
 				
diff --git a/perl/Thingy.pm b/perl/Thingy.pm
index a420206d..308e80c3 100644
--- a/perl/Thingy.pm
+++ b/perl/Thingy.pm
@@ -55,25 +55,42 @@ sub send
 	my $thing = shift;
 	my $dxchan = shift;
 	my $class;
+	my $sub;
+	
 	if (@_) {
 		$class = shift;
 	} elsif ($dxchan->isa('DXChannel')) {
 		$class = ref $dxchan;
 	}
 
+	# BEWARE!!!!!
+	no strict 'refs';
+
 	# do output filtering
 	if ($thing->can('out_filter')) {
 		return unless $thing->out_filter($dxchan);
 	}
 
-	# generate the line which may (or not) be cached
+	# before send (and line generation) things
+	# function must return true to make the send happen
+	$sub = "before_send_$class";
+	return unless $thing->can($sub) && $thing->$sub($dxchan);
+	
+	# generate the protocol line which may (or not) be cached
 	my $ref;
 	unless ($ref = $thing->{class}) {
-		no strict 'refs';
-		my $sub = "gen_$class";
+		$sub = "gen_$class";
 		$ref = $thing->$sub($dxchan) if $thing->can($sub);
 	}
 	$dxchan->send(ref $ref ? @$ref : $ref) if $ref;
+
+	# after send
+	if ($thing->can('after_send_all')) {
+		$thing->after_send_all($dxchan);
+	} else {
+		$sub = "after_send_$class";
+		$thing->$sub($dxchan) if $thing->can($sub);
+	}
 }
 
 # broadcast to all except @_
diff --git a/perl/Thingy/Rt.pm b/perl/Thingy/Rt.pm
index 362904d0..554d171a 100644
--- a/perl/Thingy/Rt.pm
+++ b/perl/Thingy/Rt.pm
@@ -24,11 +24,9 @@ use Thingy;
 use Thingy::RouteFilter;
 use Spot;
 
-use vars qw(@ISA $update_interval);
+use vars qw(@ISA);
 @ISA = qw(Thingy Thingy::RouteFilter);
 
-$update_interval = 30 * 60;		# the interval between 'cf' updates for an interface
-
 sub gen_Aranea
 {
 	my $thing = shift;
@@ -37,13 +35,13 @@ sub gen_Aranea
 	unless ($thing->{Aranea}) {
 		my $ref;
 		if ($ref = $thing->{anodes}) {
-			$thing->{a} = join(':', map {"$_->{flags}$_->{call}"} @$ref);
+			$thing->{a} = join(':', map {"$_->{flags}$_->{call}"} @$ref) || '';
 		}
 		if ($ref = $thing->{anodes}) {
-			$thing->{n} = join(':', map {"$_->{flags}$_->{call}"} @$ref);
+			$thing->{n} = join(':', map {"$_->{flags}$_->{call}"} @$ref) || '';
 		}
 		if ($ref = $thing->{ausers}) {
-			$thing->{u} = join(':', map {"$_->{flags}$_->{call}"} @$ref);
+			$thing->{u} = join(':', map {"$_->{flags}$_->{call}"} @$ref) || '';
 		}
 	 	$thing->{Aranea} = Aranea::genmsg($thing, [qw(s a n u)]);
 	}
@@ -238,12 +236,9 @@ sub copy_pc16_data
 
 	$thing->{'s'} = 'cf';
 
-	my @u = $uref->users;
-	if (@u) {
-		$thing->{ausers} = [map {Route::User::get($_)} @u];
-		return scalar @u;
-	}
-	return undef;
+	my @u = map {Route::User::get($_)} $uref->users;
+	$thing->{ausers} = \@u;
+	return @u;
 }