From: minima Date: Tue, 25 Mar 2003 18:36:37 +0000 (+0000) Subject: fix chat X-Git-Tag: PRE-1-52~8 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=e07645cec07ba739a20cc009d7dd138c962b66eb;p=spider.git fix chat make QSL.pm better --- 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^^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';