add set/buddy.
authorminima <minima>
Mon, 6 Mar 2006 09:09:36 +0000 (09:09 +0000)
committerminima <minima>
Mon, 6 Mar 2006 09:09:36 +0000 (09:09 +0000)
add set/local_node.
fix warning for empty version in PC19.

17 files changed:
Changes
cmd/Aliases
cmd/Commands_en.hlp
cmd/join.pl
cmd/set/buddy.pl [new file with mode: 0644]
cmd/set/local_node.pl [new file with mode: 0644]
cmd/show/buddy.pl [new file with mode: 0644]
cmd/show/configuration.pl
cmd/show/users.pl
cmd/unset/buddy.pl [new file with mode: 0644]
cmd/unset/local_node.pl [new file with mode: 0644]
perl/Console.pm
perl/DXChannel.pm
perl/DXCommandmode.pm
perl/DXProt.pm
perl/DXUser.pm
perl/Messages

diff --git a/Changes b/Changes
index 3f03bac1b5cd49249ce77c52106c9733b87b74c1..4a738599c01041fdcda4d4c3d46d8f7a86304d12 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+06Mar06=======================================================================
+1. Fix warning on empty PC19s.
+2. Add new command set/local_node to allow people to see logins/outs on other
+related nodes.
+3. Add new command set/buddy to allow people to see when their favorite 
+chum(s) logins/out.
 14Feb06=======================================================================
 1. Turn R and SFI around in mrtg.pl.
 13Feb06=======================================================================
index 462fcc53245a8805654f7c2b6679ea5126e4b55c..25b87e40652134fdb503fd44a70fb62744a53153 100644 (file)
@@ -114,7 +114,7 @@ package CmdAlias;
       '^set/user', 'unset/node', 'unset/node',
        '^set$', 'apropos set', 'apropos',
          '^sho?w?/u$', 'show/user', 'show/user',
-         '^sho?w?/bu', 'show/files bulletins', 'show/files',
+         '^sho?w?/bul', 'show/files bulletins', 'show/files',
          '^sho?w?/co?n?\w*/a', 'show/configuration all', 'show/configuration',
          '^sho?w?/co?n?\w*/n', 'show/configuration nodes', 'show/configuration',
          '^sho?w?/c$', 'show/configuration', 'show/configuration',
index 342630a45d31931a3e7460fbe0a4e41ca65a19c8..b1fdb80e26a3ef82e1abd801d7b2ce7da62cdcee 100644 (file)
@@ -1454,6 +1454,12 @@ will allow text with this word again.
 
 === 5^SET/BBS <call> [<call>..]^Make the callsign a BBS
 
+=== 0^SET/BUDDY <call> [<call>..]^Add this call to my buddy list
+=== 0^UNSET/BUDDY <call> [<call>..]^Remove this call from my buddy list
+A notification message 
+is sent to you automatically if anybody on your buddy list logs in or
+out of any node in this cluster.
+
 === 5^SET/CLX <call> [<call>..]^Make the callsign an CLX node
 
 === 9^SET/DEBUG <name>^Add a debug level to the debug set
@@ -1577,6 +1583,21 @@ You can select the language that you want the cluster to use. Currently
 the languages available are en (English), de (German), es (Spanish),
 Czech (cz), French (fr), Portuguese (pt), Italian (it) and nl (Dutch).
 
+=== 5^SET/LOCAL_NODE^Add node to the local_node group
+=== 5^UNSET/LOCAL_NODE^Remove node from the local_node group
+The 'local_node' group is a group of nodes that you want a user
+to perceive as effectively one big node. At the moment, this extends 
+only to announcing whenever a user is logging in or out of one of
+the nodes in the group (if those users have SET/LOGININFO). 
+
+The local node group is as setup on this node. If you want the other
+nodes to also include this node and all the other nodes specified, then
+you must get those nodes to also run this command (or rcmd them to do
+so).
+
+In principle, therefore, each node determines its own local node group
+and these can overlap with other nodes' views.
+
 === 0^SET/LOCATION <lat & long>^Set your latitude and longitude
 === 9^SET/SYS_LOCATION <lat & long>^Set your cluster latitude and longitude
 In order to get accurate headings and such like you must tell the system
@@ -1833,6 +1854,9 @@ for more information.
 Display all the bad words in the system, see SET/BADWORD
 for more information.
 
+=== 0^SHOW/BUDDY^Show your list of buddies
+See SET/BUDDY for more information about buddies.
+
 === 0^SHOW/CHAT [<group>] [<lines>]^Show any chat or conferencing 
 This command allows you to see any chat or conferencing that has  
 occurred whilst you were away. SHOW/CHAT on its own will show data for
