]> dxcluster.org Git - spider.git/commitdiff
added chat stuff for fun
authorminima <minima>
Sat, 8 Mar 2003 02:16:29 +0000 (02:16 +0000)
committerminima <minima>
Sat, 8 Mar 2003 02:16:29 +0000 (02:16 +0000)
13 files changed:
Changes
cmd/chat.pl [new file with mode: 0644]
cmd/join.pl [new file with mode: 0644]
cmd/leave.pl [new file with mode: 0644]
cmd/show/chat.pl [new file with mode: 0644]
perl/AnnTalk.pm
perl/DXCommandmode.pm
perl/DXLogPrint.pm
perl/DXProt.pm
perl/DXUser.pm
perl/Messages
perl/Spot.pm
perl/create_localqsl.pl

diff --git a/Changes b/Changes
index 214a84d0a37cd70ffd2b6d7ff92c75252f862862..61142d67b8019bfa4af24f99c0f6cd24326c28b4 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,7 @@
+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=======================================================================
diff --git a/cmd/chat.pl b/cmd/chat.pl
new file mode 100644 (file)
index 0000000..4062358
--- /dev/null
@@ -0,0 +1,43 @@
+#
+# 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, ());
diff --git a/cmd/join.pl b/cmd/join.pl
new file mode 100644 (file)
index 0000000..9b46926
--- /dev/null
@@ -0,0 +1,24 @@
+#
+# 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);
diff --git a/cmd/leave.pl b/cmd/leave.pl
new file mode 100644 (file)
index 0000000..f02add5
--- /dev/null
@@ -0,0 +1,24 @@
+#
+# 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);
diff --git a/cmd/show/chat.pl b/cmd/show/chat.pl
new file mode 100644 (file)
index 0000000..3105c36
--- /dev/null
@@ -0,0 +1,38 @@
+#
+# 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);
index 30f8964c4aee36ae463effa203b2c9a9dd935cd0..0b564064ee15989bbc2c1af12571ccd790357082 100644 (file)
@@ -47,16 +47,17 @@ $main::branch += $BRANCH;
 # 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
index 1750fee157acd6e87d497ec539642a6b08530893..65d5eb0392d4699fa63672f1de400a46900f0f11 100644 (file)
@@ -802,6 +802,26 @@ sub announce
        $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
 {
index a01f5dedca68f663d55f07dc69465aff42746c77..752e72acd64aaa5470d0d3cae4cb619041d0ed4a 100644 (file)
@@ -46,7 +46,7 @@ sub print
        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;
@@ -115,8 +115,9 @@ sub print_item
        } 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] ||= "";
index 7769729b59b3966f0933b1102c52b61380653e0f..5ddafa5ef6d9ce17730e94dc0ae092d07532a005 100644 (file)
@@ -44,7 +44,7 @@ $main::branch += $BRANCH;
 
 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);
 
@@ -70,12 +70,13 @@ $eph_info_restime = 60*60;
 $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) ],                                        # 
@@ -604,6 +605,8 @@ sub handle_12
                return;
        }
 
+       my $dxchan;
+       
        if ($_[2] eq '*' || $_[2] eq $main::mycall) {
 
 
@@ -614,7 +617,7 @@ sub handle_12
                        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;
                                }
@@ -623,6 +626,8 @@ sub handle_12
        
                # 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);
        }
@@ -1769,6 +1774,72 @@ sub send_announce
        }
 }
 
+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;
@@ -1786,6 +1857,11 @@ sub announce
        send_prot_line($self, $filter, $hops, $isolate, $line) unless $_[1] eq $main::mycall;
 }
 
+sub chat
+{
+       goto &announce;
+}
+
 
 sub send_local_config
 {
index 5e44a11f9e0b3d3fb884392cc3fe4e30c32e4f39..e62123bfc1ef1a8235bb3c942b93f501db367f38 100644 (file)
@@ -61,7 +61,7 @@ $v3 = 0;
                  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',
index 250340bf946c4a6adea46a8cb485c6b4a2132d2a..df00b3f689840ccd732b402b0270c00bd5a5bdb8 100644 (file)
@@ -91,6 +91,8 @@ package DXM;
                                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',
@@ -132,11 +134,13 @@ package DXM;
                                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)',
index f59ef4f4965bca34c5b747d30c0c9b03390bfc5e..dc63dbff42c1c2ab1309d843107e10ce6bbff4ae 100644 (file)
@@ -26,7 +26,7 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0))
 $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;
index 66634f255c2f17f56e5e2763e63d16042fa3166b..e3f447f0c64e1ce341ad0723aa305a3695e27f98 100755 (executable)
@@ -97,15 +97,11 @@ sub update
        
        # 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?
@@ -113,8 +109,8 @@ sub update
                @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);
 }