add some flesh to a gtk based console program
[spider.git] / perl / DXCommandmode.pm
index 3a94fb6a2629c82cb282ea6de174a2868c809ca7..528067061a52332a7c9c7b4a5659a9407e05a055 100644 (file)
@@ -9,10 +9,11 @@
 
 package DXCommandmode;
 
-use POSIX;
+#use POSIX;
 
 @ISA = qw(DXChannel);
 
+use POSIX qw(:math_h);
 use DXUtil;
 use DXChannel;
 use DXUser;
@@ -150,10 +151,21 @@ sub start
        $self->{priv} = 0 if $line =~ /^(ax|te)/ && !$self->conn->{usedpasswd};
 
        # get the filters
-       $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'user_default', 0);
-       $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'user_default', 0);
-       $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'user_default', 0);
-       $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'user_default', 0) ;
+       my $nossid = $call;
+       $nossid =~ s/-\d+$//;
+       
+       $self->{spotsfilter} = Filter::read_in('spots', $call, 0) 
+               || Filter::read_in('spots', $nossid, 0)
+                       || Filter::read_in('spots', 'user_default', 0);
+       $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) 
+               || Filter::read_in('wwv', $nossid, 0) 
+                       || Filter::read_in('wwv', 'user_default', 0);
+       $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) 
+               || Filter::read_in('wcy', $nossid, 0) 
+                       || Filter::read_in('wcy', 'user_default', 0);
+       $self->{annfilter} = Filter::read_in('ann', $call, 0) 
+               || Filter::read_in('ann', $nossid, 0) 
+                       || Filter::read_in('ann', 'user_default', 0) ;
 
        # clean up qra locators
        my $qra = $user->qra;
@@ -191,12 +203,23 @@ sub start
        my $info = Route::cluster();
        $self->send("Cluster:$info");
 
-       # send prompts and things
+       # send prompts for qth, name and things
        $self->send($self->msg('namee1')) if !$user->name;
        $self->send($self->msg('qthe1')) if !$user->qth;
        $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long);
        $self->send($self->msg('hnodee1')) if !$user->qth;
        $self->send($self->msg('m9')) if DXMsg::for_me($call);
+
+       # send out any buddy messages for other people that are online
+       foreach my $call (@{$user->buddies}) {
+               my $ref = Route::User::get($call);
+               if ($ref) {
+                       foreach my $node (@{$ref->parent}) {
+                               $self->send($self->msg($node eq $main::mycall ? 'loginb' : 'loginbn', $call, $node));
+                       } 
+               }
+       }
+
        $self->lastmsgpoll($main::systime);
        $self->prompt;
 }
@@ -563,7 +586,7 @@ sub disconnect
                
        # send info to all logged in thingies
        $self->tell_login('logoutu');
-       $self->tell_login('logoutb');
+       $self->tell_buddies('logoutb');
 
        LogDbg('DXCommand', "$call disconnected");
 
