Change buddy message.

[spider.git] / perl / DXCommandmode.pm

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 04a1b2866e850daf066562cc469456f2f5a7fc4d..7500d17de8bce5ed5ad51e00218350ce50463cfe 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -9,10 +9,11 @@
 
 package DXCommandmode;
 
-use POSIX;
+#use POSIX;
 
 @ISA = qw(DXChannel);
 
+use POSIX qw(:math_h);
 use DXUtil;
 use DXChannel;
 use DXUser;
@@ -35,6 +36,7 @@ use Net::Telnet;
 use QSL;
 use DB_File;
 use VE7CC;
+use DXXml;
 
 use strict;
 use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug
@@ -93,7 +95,7 @@ sub start
        my $host = $self->{conn}->{peerhost};
        $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport};
        $host ||= "unknown";
-       Log('DXCommand', "$call connected from $host");
+       LogDbg('DXCommand', "$call connected from $host");
 
        $self->{name} = $name ? $name : $call;
        $self->send($self->msg('l2',$self->{name}));
@@ -149,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;
@@ -172,6 +185,7 @@ sub start
        }
        
        $self->tell_login('loginu');
+       $self->tell_buddies('loginb');
        
        # do we need to send a forward/opernam?
        my $lastoper = $user->lastoper || 0;
@@ -189,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;
 }
@@ -297,7 +322,7 @@ sub normal
                                        my @bad;
                                        if (@bad = BadWords::check($l)) {
                                                $self->badcount(($self->badcount||0) + @bad);
-                                               Log('DXCommand', "$self->{call} swore: $l");
+                                               LogDbg('DXCommand', "$self->{call} swore: $l with words:" . join(',', @bad) . ")");
                                        } else {
                                                for (@{$self->{talklist}}) {
                                                        $self->send_talks($_, $l);
@@ -311,7 +336,7 @@ sub normal
                        my @bad;
                        if (@bad = BadWords::check($cmdline)) {
                                $self->badcount(($self->badcount||0) + @bad);
-                               Log('DXCommand', "$self->{call} swore: $cmdline");
+                               LogDbg('DXCommand', "$self->{call} swore: $cmdline with words:" . join(',', @bad) . ")");
                        } else {
                                for (@{$self->{talklist}}) {
                                        $self->send_talks($_, $rawline);
@@ -343,7 +368,7 @@ sub normal
 
        # check for excessive swearing
        if ($self->{badcount} && $self->{badcount} >= $maxbadcount) {
-               Log('DXCommand', "$self->{call} logged out for excessive swearing");
+               LogDbg('DXCommand', "$self->{call} logged out for excessive swearing");
                $self->disconnect;
                return;
        }
@@ -561,8 +586,9 @@ sub disconnect
                
        # send info to all logged in thingies
        $self->tell_login('logoutu');
+       $self->tell_buddies('logoutb');
 
-       Log('DXCommand', "$call disconnected");
+       LogDbg('DXCommand', "$call disconnected");
 
        $self->SUPER::disconnect;
 }
@@ -1026,8 +1052,7 @@ sub import_cmd
        # are there any to do in this directory?
        return unless -d $cmdimportdir;
        unless (opendir(DIR, $cmdimportdir)) {
-               dbg("can\'t open $cmdimportdir $!");
-               Log('err', "can\'t open $cmdimportdir $!");
+               LogDbg('err', "can\'t open $cmdimportdir $!");
                return;
        } 
 
@@ -1039,9 +1064,7 @@ sub import_cmd
 
                my $s = Script->new($name, $cmdimportdir);
                if ($s) {
-
-                       dbg("Run import cmd file $name");
-                       Log('DXCommand', "Run import cmd file $name");
+                       LogDbg('DXCommand', "Run import cmd file $name");
                        my @cat = split /[^A-Za-z0-9]+/, $name;
                        my ($call) = grep {is_callsign(uc $_)} @cat;
                        $call ||= $main::mycall;
@@ -1072,19 +1095,16 @@ sub import_cmd
                                                $dxchan->{priv} = $priv;
                                                $dxchan->{user} = $user;
                                        } else {
-                                               Log('err', "Trying to run import cmd for non-existant user $call");
-                                               dbg( "Trying to run import cmd for non-existant user $call");
+                                               LogDbg('err', "Trying to run import cmd for non-existant user $call");
                                        }
                                }
                        }
                        $s->erase;
                        for (@out) {
-                               Log('DXCommand', "Import cmd $name/$call: $_");
-                               dbg("Import cmd $name/$call: $_");
+                               LogDbg('DXCommand', "Import cmd $name/$call: $_");
                        }
                } else {
-                       Log("Failed to open $cmdimportdir/$name $!");
-                       dbg("Failed to open $cmdimportdir/$name $!");
+                       LogDbg('err', "Failed to open $cmdimportdir/$name $!");
                        unlink "$cmdimportdir/$name";
                }
        }