+08Mar03=======================================================================
+1. Added chat, join, leave commands to allow general purpose conferencing
+on arbitrary subjects. [Translators: added e34,e35,join,leave]. There is
+currently no help. There is also sh/chat.
28Feb03=======================================================================
1. Charlie K1XX fixed the sh/iso, sh/reg and sh/node commands
25Feb03=======================================================================
--- /dev/null
+#
+# do a chat message
+#
+# this is my version of conferencing....
+#
+# Copyright (c) 2003 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @f = split /\s+/, $line, 2;
+return (1, $self->msg('e5')) if $self->remotecmd;
+return (1, $self->msg('e34')) unless @f == 2;
+return (1, $self->msg('e28')) unless $self->registered;
+
+my $target = uc $f[0];
+
+return (1, $self->msg('e35', $target)) unless grep uc $_ eq $target, @{$self->user->group};
+
+my $from = $self->call;
+my $text = unpad $f[1];
+my $t = ztime(time);
+my $toflag = '*';
+
+# change ^ into : for transmission
+$line =~ s/\^/:/og;
+
+my @bad;
+if (@bad = BadWords::check($line)) {
+ $self->badcount(($self->badcount||0) + @bad);
+ Log('DXCommand', "$self->{call} swore: $line");
+ Log('chat', $target, $from, "[to $from only] $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^~
+my $msgid = DXProt::nextchatmsgid();
+$text = "#$msgid $text";
+
+DXProt::send_chat($self, DXProt::pc12($from, $text, $target), $from, $target, $text, ' ', $main::mycall, '0');
+
+return (1, ());
--- /dev/null
+#
+# join a group
+#
+# Copyright (c) 2003 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, uc $line;
+my $group;
+my @out;
+
+my @group = @{$self->user->group};
+
+foreach $group (@args) {
+ push @group, $group unless grep $_ eq $group, @group;
+ push @out, $self->msg('join', $group);
+}
+
+$self->user->group(\@group);
+$self->user->put;
+
+return (1, @out);
--- /dev/null
+#
+# leave a group
+#
+# Copyright (c) 2003 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, uc $line;
+my $group;
+my @out;
+
+my @group = @{$self->user->group};
+
+foreach $group (@args) {
+ @group = grep $_ ne $group, @group;
+ push @out, $self->msg('leave', $group);
+}
+
+$self->user->group(\@group);
+$self->user->put;
+
+return (1, @out);
--- /dev/null
+#
+# print out the general log file for chat only
+#
+# Copyright (c) 1998-2003 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my $self = shift;
+
+# this appears to be a reasonable thing for users to do (thank you JE1SGH)
+# return (1, $self->msg('e5')) if $self->priv < 9;
+
+my $cmdline = shift;
+my @f = split /\s+/, $cmdline;
+my $f;
+my @out;
+my ($from, $to, $who);
+
+$from = 0;
+while ($f = shift @f) { # next field
+ # print "f: $f list: ", join(',', @list), "\n";
+ if (!$from && !$to) {
+ ($from, $to) = $f =~ /^(\d+)-(\d+)$/o; # is it a from -> to count?
+ next if $from && $to > $from;
+ }
+ if (!$to) {
+ ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count?
+ next if $to;
+ }
+ next if $who;
+ ($who) = $f =~ /^(\w+)/o;
+}
+
+$to = 20 unless $to;
+$from = 0 unless $from;
+
+@out = DXLog::print($from, $to, $main::systime, 'chat', $who);
+return (1, @out);
# enter the spot for dup checking and return true if it is already a dup
sub dup
{
- my ($call, $to, $text) = @_;
+ my ($call, $to, $text, $t) = @_;
+ $t ||= $main::systime + $dupage;
chomp $text;
unpad($text);
$text =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
$text = substr($text, 0, $duplth) if length $text > $duplth;
$text = pack("C*", map {$_ & 127} unpack("C*", $text));
- $text =~ s/[^a-zA-Z0-9]//g;
+ $text =~ s/[^\#a-zA-Z0-9]//g;
my $dupkey = "A$to|\L$text";
- return DXDupe::check($dupkey, $main::systime + $dupage);
+ return DXDupe::check($dupkey, $t);
}
sub listdups
$self->local_send($target eq 'WX' ? 'W' : 'N', $buf);
}
+# send a chat
+sub chat
+{
+ my $self = shift;
+ my $line = shift;
+ my $isolate = shift;
+ my $to = shift;
+ my $target = shift;
+ my $text = shift;
+ my ($filter, $hops);
+
+ return unless grep uc $_ eq $target, @{$self->{user}->{group}};
+
+ $text =~ s/^\#\d+ //;
+ my $buf = "$target de $_[0]: $text";
+ $buf =~ s/\%5E/^/g;
+ $buf .= "\a\a" if $self->{beep};
+ $self->local_send('C', $buf);
+}
+
# send a dx spot
sub dx_spot
{
if ($pattern) {
$hint = "m{\\Q$pattern\\E}i";
} else {
- $hint = "!m{ann|rcmd|talk}";
+ $hint = "!m{ann|rcmd|talk|chat}";
}
if ($who) {
$hint .= ' && ' if $hint;
} elsif ($r->[1] eq 'talk') {
$r->[5] ||= "";
$s = "$r->[3] -> $r->[2] ($r->[4]) $r->[5]";
- } elsif ($r->[1] eq 'ann') {
+ } elsif ($r->[1] eq 'ann' || $r->[1] eq 'chat') {
$r->[4] ||= "";
+ $r->[4] =~ s/^\#\d+ //;
$s = "$r->[3] -> $r->[2] $r->[4]";
} else {
$r->[2] ||= "";
use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime
$last_hour $last10 %eph %pings %rcmds $ann_to_talk
- $pingint $obscount %pc19list
+ $pingint $obscount %pc19list $chatdupeage
%nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
$allowzero $decode_dk0wcy $send_opernam @checklist);
$eph_pc34_restime = 30;
$pingint = 5*60;
$obscount = 2;
+$chatdupeage = 20 * 60 * 60;
@checklist =
(
[ qw(c c m bp bc c) ], # pc10
[ qw(f m d t m c c h) ], # pc11
- [ qw(c bc m bp bm p h) ], # pc12
+ [ qw(c m m bp bm p h) ], # pc12
[ qw(c h) ], #
[ qw(c h) ], #
[ qw(c m h) ], #
return;
}
+ my $dxchan;
+
if ($_[2] eq '*' || $_[2] eq $main::mycall) {
if ($call) {
my $ref = Route::get($call);
if ($ref) {
- my $dxchan = $ref->dxchan;
+ $dxchan = $ref->dxchan;
$dxchan->talk($_[1], $call, undef, $_[3], $_[5]) if $dxchan != $self;
return;
}
# send it
$self->send_announce($line, @_[1..6]);
+ } elsif ((($dxchan = DXChannel->get($_[2])) && $dxchan->is_user) || !is_callsign($_[0])){
+ $self->send_chat($line, @_[1..6]);
} else {
$self->route($_[2], $line);
}
}
}
+my $msgid = 0;
+
+sub nextchatmsgid
+{
+ $msgid++;
+ $msgid = 1 if $msgid > 999;
+ return $msgid;
+}
+
+# send a chat line
+sub send_chat
+{
+ my $self = shift;
+ my $line = shift;
+ my @dxchan = DXChannel->get_all();
+ my $dxchan;
+ my $target = $_[1];
+ my $text = unpad($_[2]);
+
+ # obtain country codes etc
+ my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
+ my ($ann_state, $org_state) = ("", "");
+ my @dxcc = Prefix::extract($_[0]);
+ if (@dxcc > 0) {
+ $ann_dxcc = $dxcc[1]->dxcc;
+ $ann_itu = $dxcc[1]->itu;
+ $ann_cq = $dxcc[1]->cq;
+ $ann_state = $dxcc[1]->state;
+ }
+ @dxcc = Prefix::extract($_[4]);
+ if (@dxcc > 0) {
+ $org_dxcc = $dxcc[1]->dxcc;
+ $org_itu = $dxcc[1]->itu;
+ $org_cq = $dxcc[1]->cq;
+ $org_state = $dxcc[1]->state;
+ }
+
+ if ($self->{inannfilter}) {
+ my ($filter, $hops) =
+ $self->{inannfilter}->it(@_, $self->{call},
+ $ann_dxcc, $ann_itu, $ann_cq,
+ $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state);
+ unless ($filter) {
+ dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr');
+ return;
+ }
+ }
+
+ if (AnnTalk::dup($_[0], $_[1], $_[2], $chatdupeage)) {
+ dbg("PCPROT: Duplicate Announce ignored") if isdbg('chanerr');
+ return;
+ }
+
+
+ Log('chat', $target, $_[0], $text);
+
+ # 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 if $target eq 'LOCAL' && $dxchan->is_node;
+ $dxchan->chat($line, $self->{isolate}, ' ', $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
+ }
+}
+
sub announce
{
my $self = shift;
send_prot_line($self, $filter, $hops, $isolate, $line) unless $_[1] eq $main::mycall;
}
+sub chat
+{
+ goto &announce;
+}
+
sub send_local_config
{
annok => '9,Accept Announces?,yesno', # accept his announces?
lang => '0,Language',
hmsgno => '0,Highest Msgno',
- group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other
+ group => '0,Chat Group,parray', # used to create a group of users/nodes for some purpose or other
isolate => '9,Isolate network,yesno',
wantbeep => '0,Req Beep,yesno',
wantann => '0,Req Announce,yesno',
e31 => '$_[0] is not a user',
e32 => 'Need a passphrase',
e33 => '$_[0] is not a number of days or a valid date',
+ e34 => 'Need a GROUP and some text',
+ e35 => 'You are not a member of $_[0], join $_[0]',
echoon => 'Echoing enabled',
echooff => 'Echoing disabled',
isoari => 'there is an input route filter for $_[0]; clear/route input $_[0] first',
isoaro => 'there is an output route filter for $_[0]; clear/route $_[0] first',
isow => '$_[0] is isolated; unset/isolate $_[0] first',
+ join => 'joining group $_[0]',
l1 => 'Sorry $_[0], you are already logged on on another channel',
l2 => 'Hello $_[0], this is $main::mycall in $main::myqth\nrunning DXSpider V$main::version build $main::build',
lang => 'Language is now English',
lange1 => 'set/language <lang> where <lang> is one of ($_[0])',
lange2 => 'failed to set language on $_[0]',
+ leave => 'leaving group $_[0]',
lh1 => '$main::data/hop_table.pl doesn\'t exist',
loce1 => 'Please enter your location,, set/location <latitude longitude>',
loce2 => 'Don\'t recognise \"$_[0]\" as a Lat/Long (eg 52 20 N 0 16 E)',
$main::build += $VERSION;
$main::branch += $BRANCH;
-use vars qw($fp $statp $maxspots $defaultspots $maxdays $dirprefix $duplth $dupage $filterdef $totalspots $hfspots $vhfspots);
+use vars qw($fp $statp $maxspots $defaultspots $maxdays $dirprefix $duplth $dupage $filterdef $totalspots $hfspots $vhfspots );
$fp = undef;
$statp = undef;
# decode the lines
foreach my $l (@lines) {
- my ($date, $time, $oby, $ocom) = $l =~ /^(\s?\S+)\s+(\s?\S+)\s+by\s+(\S+):\s+(.*)$/;
+ my ($date, $time, $oby, $ocom) = $l =~ /^(\s?\S+)\s+(\s?\S+)\s+de\s+(\S+):\s+(.*)$/;
if ($date) {
my $ot = cltounix($date, $time);
push @in, [$ot, $oby, $ocom];
- } else {
- print "Cannot decode $call: $l\n";
- $DB::single = 1;
}
-
}
# is this newer than the earliest one?
@in = grep {$_->[1] ne $by} @in;
}
$comment =~ s/://g;
- unshift @in, [$t, $by, $comment] if grep is_callsign($_), split(/\s+/, $comment);
+ unshift @in, [$t, $by, $comment] if grep /^bur/i || is_callsign(uc $_), split(/\b/, $comment);
pop @in, if @in > 10;
- return join "\n", (map {(cldatetime($_->[0]) . " by $_->[1]: $_->[2]")} @in);
+ return join "\n", (map {(cldatetime($_->[0]) . " de $_->[1]: $_->[2]")} @in);
}
projects / spider.git / commitdiff