From e07645cec07ba739a20cc009d7dd138c962b66eb Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Tue, 25 Mar 2003 18:36:37 +0000
Subject: [PATCH 1/1] fix chat make QSL.pm better

---
 Changes               |  6 ++++++
 cmd/chat.pl           |  4 ++--
 perl/DXCommandmode.pm |  6 +++---
 perl/DXProt.pm        | 10 ++++++----
 perl/DXUtil.pm        |  8 +++++++-
 perl/QSL.pm           |  2 +-
 6 files changed, 25 insertions(+), 11 deletions(-)

diff --git a/Changes b/Changes
index f2de3ed0..04705508 100644
--- 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 545c7c78..a6321f5f 100644
--- 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 270183bf..42c80b53 100644
--- 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 adf112b0..deda8f45 100644
--- 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 c633413e..705e5cc6 100644
--- 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 4d3bd115..d7dc8b2c 100644
--- 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';
-- 
2.43.0