4 # This is the new fundamental protocol engine handler
6 # This is where all the new things (and eventually all the old things
11 # Copyright (c) 2004 Dirk Koopman G1TLH
18 use vars qw($VERSION $BRANCH @queue @permin @persec);
19 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
20 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /^\d+\.\d+(?:\.(\d+)\.(\d+))?$/ || (0,0));
21 $main::build += $VERSION;
22 $main::branch += $BRANCH;
24 @queue = (); # the input / processing queue
27 # these are set up using the Thingy->add_second_process($addr, $name)
28 # and Thingy->add_minute_process($addr, $name)
30 # They replace the old cycle in cluster.pl
33 @persec = (); # this replaces the cycle in cluster.pl
34 @permin = (); # this is an extra per minute cycle
42 # we expect all thingies to be subclassed
52 # send it out in the format asked for, if available
60 } elsif ($dxchan->isa('DXChannel')) {
65 if ($thing->can('out_filter')) {
66 return unless $thing->out_filter;
69 # generate the line which may (or not) be cached
71 if (my $ref = $thing->{class}) {
72 push @out, ref $ref ? @$ref : $ref;
75 my $sub = "gen_$class";
76 push @out, $thing->$sub($dxchan) if $thing->can($sub);
78 $dxchan->send(@out) if @out;
81 # broadcast to all except @_
85 dbg("Thingy::broadcast: " . $thing->ascii) if isdbg('thing');
87 foreach my $dxchan (DXChannel::get_all()) {
88 next if $dxchan == $main::me;
89 next if grep $dxchan == $_, @_;
90 $thing->send($dxchan);
94 # queue this thing for processing
99 $thing->{dxchan} = $dxchan->call;
103 # this is the main commutator loop. In due course it will
104 # become the *only* commutator loop
109 $thing = shift @queue;
110 my $dxchan = DXChannel->get($thing->{dxchan});
112 if ($thing->can('in_filter')) {
113 next unless $thing->in_filter($dxchan);
115 $thing->handle($dxchan);
119 # per second and per minute processing
120 if ($main::systime != $lastsec) {
121 if ($main::systime >= $lastmin+60) {
122 foreach my $r (@permin) {
125 $lastmin = $main::systime;
127 foreach my $r (@persec) {
130 $lastsec = $main::systime;
134 sub add_minute_process
139 dbg('Adding $name to Thingy per minute queue');
140 push @permin, [$addr, $name];
143 sub add_second_process
148 dbg('Adding $name to Thingy per second queue');
149 push @persec, [$addr, $name];
156 my $dd = new Data::Dumper([$thing]);
160 $dd->Quotekeys($] < 5.005 ? 1 : 0);