index 9b46926691fc2daedd14a012c6708ac2d5616ef2..69f220bfdf6cf086b58d100bbb0ad920ba7e52f2 100644 (file)
@@ -1,5 +1,5 @@
 #
-# join a group
+# join a group (note this applies only to users)
 #
 # Copyright (c) 2003 - Dirk Koopman G1TLH
 #
diff --git a/cmd/set/buddy.pl b/cmd/set/buddy.pl
new file mode 100644 (file)
index 0000000..2d99ef5
--- /dev/null
@@ -0,0 +1,25 @@
+#
+# add a buddy 
+#
+# Copyright (c) 2006 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, uc $line;
+my $group;
+my @out;
+
+my $buddies = $self->user->buddies || [];
+
+foreach my $call (@args) {
+       push(@out, $self->msg('e22', $call)), next unless is_callsign($call);
+       next if $call eq $self->call;
+       push @$buddies, $call unless grep $_ eq $call, @$buddies; 
+       push @out, $self->msg('buddya', $call);
+}
+
+$self->user->put;
+
+return (1, @out);
diff --git a/cmd/set/local_node.pl b/cmd/set/local_node.pl
new file mode 100644 (file)
index 0000000..0e97328
--- /dev/null
@@ -0,0 +1,27 @@
+#
+# add these nodes to the 'local_node' group
+#
+# Copyright (c) 2006 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, uc $line;
+my @out;
+
+return (1, $self->msg('e5')) unless $self->priv >= 5;
+
+foreach my $call (@args) {
+       my $user = DXUser->get_current($call);
+       push(@out, $self->msg('e3', 'set/localnode', $call)), next unless $user; 
+       push(@out, $self->msg('e13', $call)), next unless $user->is_node; 
+       my $group = $user->group || [];
+       push @$group, 'local_node' unless grep $_ eq 'local_node', @$group;
+       my $dxchan = DXChannel::get($call);
+       $dxchan->group($group) if $dxchan;
+       push @out, $self->msg('lgset', $call);
+       $user->put;
+}
+
+return (1, @out);
diff --git a/cmd/show/buddy.pl b/cmd/show/buddy.pl
new file mode 100644 (file)
index 0000000..0f5b7a6
--- /dev/null
@@ -0,0 +1,23 @@
+#
+# show your buddies 
+#
+# Copyright (c) 2006 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self) = @_;
+my $buddies = $self->user->buddies || [];
+my @out;
+my @l;
+
+foreach my $call (@$buddies) {
+       if (@l >= 5) {
+               push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
+               @l = ();
+       }
+       push @l, $call;
+}
+push @l, "" while @l < 5;
+push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
+return (1, @out);
index 3386a1716e5a65404ce7398a0d59378a6e712dd9..fe8acf9678c4027224ba65e7456570e97a31588f 100644 (file)
@@ -27,21 +27,18 @@ if ($list[0] && $list[0] =~ /^NOD/) {
                $call = "($call)" unless $dxchan->here;
                push @l, $call;
                
-               my $i = 0;
                foreach my $ref (@val) {
-                       if ($i >= 5) {
+                       if (@l >= 5) {
                                push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l;
                                @l = ();
                                push @l, "";
-                               $i = 0;
                        }
                        my $s = $ref->call;
                        $s ||= '???';
                        $s = sprintf "(%s)", $s unless $ref->here;
                        push @l, $s;
-                       $i++;
                }
-               push @l, "" while ($i++ < 5);
+               push @l, "" while @l < 5;
                push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l;
        }
 } else {
@@ -65,16 +62,14 @@ if ($list[0] && $list[0] =~ /^NOD/) {
                push @l, $call;
                @val = sort $node->users;
 
-               my $i = 0;
                if (@val == 0 && $node->usercount) {
                        push @l, sprintf "(%d users)", $node->usercount;
                }
                foreach $call (@val) {
-                       if ($i >= 5) {
+                       if (@l >= 5) {
                                push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l;
                                @l = ();
                                push @l, "";
-                               $i = 0;
                        }
                        my $uref = Route::User::get($call);
                        my $s = $call;
@@ -84,9 +79,8 @@ if ($list[0] && $list[0] =~ /^NOD/) {
                                $s = "$call?";
                        }
                        push @l, $s;
-                       $i++;
                }
-               push @l, "" while ($i++ < 5);
+               push @l, "" while @l < 5;
                push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l;
        }
 }
index a3fb3cc26ee510aeae8879bacd99a52f34d7c258..c9df4d6943a785545c1a66a6902f3c1c21f89003 100644 (file)
@@ -30,14 +30,12 @@ if (@list) {
        my $node = $main::routeroot;
        push @out, join(' ', $self->msg('userconn'), $main::mycall);
        my $call;
-       my $i = 0;
        my @l;
        my @val = sort $node->users;
        foreach $call (@val) {
-               if ($i >= 5) {
+               if (@l >= 5) {
                        push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
                        @l = ();
-                       $i = 0;
                }
                my $uref = Route::User::get($call);
                my $s = $call;
@@ -47,9 +45,8 @@ if (@list) {
                        $s = "$call?";
                }
                push @l, $s;
-               $i++;
        }
-       push @l, "" while $i++ < 5;
+       push @l, "" while @l < 5;
        push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
 }
 
diff --git a/cmd/unset/buddy.pl b/cmd/unset/buddy.pl
new file mode 100644 (file)
index 0000000..bfea54d
--- /dev/null
@@ -0,0 +1,26 @@
+#
+# remove a buddy from the list
+#
+# Copyright (c) 2006 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, uc $line;
+my $buddies;
+my @out;
+
+my @buddies = @{$self->user->buddies};
+
+foreach my $call (@args) {
+       push(@out, $self->msg('e22', $call)), next unless is_callsign($call);
+       next if $call eq $self->call;
+       @buddies = grep $_ ne $call, @buddies; 
+       push @out, $self->msg('buddyu', $call);
+}
+
+$self->user->buddies(\@buddies);
+$self->user->put;
+
+return (1, @out);
diff --git a/cmd/unset/local_node.pl b/cmd/unset/local_node.pl
new file mode 100644 (file)
index 0000000..dd08b52
--- /dev/null
@@ -0,0 +1,28 @@
+#
+# remove these nodes from the 'local_node' group
+#
+# Copyright (c) 2006 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, uc $line;
+my @out;
+
+return (1, $self->msg('e5')) unless $self->priv >= 5;
+
+foreach my $call (@args) {
+       my $user = DXUser->get_current($call);
+       push(@out, $self->msg('e3', 'set/localnode', $call)), next unless $user; 
+       push(@out, $self->msg('e13', $call)), next unless $user->is_node; 
+       my $group = $user->group || [];
+       my @new = grep {$_ ne 'local_node'} @$group;
+       $user->group(\@new);
+       my $dxchan = DXChannel::get($call);
+       $dxchan->group(\@new) if $dxchan;
+       push @out, $self->msg('lgunset', $call);
+       $user->put;
+}
+
+return (1, @out);
index 9812a024442b21cc7b5fc934bbdd2c2694988fce..22b463c6e9d141fe87124469b30a5c41e4a84eb1 100644 (file)
@@ -46,7 +46,7 @@ if ($ENV{'TERM'} =~ /(xterm|ansi)/) {
                   [ '^[-A-Z0-9]+ de [-A-Z0-9]+ \d\d-\w\w\w-\d\d\d\d \d\d\d\dZ', COLOR_PAIR(0) ],
                   [ '^[-A-Z0-9]+ de [-A-Z0-9]+ ', COLOR_PAIR(6) ],
                   [ '^WX', COLOR_PAIR(3) ],
-                  [ '^(User|Node)\b', COLOR_PAIR(8) ],
+                  [ '^(User|Node|Buddy)\b', COLOR_PAIR(8) ],
                   [ '^New mail', A_BOLD|COLOR_PAIR(5) ],
                    
                   );
index b0208f103e0e6093df5b654c133420e110780419..9812037fce2ee1fa44255555fe6e63c09957c0d3 100644 (file)
@@ -153,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;
        }
@@ -493,7 +494,28 @@ 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();
+       my $dxchan;
+       foreach $dxchan (@dxchan) {
+               next if $dxchan == $self;
+               next if $dxchan->{call} eq $main::mycall;
+               $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) = @_;
+       
+       $call ||= $self->{call};
        
        # send info to all logged in thingies
        my @dxchan = get_all_users();
@@ -501,7 +523,7 @@ 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 grep $_ eq $call, @{$dxchan->user->buddies} ;
        }
 }
 
