fix chat

make QSL.pm better

diff --git a/Changes b/Changes
index f2de3ed0999e586c1ec58d2d1825d8e59561781e..04705508be46171e51d69f76cda6462705dea2d6 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,11 @@
 18Mar03=======================================================================
 1. minor corrections to manuals (g0vgs)
+17Mar03=======================================================================
+1. changed the regex determining what is a callsign to be more comprehensive.
+I would suggest re-running create_qsl.pl and then restarting.
+2. Fix chat so that output appears to users again and PC sentence conforms
+to standard. Add kludge to remove rewritten chats if I see them.
+3. Only send chat PCs to spider or AK1A boxes
 12Mar03=======================================================================
 1. added HC and QRZ.com to possible QSL locations, if you want to pick up
 historical info (ie start again), run create_qsl.pl after update and restart

diff --git a/cmd/chat.pl b/cmd/chat.pl
index 545c7c78ef6fc2a3e404f3fbde282bf804d698bd..a6321f5fa66664c2db07cce19c25e9e2d82c0c12 100644 (file)
--- a/cmd/chat.pl
+++ b/cmd/chat.pl
@@ -34,10 +34,10 @@ if (@bad = BadWords::check($line)) {
        return (1, "$target de $from <$t>: $line");
 }
 
-#PC12^IZ4DYU^GROUP^PSE QSL INFO TO A71AW TNX IN ADV 73's^ ^IK5PWJ-6^0^H21^~
+#PC12^IZ4DYU^*^PSE QSL INFO TO A71AW TNX IN ADV 73's^<group>^IK5PWJ-6^0^H21^~
 my $msgid = DXProt::nextchatmsgid();
 $text = "#$msgid $text";
 
-DXProt::send_chat($self, DXProt::pc12($from, $text, '*', $target), $from, $target, $text, ' ', $main::mycall, '0');
+DXProt::send_chat($self, DXProt::pc12($from, $text, '*', $target), $from, '*', $text, $target, $main::mycall, '0');
 
 return (1, ());

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 270183bffd5058f7916aa19bc0c1a7d861243c24..42c80b533e63bc737c0d6e56caeedfbdf8590a45 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -810,15 +810,15 @@ sub chat
        my $self = shift;
        my $line = shift;
        my $isolate = shift;
-       my $to = shift;
        my $target = shift;
+       my $to = shift;
        my $text = shift;
        my ($filter, $hops);
 
-       return unless grep uc $_ eq $to, @{$self->{user}->{group}};
+       return unless grep uc $_ eq $target, @{$self->{user}->{group}};
        
        $text =~ s/^\#\d+ //;
-       my $buf = "$to de $_[0]: $text";
+       my $buf = "$target de $_[0]: $text";
        $buf =~ s/\%5E/^/g;
        $buf .= "\a\a" if $self->{beep};
        $self->local_send('C', $buf);

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index adf112b0884b86adaecd94f39cc01896926b94b9..deda8f45c2abdd8c5b8aaa6d5c69d39ab98d2bb4 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -1839,10 +1839,12 @@ sub send_chat
        # send it if it isn't the except list and isn't isolated and still has a hop count
        # taking into account filtering and so on
        foreach $dxchan (@dxchan) {
-               next if $dxchan == $main::me;
-               next if $dxchan == $self && $self->is_node;
-               next unless $dxchan->is_spider || $dxchan->is_ak1a;
-               next if $target eq 'LOCAL' && $dxchan->is_node;
+               if ($dxchan->is_node) {
+                       next if $dxchan == $main::me;
+                       next if $dxchan == $self;
+                       next unless $dxchan->is_spider || $dxchan->is_ak1a;
+                       next if $target eq 'LOCAL';
+               }
                
                $dxchan->chat($line, $self->{isolate}, $target, $_[1], $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
        }

diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index c633413e7bfa2a0fdef19fde66645dffcef91ce6..705e5cc6c6eb02bdae3acf8eb003889182645205 100644 (file)
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -341,7 +341,13 @@ sub unpad
 # check that a field only has callsign characters in it
 sub is_callsign
 {
-       return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]{1,2}\d+)[A-Z]{1,3}(?:-\d{1,2}|\/(?:[A-Z]{1,2}\d{0,2}|\d[A-Z]\d{0,2}))?$/;
+       return $_[0] =~ m!^(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+)        # basic prefix
+                       (?:/(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+))?  # / another one (possibly)
+                                          [A-Z]{1,3}                                 # callsign letters
+                                          (?:/(?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+))?  # / another prefix possibly
+                       (?:/[0-9A-Z]{1,2})?                        # /0-9A-Z+ possibly
+                                          (?:-\d{1,2})?                              # - nn possibly
+                                        $!x;
 }
 
 # check that a PC protocol field is valid text

diff --git a/perl/QSL.pm b/perl/QSL.pm
index 4d3bd1154fde0e8224cdcb1bd2806f390c781344..d7dc8b2c0fced88746f56db95bd98de9c994160c 100644 (file)
--- a/perl/QSL.pm
+++ b/perl/QSL.pm
@@ -80,7 +80,7 @@ sub update
                        $tok = $man if @pre && $pre[0] ne 'Q';
                } elsif ($man =~ /^BUR/) {
                        $tok = 'BUREAU';
-               } elsif ($man eq 'HC' || $man =~ /^HOM/) {
+               } elsif ($man eq 'HC' || $man =~ /^HOM/ || $man =~ /^DIR/) {
                        $tok = 'HOME CALL';
                } elsif ($man =~ /^QRZ/) {
                        $tok = 'QRZ.com';