clean up various things and add the DXXml.pm module

[spider.git] / perl / DXChannel.pm

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 1994846b20894092ffd6f81a56c25057fe5f6169..6da3ecbe36d0be30a00ee2a47ce64bdac9f1e411 100644 (file)
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -115,6 +115,10 @@ $count = 0;
                  verified => '9,Verified?,yesno',
                  newroute => '1,New Style Routing,yesno',
                  ve7cc => '0,VE7CC program special,yesno',
+                 lastmsgpoll => '0,Last Msg Poll,atime',
+                 inscript => '9,In a script,yesno',
+                 handle_xml => '9,Handles XML,yesno',
+                 inqueue => '9,Input Queue,parray',
                 );
 
 use vars qw($VERSION $BRANCH);
@@ -166,6 +170,7 @@ sub alloc
                $self->{itu} = $dxcc[1]->itu;
                $self->{cq} = $dxcc[1]->cq;                                             
        }
+       $self->{inqueue} = [];
 
        $count++;
        dbg("DXChannel $self->{call} created ($count)") if isdbg('chan');
@@ -173,17 +178,26 @@ sub alloc
        return $channels{$call} = $self;
 }
 
-# obtain a channel object by callsign [$obj = DXChannel->get($call)]
+sub rec        
+{
+       my ($self, $msg) = @_;
+       
+       # queue the message and the channel object for later processing
+       if (defined $msg) {
+               push @{$self->{inqueue}}, $msg;
+       }
+}
+
+# obtain a channel object by callsign [$obj = DXChannel::get($call)]
 sub get
 {
-       my ($pkg, $call) = @_;
+       my $call = shift;
        return $channels{$call};
 }
 
 # obtain all the channel objects
 sub get_all
 {
-       my ($pkg) = @_;
        return values(%channels);
 }
 
@@ -253,7 +267,7 @@ sub is_bbs
 sub is_node
 {
        my $self = shift;
-       return $self->{'sort'} =~ /[ACRSX]/;
+       return $self->{'sort'} =~ /[ACRSXW]/;
 }
 # is it an ak1a node ?
 sub is_ak1a
@@ -276,6 +290,13 @@ sub is_clx
        return $self->{'sort'} eq 'C';
 }
 
+# it is Aranea
+sub is_aranea
+{
+       my $self = shift;
+       return $self->{'sort'} eq 'W';
+}
+
 # is it a spider node
 sub is_spider
 {
@@ -437,7 +458,6 @@ sub disconnect
        my $self = shift;
        my $user = $self->{user};
        
-       main::clean_inqueue($self);          # clear out any remaining incoming frames
        $user->close() if defined $user;
        $self->{conn}->disconnect;
        $self->del();
@@ -549,7 +569,7 @@ sub broadcast_nodes
 {
        my $s = shift;                          # the line to be rebroadcast
        my @except = @_;                        # to all channels EXCEPT these (dxchannel refs)
-       my @dxchan = DXChannel::get_all_nodes();
+       my @dxchan = get_all_nodes();
        my $dxchan;
        
        # send it if it isn't the except list and isn't isolated and still has a hop count
@@ -569,7 +589,7 @@ sub broadcast_all_nodes
 {
        my $s = shift;                          # the line to be rebroadcast
        my @except = @_;                        # to all channels EXCEPT these (dxchannel refs)
-       my @dxchan = DXChannel::get_all_nodes();
+       my @dxchan = get_all_nodes();
        my $dxchan;
        
        # send it if it isn't the except list and isn't isolated and still has a hop count
@@ -590,7 +610,7 @@ sub broadcast_users
        my $sort = shift;           # the type of transmission
        my $fref = shift;           # a reference to an object to filter on
        my @except = @_;                        # to all channels EXCEPT these (dxchannel refs)
-       my @dxchan = DXChannel::get_all_users();
+       my @dxchan = get_all_users();
        my $dxchan;
        my @out;
        
@@ -634,6 +654,42 @@ sub broadcast_list
        }
 }
 
+sub process
+{
+       foreach my $dxchan (get_all()) {
+
+               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;
+                       if ($sort eq 'A' || $sort eq 'O') {
+                               $dxchan->start($line, $sort);
+                       } elsif ($sort eq 'I') {
+                               die "\$user not defined for $call" if !defined $user;
+                       
+                               # normal input
+                               $dxchan->normal($line);
+                       } elsif ($sort eq 'Z') {
+                               $dxchan->disconnect;
+                       } elsif ($sort eq 'D') {
+                               ;                               # ignored (an echo)
+                       } elsif ($sort eq 'G') {
+                               $dxchan->enhanced($line);
+                       } else {
+                               print STDERR atime, " Unknown command letter ($sort) received from $call\n";
+                       }
+               }
+       }
+}
 
 #no strict;
 sub AUTOLOAD