From de7f7dbbadcad48ba245f22db044b14954e18782 Mon Sep 17 00:00:00 2001 From: minima Date: Wed, 23 Feb 2005 15:47:34 +0000 Subject: [PATCH] add interval processing --- perl/Aranea.pm | 44 ++++++++++++++++++++++++++++++++++++++++--- perl/DXChannel.pm | 1 + perl/DXCommandmode.pm | 8 +++++--- perl/DXProt.pm | 16 ++++++++-------- perl/Thingy.pm | 23 +++++++++++++++++++--- perl/Thingy/Rt.pm | 19 +++++++------------ 6 files changed, 82 insertions(+), 29 deletions(-) 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; } -- 2.34.1