index ecd65716f71da86fac4f27df28b7af0d7f3ae5b6..3a94fb6a2629c82cb282ea6de174a2868c809ca7 100644 (file)
@@ -173,6 +173,7 @@ sub start
        }
        
        $self->tell_login('loginu');
+       $self->tell_buddies('loginb');
        
        # do we need to send a forward/opernam?
        my $lastoper = $user->lastoper || 0;
@@ -562,6 +563,7 @@ sub disconnect
                
        # send info to all logged in thingies
        $self->tell_login('logoutu');
+       $self->tell_login('logoutb');
 
        LogDbg('DXCommand', "$call disconnected");
 
index 5c6ca1fb928abd18426cce68525fedbcb3e20cf6..76b9d25d4dee47029d20211d82f1664adca88e94 100644 (file)
@@ -845,9 +845,12 @@ sub handle_16
                        push @rout, $parent->add_user($call, $flags);
                }
                
+               # send info to all logged in thingies
+               $self->tell_login('loginu', $call) if DXUser->get_current($ncall)->is_local_node;
+               $self->tell_buddies('loginb', $call);
                                
                # add this station to the user database, if required
-               $call =~ s/-\d+$//o;    # remove ssid for users
+#              $call =~ s/-\d+$//o;    # remove ssid for users
                my $user = DXUser->get_current($call);
                $user = DXUser->new($call) if !$user;
                $user->homenode($parent->call) if !$user->homenode;
