1. Added talk mode so that I don't have to keep typing T <call> all the time.
authorminima <minima>
Sun, 30 Jul 2000 11:16:12 +0000 (11:16 +0000)
committerminima <minima>
Sun, 30 Jul 2000 11:16:12 +0000 (11:16 +0000)
2. fiddled around with storing of Debug messages a bit more.
3. bomb proofed the type command.
4. started the objectifying for talk, dx and announcements.

12 files changed:
Changes
cmd/Commands_en.hlp
cmd/talk.pl
cmd/type.pl
perl/AnnTalk.pm
perl/DXChannel.pm
perl/DXCommandmode.pm
perl/DXDebug.pm
perl/DXProt.pm
perl/DXProtout.pm
perl/Messages
perl/client.pl

diff --git a/Changes b/Changes
index d35eb5a5ffc1e876840dc584d11a169e1cb59459..441d9623f1d5a2cc614ed24bf1f3be908ebe0480 100644 (file)
--- a/Changes
+++ b/Changes
@@ -6,6 +6,9 @@ count of 1.
 sequentially reading the data directly and only 'get'ting the ones that are
 nodes.
 3. did the same for show/isolate and show/lockout.
+4. Added talk mode so that I don't have to keep typing T <call> all the time.
+5. fiddled around with storing of Debug messages a bit more.
+6. bomb proofed the type command.
 28Jul00=======================================================================
 1. fixed watchdbg midnight rollover loop and removed the date part of the 
 date/time translation to leave just the time.
index 5ef9126f57e131ee20cf97b78f7fd753c46f64f4..47645f9e508cd158da5de6c6e067d28338943c0b 100644 (file)
@@ -911,8 +911,8 @@ They will all match. If there is no password you will still be offered
 numbers but nothing will happen when you input a string. Any match is
 case sensitive.
 
-=== 0^TALK <call> <text>^Send a text message to another station
-=== 0^TALK <call> > <node> <text>^Send a text message to another station via a node
+=== 0^TALK <call> [<text>]^Send a text message to another station
+=== 0^TALK <call> > <node> [<text>]^Send a text message to another station via a node
 Send a short message to any other station that is visible on the cluster
 system. You can send it to anyone you can see with a SHOW/CONFIGURATION 
 command, they don't have to be connected locally.
@@ -925,6 +925,25 @@ If you know that G3JNB is likely to be present on GB7TLH, but you can only
 see GB7TLH in the SH/C list but with no users, then you would use the
 second form of the talk message.
 
+If you want to have a ragchew with someone you can leave the text message
+out and the system will go into 'Talk' mode. What this means is that a
+short message is sent to the recipient telling them that you are in a
+'Talking' frame of mind and then you just type - everything you send will
+go to the station that you asked for. 
+
+All the usual announcements, spots and so on will still come out on your
+terminal.
+
+If you want to do something (such as send a spot) you preceed the normal 
+command with a '/' character, eg:-
+
+   /DX 14001 G1TLH What's a B class licensee doing on 20m CW?
+   /HELP talk
+
+To leave talk mode type:
+   
+   /EX
+
 === 0^TYPE <filearea>/<name>^Look at the contents of a file in one of the fileareas
 Type out the contents of a file in a filearea. So, for example, in 
 filearea 'bulletins' you want to look at file 'arld051' you would 
index fa7ade223f94594e0a476c7bb859601ae14800d9..9cdd1c58bde99deeca39e9a488dd3194e24b9345 100644 (file)
@@ -6,51 +6,54 @@
 # $Id$
 #
 
-my ($self, $line) = @_;
-my @argv = split /\s+/, $line; # generate an argv
-my $to = uc $argv[0];
+my ($self, $inline) = @_;
+my $to;
 my $via;
-my $from = $self->call();
+my $line;
+my $from = $self->call;
 my @out;
 
-# have we a callsign and some text?
-return (1, $self->msg('e8')) if @argv < 2;
+# analyse the line there are four situations...
+# 1) talk call
+# 2) talk call <text>
+# 3) talk call>node 
+# 4) talk call>node text
+#
 
