From: minima Date: Tue, 24 Jul 2001 07:38:18 +0000 (+0000) Subject: 1. made ann,dx spots,wwv,wcy,wx more 'object oriented'. X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=c20912fa90a1c3dd97d437e08691b5dc043dd869;p=spider.git 1. made ann,dx spots,wwv,wcy,wx more 'object oriented'. 2. allow for 'enhanced clients' and tell them what sort of thing is being sent. 3. Allow debug info to be sent via interface to an enhanced client. --- diff --git a/Changes b/Changes index 3bf65f20..dadfdfad 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,12 @@ +23Jul01======================================================================= +1. made ann,dx spots,wwv,wcy,wx more 'object oriented'. +2. allow for 'enhanced clients' and tell them what sort of thing is being +sent. +3. Allow debug info to be sent via interface to an enhanced client. 21Jul01======================================================================= 1. started a gtkconsole program. It appears to sort of work. Requires Gtk- Perl-0.7007. +2. start doing some spot statistical stuff. 19Jul01======================================================================= 1. changes to Admin Manual to reflect route filtering. Some alterations to the help files (g0vgs) diff --git a/cmd/set/send_dbg.pl b/cmd/set/send_dbg.pl new file mode 100644 index 00000000..2fe8c6db --- /dev/null +++ b/cmd/set/send_dbg.pl @@ -0,0 +1,12 @@ +# +# send debug information to this connection +# +# Copyright (c) 2001 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +return (1, $self->msg('e5')) if $self->priv < 8; +$self->senddbg(1); +return (1, $self->msg('done')); diff --git a/cmd/unset/send_dbg.pl b/cmd/unset/send_dbg.pl new file mode 100644 index 00000000..6173644c --- /dev/null +++ b/cmd/unset/send_dbg.pl @@ -0,0 +1,12 @@ +# +# send debug information to this connection +# +# Copyright (c) 2001 - Dirk Koopman +# +# $Id$ +# + +my ($self, $line) = @_; +return (1, $self->msg('e5')) if $self->priv < 8; +$self->senddbg(0); +return (1, $self->msg('done')); diff --git a/gtkconsole/gtkconsole b/gtkconsole/gtkconsole index e67ff0c9..724f0fc5 100755 --- a/gtkconsole/gtkconsole +++ b/gtkconsole/gtkconsole @@ -49,6 +49,9 @@ die "You cannot connect as your cluster callsign ($main::mycall)\n" if $call eq my $sock = IO::Socket::INET->new(PeerAddr=>$main::clusteraddr, PeerPort=>$main::clusterport); die "Cannot connect to $main::clusteraddr/$main::clusterport ($!)\n" unless $sock; sendmsg('A', 'local'); +sendmsg('G', '2'); +sendmsg('I', 'set/page 500'); +sendmsg('I', 'set/nobeep'); # # start of GTK stuff @@ -177,6 +180,16 @@ sub handlemsg my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/; if ($sort eq 'D') { $toplist->insert($toplist->{font}, undef, undef, "$line\n"); + } elsif ($sort eq 'X') { + $toplist->insert($toplist->{font}, undef, undef, "$line\n"); + } elsif ($sort eq 'Y') { + $toplist->insert($toplist->{font}, undef, undef, "$line\n"); + } elsif ($sort eq 'V') { + $toplist->insert($toplist->{font}, undef, undef, "$line\n"); + } elsif ($sort eq 'N') { + $toplist->insert($toplist->{font}, undef, undef, "$line\n"); + } elsif ($sort eq 'W') { + $toplist->insert($toplist->{font}, undef, undef, "$line\n"); } elsif ($sort eq 'Z') { Gtk->exit(0); } diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index f1e711e0..be5feee3 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -99,6 +99,8 @@ $count = 0; dxcc => '0,Country Code', itu => '0,ITU Zone', cq => '0,CQ Zone', + enhanced => '5,Enhanced Client,yesno', + senddbg => '8,Sending Debug,yesno', ); # object destruction @@ -303,6 +305,29 @@ sub send_now $self->{t} = time; } +# +# send later with letter (more control) +# + +sub send_later +{ + my $self = shift; + my $conn = $self->{conn}; + return unless $conn; + my $sort = shift; + my $call = $self->{call}; + + for (@_) { +# chomp; + my @lines = split /\n/; + for (@lines) { + $conn->send_later("$sort$call|$_"); + dbg("-> $sort $call $_") if isdbg('chan'); + } + } + $self->{t} = time; +} + # # the normal output routine # diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index c1a461ff..eef342bc 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -267,7 +267,11 @@ sub send_ans $self->send($self->msg('page', scalar @_)); } else { for (@_) { - $self->send($_) if $_; + if (defined $_) { + $self->send($_); + } else { + $self->send(''); + } } } } @@ -406,6 +410,7 @@ sub disconnect { my $self = shift; my $call = $self->call; + delete $self->{senddbg}; my @rout = $main::routeroot->del_user($call); dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route'); @@ -439,15 +444,10 @@ sub broadcast { my $pkg = shift; # ignored my $s = shift; # the line to be rebroadcast - my @except = @_; # to all channels EXCEPT these (dxchannel refs) - my @list = DXChannel->get_all(); # just in case we are called from some funny object - my ($dxchan, $except); - L: foreach $dxchan (@list) { - next if !$dxchan->sort eq 'U'; # only interested in user channels - foreach $except (@except) { - next L if $except == $dxchan; # ignore channels in the 'except' list - } + foreach my $dxchan (DXChannel->get_all()) { + next unless $dxchan->{sort} eq 'U'; # only interested in user channels + next if grep $dxchan == $_, @_; $dxchan->send($s); # send it } } @@ -455,13 +455,7 @@ sub broadcast # gimme all the users sub get_all { - my @list = DXChannel->get_all(); - my $ref; - my @out; - foreach $ref (@list) { - push @out, $ref if $ref->sort eq 'U'; - } - return @out; + return grep {$_->{sort} eq 'U'} DXChannel->get_all(); } # run a script for this user @@ -636,12 +630,26 @@ sub find_cmd_name { return $package; } +sub local_send +{ + my ($self, $let, $buf) = @_; + if ($self->{state} eq 'prompt' || $self->{state} eq 'talk') { + if ($self->{enhanced}) { + $self->send_later($let, $buf); + } else { + $self->send($buf); + } + } else { + $self->delay($buf); + } +} + # send a talk message here sub talk { my ($self, $from, $to, $via, $line) = @_; $line =~ s/\\5E/\^/g; - $self->send("$to de $from: $line") if $self->{talk}; + $self->send_later('T', "$to de $from: $line") if $self->{talk}; Log('talk', $to, $from, $main::mycall, $line); # send a 'not here' message if required unless ($self->{here} && $from ne $to) { @@ -661,14 +669,99 @@ sub talk # send an announce sub announce { + my $self = shift; + my $line = shift; + my $isolate = shift; + my $to = shift; + my $target = shift; + my $text = shift; + my ($filter, $hops); + + if ($self->{annfilter}) { + ($filter, $hops) = $self->{annfilter}->it(@_ ); + return unless $filter; + } + unless ($self->{ann}) { + return if $_[0] ne $main::myalias && $_[0] ne $main::mycall; + } + return if $target eq 'SYSOP' && $self->{priv} < 5; + my $buf = "$to$target de $_[0]: $text"; + $buf =~ s/\%5E/^/g; + $buf .= "\a\a" if $self->{beep}; + $self->local_send($target eq 'WX' ? 'W' : 'N', $buf); } # send a dx spot sub dx_spot { + my $self = shift; + my $line = shift; + my $isolate = shift; + my ($filter, $hops); + + return unless $self->{dx}; + if ($self->{spotsfilter}) { + ($filter, $hops) = $self->{spotsfilter}->it(@_ ); + return unless $filter; + } + + my $buf = Spot::formatb($self->{user}->wantgrid, $_[0], $_[1], $_[2], $_[3], $_[4]); + $buf .= "\a\a" if $self->{beep}; + $buf =~ s/\%5E/^/g; + $self->local_send('X', $buf); } +sub wwv +{ + my $self = shift; + my $line = shift; + my $isolate = shift; + my ($filter, $hops); + + return unless $self->{wwv}; + + if ($self->{wwvfilter}) { + ($filter, $hops) = $self->{wwvfilter}->it(@_ ); + return unless $filter; + } + + my $buf = "WWV de $_[6] <$_[1]>: SFI=$_[2], A=$_[3], K=$_[4], $_[5]"; + $buf .= "\a\a" if $self->{beep}; + $self->local_send('V', $buf); +} + +sub wcy +{ + my $self = shift; + my $line = shift; + my $isolate = shift; + my ($filter, $hops); + + return unless $self->{wcy}; + + if ($self->{wcyfilter}) { + ($filter, $hops) = $self->{wcyfilter}->it(@_ ); + return unless $filter; + } + + my $buf = "WCY de $_[10] <$_[1]> : K=$_[4] expK=$_[5] A=$_[3] R=$_[6] SFI=$_[2] SA=$_[7] GMF=$_[8] Au=$_[9]"; + $buf .= "\a\a" if $self->{beep}; + $self->local_send('Y', $buf); +} + +# broadcast debug stuff to all interested parties +sub broadcast_debug +{ + my $s = shift; # the line to be rebroadcast + + foreach my $dxchan (DXChannel->get_all) { + next unless $dxchan->{enhanced} && $dxchan->{senddbg}; + $dxchan->send_later('L', $s); + } +} + + 1; __END__ diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 4b8d4f25..14f8dbd2 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -14,7 +14,7 @@ require Exporter; @EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck); use strict; -use vars qw(%dbglevel $fp); +use vars qw(%dbglevel $fp $callback); use DXUtil; use DXLog (); @@ -22,6 +22,7 @@ use Carp (); %dbglevel = (); $fp = undef; +$callback = undef; # Avoid generating "subroutine redefined" warnings with the following # hack (from CGI::Carp): @@ -64,13 +65,17 @@ sub dbg($) for (@l) { s/([\x00-\x08\x0B-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg; print "$_\n" if defined \*STDOUT; - $fp->writeunix($t, "$t^$_"); + my $str = "$t^$_"; + &$callback($str) if $callback; + $fp->writeunix($t, $str); } } } sub dbginit { + $callback = shift; + # add sig{__DIE__} handling if (!defined $DB::VERSION) { $SIG{__WARN__} = sub { diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 5f3890a0..966f0eef 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -1214,41 +1214,45 @@ sub send_dx_spot # taking into account filtering and so on foreach $dxchan (@dxchan) { next if $dxchan == $me; - my $routeit; - my ($filter, $hops); + next if $dxchan == $self; + $dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call}); + } +} - if ($dxchan->{spotsfilter}) { - ($filter, $hops) = $dxchan->{spotsfilter}->it(@_, $self->{call} ); - next unless $filter; - } - - if ($dxchan->is_node) { - next if $dxchan == $self; - if ($hops) { - $routeit = $line; - $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; - } else { - $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name - next unless $routeit; - } - if ($filter) { - $dxchan->send($routeit) if $routeit; - } else { - $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate}; - } - } elsif ($dxchan->is_user && $dxchan->{dx}) { - my $buf = Spot::formatb($dxchan->{user}->wantgrid, $_[0], $_[1], $_[2], $_[3], $_[4]); - $buf .= "\a\a" if $dxchan->{beep}; - $buf =~ s/\%5E/^/g; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { - $dxchan->send($buf); - } else { - $dxchan->delay($buf); - } - } +sub dx_spot +{ + my $self = shift; + my $line = shift; + my $isolate = shift; + my ($filter, $hops); + + if ($self->{spotsfilter}) { + ($filter, $hops) = $self->{spotsfilter}->it(@_); + return unless $filter; } + send_prot_line($self, $filter, $hops, $isolate, $line) } +sub send_prot_line +{ + my ($self, $filter, $hops, $isolate, $line) = @_; + my $routeit; + + if ($hops) { + $routeit = $line; + $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; + } else { + $routeit = adjust_hops($self, $line); # adjust its hop count by node name + next unless $routeit; + } + if ($filter) { + $self->send($routeit) if $routeit; + } else { + $self->send($routeit) unless $self->{isolate} || $isolate; + } +} + + sub send_wwv_spot { my $self = shift; @@ -1277,34 +1281,23 @@ sub send_wwv_spot my $routeit; my ($filter, $hops); - if ($dxchan->{wwvfilter}) { - ($filter, $hops) = $dxchan->{wwvfilter}->it(@_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq); - next unless $filter; - } - if ($dxchan->is_node) { - if ($hops) { - $routeit = $line; - $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; - } else { - $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name - next unless $routeit; - } - if ($filter) { - $dxchan->send($routeit) if $routeit; - } else { - $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate}; - - } - } elsif ($dxchan->is_user && $dxchan->{wwv}) { - my $buf = "WWV de $_[6] <$_[1]>: SFI=$_[2], A=$_[3], K=$_[4], $_[5]"; - $buf .= "\a\a" if $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { - $dxchan->send($buf); - } else { - $dxchan->delay($buf); - } - } + $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq); } + +} + +sub wwv +{ + my $self = shift; + my $line = shift; + my $isolate = shift; + my ($filter, $hops); + + if ($self->{wwvfilter}) { + ($filter, $hops) = $self->{wwvfilter}->it(@_); + return unless $filter; + } + send_prot_line($self, $filter, $hops, $isolate, $line) } sub send_wcy_spot @@ -1331,36 +1324,24 @@ sub send_wcy_spot # taking into account filtering and so on foreach $dxchan (@dxchan) { next if $dxchan == $me; - my $routeit; - my ($filter, $hops); + next if $dxchan == $self; - if ($dxchan->{wcyfilter}) { - ($filter, $hops) = $dxchan->{wcyfilter}->it(@_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq); - next unless $filter; - } - if ($dxchan->is_clx || $dxchan->is_spider || $dxchan->is_dxnet) { - if ($hops) { - $routeit = $line; - $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; - } else { - $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name - next unless $routeit; - } - if ($filter) { - $dxchan->send($routeit) if $routeit; - } else { - $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate}; - } - } elsif ($dxchan->is_user && $dxchan->{wcy}) { - my $buf = "WCY de $_[10] <$_[1]> : K=$_[4] expK=$_[5] A=$_[3] R=$_[6] SFI=$_[2] SA=$_[7] GMF=$_[8] Au=$_[9]"; - $buf .= "\a\a" if $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { - $dxchan->send($buf); - } else { - $dxchan->delay($buf); - } - } + $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq); + } +} + +sub wcy +{ + my $self = shift; + my $line = shift; + my $isolate = shift; + my ($filter, $hops); + + if ($self->{wcyfilter}) { + ($filter, $hops) = $self->{wcyfilter}->it(@_); + return unless $filter; } + send_prot_line($self, $filter, $hops, $isolate, $line) if $self->is_clx || $self->is_spider || $self->is_dxnet; } # send an announce @@ -1370,9 +1351,9 @@ sub send_announce my $line = shift; my @dxchan = DXChannel->get_all(); my $dxchan; - my $text = unpad($_[2]); my $target; my $to = 'To '; + my $text = unpad($_[2]); if ($_[3] eq '*') { # sysops $target = "SYSOP"; @@ -1412,41 +1393,27 @@ sub send_announce my $routeit; my ($filter, $hops); - if ($dxchan->{annfilter}) { - ($filter, $hops) = $dxchan->{annfilter}->it(@_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq); - next unless $filter; - } - if ($dxchan->is_node && $_[1] ne $main::mycall) { # i.e not specifically routed to me - if ($hops) { - $routeit = $line; - $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; - } else { - $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name - next unless $routeit; - } - if ($filter) { - $dxchan->send($routeit) if $routeit; - } else { - $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate}; - - } - } elsif ($dxchan->is_user) { - unless ($dxchan->{ann}) { - next if $_[0] ne $main::myalias && $_[0] ne $main::mycall; - } - next if $target eq 'SYSOP' && $dxchan->{priv} < 5; - my $buf = "$to$target de $_[0]: $text"; - $buf =~ s/\%5E/^/g; - $buf .= "\a\a" if $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { - $dxchan->send($buf); - } else { - $dxchan->delay($buf); - } - } + $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) + } +} + +sub announce +{ + my $self = shift; + my $line = shift; + my $isolate = shift; + my $to = shift; + my $target = shift; + my ($filter, $hops); + + if ($self->{annfilter}) { + ($filter, $hops) = $self->{annfilter}->it(@_); + return unless $filter; } + send_prot_line($self, $filter, $hops, $isolate, $line) unless $_[1] eq $main::mycall; } + sub send_local_config { my $self = shift; diff --git a/perl/cluster.pl b/perl/cluster.pl index 3a8bf619..572be7a9 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -284,6 +284,8 @@ sub process_inqueue $dxchan->disconnect; } elsif ($sort eq 'D') { ; # ignored (an echo) + } elsif ($sort eq 'G') { + $dxchan->enhanced($line); } else { print STDERR atime, " Unknown command letter ($sort) received from $call\n"; } @@ -315,7 +317,7 @@ $starttime = $systime = time; $lang = 'en' unless $lang; # open the debug file, set various FHs to be unbuffered -dbginit(); +dbginit(\&DXCommandmode::broadcast_debug); foreach (@debug) { dbgadd($_); }