add interval processing

diff --git a/perl/Aranea.pm b/perl/Aranea.pm
index 787fc5389986f01c869d75b1bc91222c6a0da8e3..3fb2807290945e3234a61b143d2087203899e2a9 100644 (file)
--- 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 f6a98cb14a1c18dad119ece5f4b3d14e60ea73a7..31f912c6030b789b5fef9fa3c310273aa3b45e3e 100644 (file)
--- 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 937bbfea034b21da0d447bdf95f3483a95ee9c6c..72144d91ea2f302b65a03552cd9728f94797c96c 100644 (file)
--- 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 612e59b6c93e62fbefa1a52a6dc4823ed5e001a1..d09632e3a09400891c58d744a75e644df320d425 100644 (file)
--- 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 a420206d5ef402a7c70f038927ab575a068fd41d..308e80c3d67c3dd13e72576c09f7bceead959887 100644 (file)
--- 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 362904d01cac4b311eb2679e379f0afbea16f25e..554d171aea445f9ed6d65e231d6b3881eb102d44 100644 (file)
--- 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;
 }