-if ($argv[1] eq '>') {
-       $via = uc $argv[2];
-       $line =~ s/^$argv[0]\s+>\s+$argv[2]\s*//;
+($to, $via, $line) = $inline =~ /^\s*([A-Za-z0-9\-]+)\s*>([A-Za-z0-9\-]+)(.*)$/;
+if ($via) {
+       $line =~ s/\s+// if $line;
 } else {
-       $line =~ s/^$argv[0]\s*//;
+       ($to, $line) = split /\s+/, $inline, 2;  
 }
 
+$to = uc $to if $to;
+$via = uc $via if $via;
 my $call = $via ? $via : $to;
-my $ref = DXCluster->get_exact($call);     # try an exact call
-$ref = DXCluster->get($call) unless $ref;  # try one ignoring SSID
-$ref = DXChannel->get($call) unless $ref;  # is it local?
-
-# if we haven't got an explicit via and we can't see them, try their node
-unless ($ref || $via) {
-       my $user = DXUser->get_current($call);
-       $ref = DXCluster->get_exact($user->node) if $user;
+my $clref = DXCluster->get_exact($call);     # try an exact call
+my $dxchan = $clref->dxchan if $clref;
+return (1, $self->msg('e7', $call)) unless $dxchan;
+
+# if there is a line send it, otherwise add this call to the talk list
+# and set talk mode for command mode
+if ($line) {
+       $dxchan->talk($self->call, $to, $via, $line) if $dxchan;
+} else {
+       my $s = "$to>" . $dxchan->call;
+       my $ref = $self->talklist;
        if ($ref) {
-               $via = $user->node;
-               push @out, "trying via $via..";
+               unless (grep { $_ eq $s } @$ref) {
+                       $dxchan->talk($self->call, $to, $via, $self->msg('talkstart'));
+                       $self->state('talk');
+                       push @$ref, $s;
+               }
+       } else { 
+               $self->talklist([ $s ]);
+               $dxchan->talk($self->call, $to, $via, $self->msg('talkstart'));
+               push @out, $self->msg('talkinst');
+               $self->state('talk');
        }
-}
-return (1, "$call not visible on the cluster") if !$ref;
-
-# change ^ into : for transmission
-$line =~ s/\^/:/og;
-
-my $dxchan = DXCommandmode->get($to); # is it for us?
-if ($dxchan && $dxchan->is_user) {
-       $dxchan->send("$to de $from $line") if $dxchan->talk;
-       Log('talk', $to, $from, $main::mycall, $line);
-} else {
-       $line =~ s/\^//og;                      # remove any ^ characters
-       my $prot = DXProt::pc10($from, $to, $via, $line);
-       DXProt::route(undef,$via?$via:$to, $prot);
-       Log('talk', $to, $from, $via?$via:$main::mycall, $line);
+       push @out, $self->talk_prompt;
 }
 
 return (1, @out);
index e525f94e57529785363fbcd9a2f014106686ad1e..df289e693edc1aaa80866bd4f65bfc4b96dad5f9 100644 (file)
@@ -16,9 +16,8 @@ my @slot;
 
 if (@f) {
        my $fn = lc $f[0];
-       $fn =~ s/\\/\//og;
-       $fn =~ s/\.//og;
-       $fn =~ s/^\///og;
+       $fn =~ s([^A-Za-z0-9_/])()g;
+       $fn =~ s(^/+)();
        $root = "$root/$fn";
 }
 
index faa644a302c99c3c204df7d2f834ca2a61ee74ef..5bd44fd49e3104de3bcdec7a4bf9904147b0c433 100644 (file)
@@ -53,5 +53,6 @@ sub listdups
        return @out;
 }
 
+
 1; 
 
index 2758e64dd3a1f8c54fd65998fbee065ee2f6a51a..8b71dbff499d7946a83378b2938f6c54f6ea41c4 100644 (file)
@@ -86,6 +86,7 @@ use vars qw(%channels %valid);
                  pingtime => '5,Ping totaltime,parray',
                  pingave => '0,Ping ave time',
                  logininfo => '9,Login info req,yesno',
+                 talklist => '0,Talk List,parray',
                 );
 
 # object destruction
@@ -361,7 +362,7 @@ sub state
                dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n");
 
                # if there is any queued up broadcasts then splurge them out here