@@ -577,6 +600,9 @@ sub disconnect
 sub prompt
 {
        my $self = shift;
+
+       return if $self->{gtk};         # 'cos prompts are not a concept that applies here
+       
        my $call = $self->call;
        my $date = cldate($main::systime);
        my $time = ztime($main::systime);
@@ -774,6 +800,18 @@ sub find_cmd_name {
        return $package;
 }
 
+sub send
+{
+       my $self = shift;
+       if ($self->{gtk}) {
+               for (@_) {
+                       $self->SUPER::send(dd(['cmd',$_]));
+               }
+       } else {
+               $self->SUPER::send(@_);
+       }
+}
+
 sub local_send
 {
        my ($self, $let, $buf) = @_;
@@ -793,7 +831,13 @@ sub talk
 {
        my ($self, $from, $to, $via, $line) = @_;
        $line =~ s/\\5E/\^/g;
-       $self->local_send('T', "$to de $from: $line") if $self->{talk};
+       if ($self->{talk}) {
+               if ($self->{gtk}) {
+                       $self->local_send('T', dd(['talk',$to,$from,$via,$line,@_]));
+               } else {
+                       $self->local_send('T', "$to de $from: $line");
+               }
+       }
        Log('talk', $to, $from, $via?$via:$main::mycall, $line);
        # send a 'not here' message if required
        unless ($self->{here} && $from ne $to) {
@@ -835,9 +879,14 @@ sub announce
                return if $_[0] ne $main::myalias && $_[0] ne $main::mycall;
        }
        return if $target eq 'SYSOP' && $self->{priv} < 5;
-       my $buf = "$to$target de $_[0]: $text";
-       $buf =~ s/\%5E/^/g;
-       $buf .= "\a\a" if $self->{beep};
+       my $buf;
+       if ($self->{gtk}) {
+               $buf = dd(['ann', $to, $target, $text, @_])
+       } else {
+               $buf = "$to$target de $_[0]: $text";
+               $buf =~ s/\%5E/^/g;
+               $buf .= "\a\a" if $self->{beep};
+       }
        $self->local_send($target eq 'WX' ? 'W' : 'N', $buf);
 }
 
@@ -855,9 +904,14 @@ sub chat
        return unless grep uc $_ eq $target, @{$self->{user}->{group}};
        
        $text =~ s/^\#\d+ //;
-       my $buf = "$target de $_[0]: $text";
-       $buf =~ s/\%5E/^/g;
-       $buf .= "\a\a" if $self->{beep};
+       my $buf;
+       if ($self->{gtk}) {
+               $buf = dd(['chat', $to, $target, $text, @_])
+       } else {
+               $buf = "$target de $_[0]: $text";
+               $buf =~ s/\%5E/^/g;
+               $buf .= "\a\a" if $self->{beep};
+       }
        $self->local_send('C', $buf);
 }
 
@@ -912,6 +966,24 @@ sub dx_spot
        my $buf;
        if ($self->{ve7cc}) {
                $buf = VE7CC::dx_spot($self, @_);
+       } elsif ($self->{gtk}) {
+               my ($dxloc, $byloc);
+
+               my $ref = DXUser->get_current($_[4]);
+               if ($ref) {
+                       $byloc = $ref->qra;
+                       $byloc = substr($byloc, 0, 4) if $byloc;
+               }
+
+               my $spot = $_[1];
+               $spot =~ s|/\w{1,4}$||;
+               $ref = DXUser->get_current($spot);
+               if ($ref) {
+                       $dxloc = $ref->qra;
+                       $dxloc = substr($dxloc, 0, 4) if $dxloc;
+               }
+               $buf = dd(['dx', @_, ($dxloc||''), ($byloc||'')]);
+               
        } else {
                $buf = $self->format_dx_spot(@_);
                $buf .= "\a\a" if $self->{beep};
@@ -935,8 +1007,14 @@ sub wwv
                return unless $filter;
        }
 
-       my $buf = "WWV de $_[6] <$_[1]>:   SFI=$_[2], A=$_[3], K=$_[4], $_[5]";
-       $buf .= "\a\a" if $self->{beep};
+       my $buf;
+       if ($self->{gtk}) {
+               $buf = dd(['wwv', @_])
+       } else {
+               $buf = "WWV de $_[6] <$_[1]>:   SFI=$_[2], A=$_[3], K=$_[4], $_[5]";
+               $buf .= "\a\a" if $self->{beep};
+       }
+       
        $self->local_send('V', $buf);
 }
 
@@ -954,8 +1032,13 @@ sub wcy
                return unless $filter;
        }
 
-       my $buf = "WCY de $_[10] <$_[1]> : K=$_[4] expK=$_[5] A=$_[3] R=$_[6] SFI=$_[2] SA=$_[7] GMF=$_[8] Au=$_[9]";
-       $buf .= "\a\a" if $self->{beep};
+       my $buf;
+       if ($self->{gtk}) {
+               $buf = dd(['wcy', @_])
+       } else {
+               $buf = "WCY de $_[10] <$_[1]> : K=$_[4] expK=$_[5] A=$_[3] R=$_[6] SFI=$_[2] SA=$_[7] GMF=$_[8] Au=$_[9]";
+               $buf .= "\a\a" if $self->{beep};
+       }
        $self->local_send('Y', $buf);
 }
 
@@ -966,7 +1049,11 @@ sub broadcast_debug
        
        foreach my $dxchan (DXChannel::get_all) {
                next unless $dxchan->{enhanced} && $dxchan->{senddbg};
-               $dxchan->send_later('L', $s);
+               if ($dxchan->{gtk}) {
+                       $dxchan->local_send('L', dd(['db', $s]));
+               } else {
+                       $dxchan->local_send('L', $s);
+               }
        }
 }