@@ -916,6 +919,10 @@ sub handle_17
                $parent = Route->new($ncall);  # throw away
        }
 
+       # send info to all logged in thingies
+       $self->tell_login('logoutu', $ucall) if DXUser->get_current($ncall)->is_local_node;
+       $self->tell_buddies('logoutb', $ucall);
+
        if (eph_dup($line)) {
                dbg("PCPROT: dup PC17 detected") if isdbg('chanerr');
                return;
@@ -1014,6 +1021,7 @@ sub handle_19
                                
                # check for sane parameters
                #                               $ver = 5000 if $ver eq '0000';
+               next unless $ver && $ver =~ /^\d+$/;
                next if $ver < 5000;    # only works with version 5 software
                next if length $call < 3; # min 3 letter callsigns
                next if $call eq $main::mycall;
index 6ca9b91e5af7aff42fb73c28b08d220429194f11..413d56a6446c6678b779498498ef4bfd56146ef9 100644 (file)
@@ -61,7 +61,8 @@ $v3 = 0;
                  annok => '9,Accept Announces?,yesno', # accept his announces?
                  lang => '0,Language',
                  hmsgno => '0,Highest Msgno',
-                 group => '0,Chat Group,parray',       # used to create a group of users/nodes for some purpose or other
+                 group => '0,Group,parray',    # used to create a group of users/nodes for some purpose or other
+                 buddies => '0,Buddies,parray',
                  isolate => '9,Isolate network,yesno',
                  wantbeep => '0,Req Beep,yesno',
                  wantann => '0,Req Announce,yesno',
@@ -585,6 +586,13 @@ sub new_group
        $self->{group} = [ 'local' ];
 }
 
+# set up empty buddies (only happens for them's that connect direct)
+sub new_buddies
+{
+       my $self = shift;
+       $self->{buddies} = [  ];
+}
+
 #
 # return a prompt for a field
 #
@@ -725,6 +733,12 @@ sub is_node
        return $self->{sort} =~ /[ACRSX]/;
 }
 
+sub is_local_node
+{
+       my $self = shift;
+       return grep $_ eq 'local_node', @{$self->{group}};
+}
+
 sub is_user
 {
        my $self = shift;
index a61c41dfc018d71329a74f9a162b981a6a0752be..d66e66c1ef3a2f6ce267477f7b565da002e719ff 100644 (file)
@@ -26,6 +26,8 @@ package DXM;
                                beepon => 'Beeps are now on',
                                believes => 'Believe node $_[0] via $_[1]',
                                believeu => 'Don\'t believe node $_[0] via $_[1]', 
+                               buddya => '$_[0] has been added to your buddies',
+                               buddyu => '$_[0] has been removed from your buddies',
                                call1 => 'Callsign lookup via $_[0]:',
                                conother => 'Sorry $_[0] you are connected to me on another port',
                                concluster => 'Sorry $_[0] you are already connected elsewhere on the cluster (on $_[1])',
@@ -152,6 +154,8 @@ package DXM;
                                lange2 => 'failed to set language on $_[0]', 
                                lastconn => 'Last connect',
                                leave => 'leaving group $_[0]',
+                               lgset => 'Added $_[0] to the local node group',
+                               lgunset => 'Removed $_[0] from the local node group',
                                lh1 => '$main::data/hop_table.pl doesn\'t exist',
                                local1 => 'Local',
                                loce1 => 'Please enter your location,, set/location <latitude longitude>',
@@ -163,6 +167,8 @@ package DXM;
                                lockoutc => '$_[0] Created and Locked out',
                                lockoutun => '$_[0] Unlocked',
                                lockoutuse => 'usage: sh/lockout <call>|ALL',
+                               loginb => 'Buddy $_[0] has logged in',
+                               logoutb => 'Buddy $_[0] has logged out',
                                loginu => 'User $_[0] has logged in',
                                logoutu => 'User $_[0] has logged out',
                                loginn => 'Node $_[0] has logged in',