-               if ($self->{delayed} && ($self->{state} eq 'prompt' || $self->{state} eq 'convers')) {
+               if ($self->{delayed} && ($self->{state} eq 'prompt' || $self->{state} eq 'talk')) {
                        $self->send (@{$self->{delayed}});
                        delete $self->{delayed};
                }
index 60626ef41722ba1bb13bca65ceb6d60b09dfb906..ab82d904e9ba1eb5d1279f6303eaac4ae8869548 100644 (file)
@@ -177,30 +177,88 @@ sub normal
                }
                delete $self->{passwd};
                $self->state('prompt');
-       } else {
-               @ans = run_cmd($self, $cmdline);           # if length $cmdline;
-               
-               if ($self->{pagelth} && @ans > $self->{pagelth}) {
-                       my $i;
-                       for ($i = $self->{pagelth}; $i-- > 0; ) {
-                               my $line = shift @ans;
-                               $line =~ s/\s+$//o;     # why am having to do this? 
-                               $self->send($line);
+       } elsif ($self->{state} eq 'talk') {
+               if ($cmdline =~ m{^(?:/EX|/ABORT)}i) {
+                       for (@{$self->{talklist}}) {
+                               my $ent = $_;
+                               my ($to, $via) = $ent =~ /(\S+)>(\S+)/;
+                               my $dxchan = DXChannel->get($via);
+                               $dxchan->talk($self->{call}, $to, $via, $self->msg('talkend')) if $dxchan;
                        }
-                       $self->{pagedata} =  \@ans;
-                       $self->state('page');
-                       $self->send($self->msg('page', scalar @ans));
-               } else {
-                       for (@ans) {
-                               $self->send($_) if $_;
+                       $self->state('prompt');
+                       delete $self->{talklist};
+               } elsif ($cmdline =~ m(^/\w+)) {
+                       $cmdline =~ s(^/)();
+                       $self->send_ans(run_cmd($self, $cmdline));
+                       $self->send($self->talk_prompt);
+               } elsif ($self->{talklist} && @{$self->{talklist}}) {
+                       # send what has been said to whoever is in this person's talk list
+                       for (@{$self->{talklist}}) {
+                               my $ent = $_;
+                               my ($to, $via) = $ent =~ /(\S+)>(\S+)/;
+                               my $dxchan = DXChannel->get($via);
+                               if ($dxchan && DXCluster->get_exact($to)) {
+                                       $dxchan->talk($self->{call}, $to, $via, $cmdline);
+                               } else {
+                                       $self->send($self->msg('disc2', $via ? $via : $to));
+                                       my @l = grep { $_ ne $ent } @{$self->{talklist}};
+                                       if (@l) {
+                                               $self->{talklist} = \@l;
+                                       } else {
+                                               delete $self->{talklist};
+                                               $self->state('prompt');
+                                       }
+                               }
                        }
-               } 
+                       $self->send($self->talk_prompt) if $self->{state} eq 'talk';
+               } else {
+                       # for safety
+                       $self->state('prompt');
+               }
+       } else {
+               $self->send_ans(run_cmd($self, $cmdline));
        } 
        
        # send a prompt only if we are in a prompt state
        $self->prompt() if $self->{state} =~ /^prompt/o;
 }
 
+sub talk_prompt
+{
+       my $self = shift;
+       my @call;
+       for (@{$self->{talklist}}) {
+               my ($to, $via) = /(\S+)>(\S+)/;
+               push @call, $to;
+       }
+       return $self->msg('talkprompt', join(',', @call));
+}
+
+#
+# send a load of stuff to a command user with page prompting
+# and stuff
+#
+
+sub send_ans
+{
+       my $self = shift;
+       
+       if ($self->{pagelth} && @_ > $self->{pagelth}) {
+               my $i;
+               for ($i = $self->{pagelth}; $i-- > 0; ) {
+                       my $line = shift @_;
+                       $line =~ s/\s+$//o;     # why am having to do this? 
+                       $self->send($line);
+               }
+               $self->{pagedata} =  \@_;
+               $self->state('page');
+               $self->send($self->msg('page', scalar @_));
+       } else {
+               for (@_) {
+                       $self->send($_) if $_;
+               }
+       } 
+}
 # 
 # this is the thing that runs the command, it is done like this for the 
 # benefit of remote command execution
@@ -272,7 +330,7 @@ sub run_cmd
                                    };
                                        
                                        if ($@) {
-                                               cluck($@);
+                                               #cluck($@);
                                                return (DXDebug::shortmess($@));
                                        };
                                }
