new keepalive system + timings for PC92 C recs
[spider.git] / perl / DXChannel.pm
index adf7c358ddfec793cf90cedf136da8e799355e0e..7d340a6165f5cfde293b725b28efea2edf9c95b7 100644 (file)
@@ -21,7 +21,7 @@
 #
 # Copyright (c) 1998-2000 - Dirk Koopman G1TLH
 #
-# $Id$
+#
 #
 package DXChannel;
 
@@ -101,6 +101,7 @@ $count = 0;
                  itu => '0,ITU Zone',
                  cq => '0,CQ Zone',
                  enhanced => '5,Enhanced Client,yesno',
+                 gtk => '5,Using GTK,yesno',
                  senddbg => '8,Sending Debug,yesno',
                  width => '0,Column Width',
                  disconnecting => '9,Disconnecting,yesno',
@@ -118,15 +119,12 @@ $count = 0;
                  lastmsgpoll => '0,Last Msg Poll,atime',
                  inscript => '9,In a script,yesno',
                  handle_xml => '9,Handles XML,yesno',
+                 do_pc9x => '9,Handles PC9x,yesno',
                  inqueue => '9,Input Queue,parray',
+                 next_pc92_update => '9,Next PC92 Update,atime',
+                 next_pc92_keepalive => '9,Next PC92 KeepAlive,atime',
                 );
 
-use vars qw($VERSION $BRANCH);
-$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
-$main::build += $VERSION;
-$main::branch += $BRANCH;
-
 # object destruction
 sub DESTROY
 {
@@ -153,7 +151,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;
        }
@@ -357,7 +356,8 @@ sub send_now
         my @lines = split /\n/;
                for (@lines) {
                        $conn->send_now("$sort$call|$_");
-                       dbg("-> $sort $call $_") if isdbg('chan');
+                       # debug log it, but not if it is a log message
+                       dbg("-> $sort $call $_") if $sort ne 'L' && isdbg('chan');
                }
        }
        $self->{t} = time;
@@ -380,7 +380,8 @@ sub send_later
         my @lines = split /\n/;
                for (@lines) {
                        $conn->send_later("$sort$call|$_");
-                       dbg("-> $sort $call $_") if isdbg('chan');
+                       # debug log it, but not if it is a log message
+                       dbg("-> $sort $call $_") if $sort ne 'L' && isdbg('chan');
                }
        }
        $self->{t} = time;
@@ -396,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)
@@ -467,7 +469,7 @@ sub disconnect
        my $user = $self->{user};
        
        $user->close() if defined $user;
-       $self->{conn}->disconnect;
+       $self->{conn}->disconnect if $self->{conn};
        $self->del();
 }
 
@@ -492,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();
@@ -500,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}} ;
        }
 }
 
@@ -549,28 +574,6 @@ sub decode_input
        return ($sort, $call, $line);
 }
 
-sub rspfcheck
-{
-       my ($self, $flag, $node, $user) = @_;
-       my $nref = Route::Node::get($node);
-       my $dxchan = $nref->dxchan if $nref;
-       if ($nref && $dxchan) {
-           if ($dxchan == $self) {
-                       return 1 unless $user;
-                       return 1 if $user eq $node;
-                       my @users = $nref->users;
-                       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->dxchan->{call}) if isdbg('chanerr');
-               }
-       } else {
-               return 1 if $flag;
-               dbg("RSPF: required $node not found" ) if isdbg('chanerr');
-       }
-       return 0;
-}
-
 # broadcast a message to all clusters taking into account isolation
 # [except those mentioned after buffer]
 sub broadcast_nodes
@@ -699,6 +702,19 @@ sub process
        }
 }
 
+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
 {