fix xml ambiqueties.
[spider.git] / perl / DXChannel.pm
index 829c6b55585bf0022e6f96c28a17be6d368d5798..efaffb6c04d80be433ac080fd2470c53ea340185 100644 (file)
@@ -114,6 +114,11 @@ $count = 0;
                  build => '1,Node Build',
                  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);
@@ -148,7 +153,8 @@ sub alloc
        if (defined $user) {
                $self->{user} = $user;
                $self->{lang} = $user->lang;
-               $user->new_group() if !$user->group;
+               $user->new_group unless $user->group;
+               $user->new_buddies unless $user->buddies;
                $self->{group} = $user->group;
                $self->{sort} = $user->sort;
        }
@@ -165,6 +171,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');
@@ -172,17 +179,34 @@ sub alloc
        return $channels{$call} = $self;
 }
 
-# obtain a channel object by callsign [$obj = DXChannel->get($call)]
+# rebless this channel as something else
+sub rebless
+{
+       my $self = shift;
+       my $class = shift;
+       return $channels{$self->{call}} = bless $self, $class;
+}
+
+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);
 }
 
@@ -252,7 +276,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
@@ -275,6 +299,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
 {
@@ -366,15 +397,16 @@ sub send                                          # this is always later and always data
        return unless $conn;
        my $call = $self->{call};
 
-       for (@_) {
-#              chomp;
-        my @lines = split /\n/;
-               for (@lines) {
-                       $conn->send_later("D$call|$_");
-                       dbg("-> D $call $_") if isdbg('chan');
+       foreach my $l (@_) {
+               for (ref $l ? @$l : $l) {
+                       my @lines = split /\n/;
+                       for (@lines) {
+                               $conn->send_later("D$call|$_");
+                               dbg("-> D $call $_") if isdbg('chan');
+                       }
                }
        }
-       $self->{t} = time;
+       $self->{t} = $main::systime;
 }
 
 # send a file (always later)
@@ -436,7 +468,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();
@@ -463,7 +494,9 @@ sub closeall
 #
 sub tell_login
 {
-       my ($self, $m) = @_;
+       my ($self, $m, $call) = @_;
+       
+       $call ||= $self->{call};
        
        # send info to all logged in thingies
        my @dxchan = get_all_users();
@@ -471,7 +504,28 @@ sub tell_login
        foreach $dxchan (@dxchan) {
                next if $dxchan == $self;
                next if $dxchan->{call} eq $main::mycall;
-               $dxchan->send($dxchan->msg($m, $self->{call})) if $dxchan->{logininfo};
+               $dxchan->send($dxchan->msg($m, $call)) if $dxchan->{logininfo};
+       }
+}
+
+#
+# Tell all the users if a buddy is logged or out
+#
+sub tell_buddies
+{
+       my ($self, $m, $call, $node) = @_;
+       
+       $call ||= $self->{call};
+       $call =~ s/-\d+$//;
+       $m .= 'n' if $node;
+       
+       # send info to all logged in thingies
+       my @dxchan = get_all_users();
+       my $dxchan;
+       foreach $dxchan (@dxchan) {
+               next if $dxchan == $self;
+               next if $dxchan->{call} eq $main::mycall;
+               $dxchan->send($dxchan->msg($m, $call, $node)) if grep $_ eq $call, @{$dxchan->{user}->{buddies}} ;
        }
 }
 
@@ -524,7 +578,7 @@ sub rspfcheck
 {
        my ($self, $flag, $node, $user) = @_;
        my $nref = Route::Node::get($node);
-       my $dxchan = $nref->bestdxchan if $nref;
+       my $dxchan = $nref->dxchan if $nref;
        if ($nref && $dxchan) {
            if ($dxchan == $self) {
                        return 1 unless $user;
@@ -533,7 +587,7 @@ sub rspfcheck
                        return 1 if @users == 0 || grep $user eq $_, @users;
                        dbg("RSPF: $user not on $node") if isdbg('chanerr');
                } else {
-                       dbg("RSPF: Shortest path for $node is " . $nref->bestdxchan->{call}) if isdbg('chanerr');
+                       dbg("RSPF: Shortest path for $node is " . $nref->dxchan->{call}) if isdbg('chanerr');
                }
        } else {
                return 1 if $flag;
@@ -548,7 +602,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
@@ -568,7 +622,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
@@ -589,7 +643,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;
        
@@ -633,6 +687,55 @@ 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";
+                       }
+               }
+       }
+}
+
+sub handle_xml
+{
+       my $self = shift;
+       my $r = 0;
+       
+       if (DXXml::available()) {
+               $r = $self->{handle_xml} || 0;
+       } else {
+               delete $self->{handle_xml} if exists $self->{handle_xml};
+       }
+       return $r;
+}
 
 #no strict;
 sub AUTOLOAD