@@ -559,5 +617,26 @@ sub find_cmd_name {
        return $package;
 }
 
+# send a talk message here
+sub talk
+{
+       my ($self, $from, $to, $via, $line) = @_;
+       $line =~ s/\\5E/\^/g;
+       $self->send("$to de $from $line") if $self->{talk};
+       Log('talk', $to, $from, $main::mycall, $line);
+}
+
+# send an announce
+sub announce
+{
+
+}
+
+# send a dx spot
+sub dx_spot
+{
+       
+}
+
 1;
 __END__
index b42db66dfb4934dd9744b2f9c6fcd00f1b77e8be..a1c63407f71f1b2aba38c58782dbe77f0a73e63b 100644 (file)
@@ -18,7 +18,7 @@ use vars qw(%dbglevel $fp);
 
 use DXUtil;
 use DXLog ();
-use Carp;
+use Carp qw(cluck);
 
 %dbglevel = ();
 $fp = DXLog::new('debug', 'dat', 'd');
@@ -28,13 +28,13 @@ $fp = DXLog::new('debug', 'dat', 'd');
 if (!defined $DB::VERSION) {
        local $^W=0;
        eval qq( sub confess { 
-          \$SIG{__DIE__} = 'DEFAULT'; 
-          DXDebug::_store(Carp::longmess(\@_)); 
-          exit(-1); 
+           \$SIG{__DIE__} = 'DEFAULT'; 
+        DXDebug::_store(\$@, Carp::shortmess(\@_));
+           exit(-1); 
        }
-       sub confess { 
+       sub croak { 
                \$SIG{__DIE__} = 'DEFAULT'; 
-               DXDebug::_store(Carp::shortmess(\@_)); 
+        DXDebug::_store(\$@, Carp::longmess(\@_));
                exit(-1); 
        }
        sub carp    { DXDebug::_store(Carp::shortmess(\@_)); }
@@ -42,15 +42,23 @@ if (!defined $DB::VERSION) {
        );
 
     CORE::die(Carp::shortmess($@)) if $@;
-}
+} else {
+    eval qq( sub confess { Carp::confess(\@_); }; 
+       sub cluck { Carp::cluck(\@_); }; 
+   );
+} 
 
 
 sub _store
 {
        my $t = time; 
        for (@_) {
-               $fp->writeunix($t, "$t^$_"); 
-               print STDERR $_;
+               chomp;
+               my @l = split /\n/;
+               for (@l) {
+                       print "$_\n" if defined \*STDOUT;
+                       $fp->writeunix($t, "$t^$_"); 
+               }
        }
 }
 
@@ -58,8 +66,8 @@ sub dbginit
 {
        # add sig{__DIE__} handling
        if (!defined $DB::VERSION) {
-               $SIG{__WARN__} = sub { _store(Carp::shortmess(@_)); };
-               $SIG{__DIE__} = sub { _store(Carp::shortmess(@_)); };
+               $SIG{__WARN__} = sub { _store($@, Carp::shortmess(@_)); };
+               $SIG{__DIE__} = sub { _store($@, Carp::longmess(@_)); };
        }
 }
 
index a2f7734724f1e74da0994c8ca607b44be315e7e1..65ad93f930a1bcb164ea623c1fe4f15be8ed19a1 100644 (file)
@@ -996,7 +996,7 @@ sub send_dx_spot
                } elsif ($dxchan->is_user && $dxchan->{dx}) {
                        my $buf = Spot::formatb($dxchan->{user}->wantgrid, $_[0], $_[1], $_[2], $_[3], $_[4]);
                        $buf .= "\a\a" if $dxchan->{beep};
-                       if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') {
+                       if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
                                $dxchan->send($buf);
                        } else {
                                $dxchan->delay($buf);
@@ -1040,7 +1040,7 @@ sub send_wwv_spot
                } elsif ($dxchan->is_user && $dxchan->{wwv}) {
                        my $buf = "WWV de $_[6] <$_[1]>:   SFI=$_[2], A=$_[3], K=$_[4], $_[5]";
                        $buf .= "\a\a" if $dxchan->{beep};
-                       if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') {
+                       if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
                                $dxchan->send($buf);
                        } else {
                                $dxchan->delay($buf);
@@ -1083,7 +1083,7 @@ sub send_wcy_spot
                } elsif ($dxchan->is_user && $dxchan->{wcy}) {
                        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 $dxchan->{beep};
-                       if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') {
+                       if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
                                $dxchan->send($buf);
                        } else {
                                $dxchan->delay($buf);
@@ -1147,7 +1147,7 @@ sub send_announce
                        next if $target eq 'SYSOP' && $dxchan->{priv} < 5;
                        my $buf = "$to$target de $_[0]: $text";
                        $buf .= "\a\a" if $dxchan->{beep};
-                       if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') {
+                       if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
                                $dxchan->send($buf);
                        } else {
                                $dxchan->delay($buf);
@@ -1298,7 +1298,7 @@ sub broadcast_list
 
                $s =~ s/\a//og unless $dxchan->{beep};
 
-               if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') {
+               if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
                        $dxchan->send($s);      
                } else {
                        $dxchan->delay($s);
@@ -1408,5 +1408,17 @@ sub disconnect
 
        $self->SUPER::disconnect;
 }
+
+# 
+# send a talk message to this thingy
+#
+sub talk
+{
+       my ($self, $from, $to, $via, $line) = @_;
+       
+       $line =~ s/\^/\\5E/g;                   # remove any ^ characters
+       $self->send(DXProt::pc10($from, $to, $via, $line));
+       Log('talk', $self->call, $from, $via?$via:$main::mycall, $line);
+}
 1;
 __END__ 
index 3d3a46bc1c01a46bb1ae3561dafd3d2cc242c888..8cc5137f59684c096eb79f4e6c8132becf723023 100644 (file)
@@ -27,8 +27,16 @@ use strict;
 sub pc10
 {
        my ($from, $to, $via, $text) = @_;
-       my $user2 = $via ? $to : ' ';
-       my $user1 = $via ? $via : $to;
+       my ($user1, $user2);
+       if ($via && $via ne $to) {
+               $user1 = $via;
+               $user2 = $to;
+       } else {
+               $user2 = ' ';
+               $user1 = $to;
+       }
+#      my $user2 = $via ? $to : ' ';
+#      my $user1 = $via ? $via : $to;
        $text = unpad($text);
        $text = ' ' if !$text;
        return "PC10^$from^$user1^$text^*^$user2^$main::mycall^~";  
index 56fcb345f4ddffb0a45c5a8443fae5a12a9f4888..7918a6e13917c24c411d6659fd09dfbdf6d8b35b 100644 (file)
@@ -187,6 +187,10 @@ package DXM;
                                time3 => '$_[0]  $_[1]',
                                talks => 'Talk flag set on $_[0]',
                                talku => 'Talk flag unset on $_[0]',
+                               talkend => 'Finished talking to you',
+                               talkinst => 'Entering Talkmode, /EX to end, /<cmd> to run a command',
+                               talkprompt => 'Talk ($_[0])>',
+                               talkstart => 'Starting talking to you',
                                usernf => '*** User record for $_[0] not found ***',
                                wwvs => 'WWV flag set on $_[0]',
                                wwvu => 'WWV flag unset on $_[0]',
index 7a539cf2259202d8cf4bb3b4cb3ec01b60a50f08..740a9e7211d45bb27c4dfadf8cebe3f0243e0e7c 100755 (executable)
@@ -289,7 +289,7 @@ sub dochat
                                $line =~ s/\r/\n/g;
                                chomp;
                        }
-                       dbg('connect', "received \"$line\"");
+                       dbg('connect', map { "received \"$_\"" } split /\n/, $line);
                        if ($abort && $line =~ /$abort/i) {
                                dbg('connect', "aborted on /$abort/");
                                cease(11);