From: djk Date: Mon, 28 Sep 1998 21:49:56 +0000 (+0000) Subject: started the addition of help files X-Git-Tag: SPIDER_1_5~36 X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=171a7a0bf86e9732a33c7829e808129ec01c51c2 started the addition of help files implemented a basic help function added a skeleton DXMsg.pm for message handling in and out --- diff --git a/cmd/announce.hlp b/cmd/announce.hlp new file mode 100644 index 00000000..e65b898f --- /dev/null +++ b/cmd/announce.hlp @@ -0,0 +1,9 @@ +=== 0^EN^ANNOUNCE^Send an announcement to the local cluster users + ANNOUNCE + + is the text of the announcement you wish to broadcast + +=== 0^EN^ANNOUNCE FULL^Send an announcement to all cluster users + ANNOUNCE FULL +=== 5^EN^ANNOUNCE SYSOP^Send an announcement to sysops + ANNOUNCE SYSOP diff --git a/cmd/announce.pl b/cmd/announce.pl index cb2e325d..1f2d24ab 100644 --- a/cmd/announce.pl +++ b/cmd/announce.pl @@ -38,7 +38,7 @@ if ($sort eq "FULL") { DXProt::broadcast_list("To $to de $from <$t>: $line", @locals); if ($to ne "LOCAL") { $line =~ s/\^//og; # remove ^ characters! - my $pc = DXProt::pc12($self, $line, $tonode, $sysopflag, 0); + my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 0); DXProt::broadcast_ak1a($pc); } diff --git a/cmd/bye.hlp b/cmd/bye.hlp new file mode 100644 index 00000000..1fe64326 --- /dev/null +++ b/cmd/bye.hlp @@ -0,0 +1,5 @@ +=== 0^EN^BYE^Exit from the cluster + BYE + + This will disconnect you from the cluster + diff --git a/cmd/dx.hlp b/cmd/dx.hlp new file mode 100644 index 00000000..22dbc676 --- /dev/null +++ b/cmd/dx.hlp @@ -0,0 +1,7 @@ +=== 0^EN^DX^Send a DX spot throughout the cluster + DX + or + DX + + Use the second form only if you wish to credit the spot to someone + else. diff --git a/cmd/dx.pl b/cmd/dx.pl index cbf003c0..a966ff6b 100644 --- a/cmd/dx.pl +++ b/cmd/dx.pl @@ -19,11 +19,11 @@ my @out; if ($f[0] =~ /[A-Za-z]/) { $spotter = uc $f[0]; $freq = $f[1]; - $spotted = $f[2]; - $line =~ s/^$f[0]\s+$freq\s+$spotted\s*//; + $spotted = uc $f[2]; + $line =~ s/^$f[0]\s+$f[1]\s+$f[2]\s*//; } else { $freq = $f[0]; - $spotted = $f[1]; + $spotted = uc $f[1]; $line =~ s/^$f[0]\s+$f[1]\s*//; } diff --git a/cmd/help.hlp b/cmd/help.hlp index e69de29b..23576f8c 100644 --- a/cmd/help.hlp +++ b/cmd/help.hlp @@ -0,0 +1,23 @@ +=== 0^EN^HELP^The HELP Command +HELP is available for a number of commands. The syntax is:- + + HELP + +Where is the name of the command you want help on. + +Commands for which help is available:- + +=== 0^EN^ANNOUNCE^make an announcement to the cluster +=== 0^EN^BYE^exit from the cluster +=== 9^EN^CREATE^Create various things +=== 9^EN^DELETE^Delete various things +=== 9^EN^DISCONNECT^Disconnect a user or node from the cluster +=== 0^EN^DX^send a DX spot to the cluster +=== 0^EN^SET^set various parameters +=== 0^EN^SHOW^show various parameters +=== 5^EN^SHUTDOWN^shutdown this node completely +=== 5^EN^STAT^show the status of various system related things +=== 0^EN^TALK^talk to another user of the cluster +=== 0^EN^UNSET^unset or reset various parameters +=== 0^EN^WWV^send a WWV spot +=== 0^EN^WX^send a weather announcement to the cluster diff --git a/cmd/help.pl b/cmd/help.pl index 60eef059..781edc32 100644 --- a/cmd/help.pl +++ b/cmd/help.pl @@ -14,6 +14,50 @@ my ($self, $line) = @_; my @out; +my ($path, $fcmd) = ($main::cmd, "help");; +my @out; +my @inpaths = ($main::localcmd, $main::cmd); +my @helpfiles; + +# this is naff but it will work for now +$line = "help" if !$line; +$fcmd = lc $line; + +# each help file starts with a line that looks like:- +# +# === 0^EN^HELP^Description +# text +# text +# text +# +# The fields are:- privilege level, Language, full command name, short description +# + +if (!open(H, "$path/$fcmd.hlp")) { + return (1, "no help on $line available"); +} +my $in; +my $include = 0; +my @in = ; +close(H); + +foreach $in (@in) { + next if $in =~ /^\s*\#/; + chomp $in; + if ($in =~ /^===/) { + $include = 0; + $in =~ s/=== //; + my ($priv, $lang, $cmd, $desc) = split /\^/, $in; + next if $priv > $self->priv; # ignore subcommands that are of no concern + next if $self->lang && $self->lang ne $lang; + push @out, "$cmd - $desc"; + $include = 1; + next; + } + push @out, $in if $include; +} +push @out, "No help available for $line" if @out == 0; +return (1, @out); diff --git a/cmd/show/dx.hlp b/cmd/show/dx.hlp new file mode 100644 index 00000000..deb06a71 --- /dev/null +++ b/cmd/show/dx.hlp @@ -0,0 +1,32 @@ +=== 0^EN^SHOW/DX^Interrogate the spot database + SHOW/DX + + If you just type SHOW/DX you will get the last so many spots + (sysop configurable, but usually 10). + + In addition you can add any number of these commands in very nearly + any order to the basic SHOW/DX command, they are:- + + on - eg 160m 20m 2m 23cm 6mm + on - eg hf vhf uhf shf + + - the number of spots you want + - - spot no spot no in the selected list + + - for a spotted callsign beginning with + * - for a spotted callsign ending in + ** - for a spotted callsign containing + + day - starting days ago + day - - days days ago + + info - any spots containing in the info or remarks + + spotter - any spots spotted by + + e.g. + + SH/DX 9m0 + SH/DX on 20m info iota + SH/DX 9a on vhf day 30 + See also SHOW/DXCC diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl index 74b4c0a9..fe2bf636 100644 --- a/cmd/show/dx.pl +++ b/cmd/show/dx.pl @@ -20,7 +20,7 @@ my $info; my $expr; while ($f = shift @list) { # next field - print "f: $f list: ", join(',', @list), "\n"; +# 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; @@ -30,28 +30,28 @@ while ($f = shift @list) { # next field next if $to; } if (lc $f eq 'on' && $list[0]) { # is it freq range? - print "yup freq\n"; +# print "yup freq\n"; my @r = split '/', $list[0]; - print "r0: $r[0] r1: $r[1]\n"; +# print "r0: $r[0] r1: $r[1]\n"; @freq = Bands::get_freq($r[0], $r[1]); if (@freq) { # yup, get rid of extranous param - print "freq: ", join(',', @freq), "\n"; +# print "freq: ", join(',', @freq), "\n"; shift @list; next; } } if (lc $f eq 'day' && $list[0]) { - print "got day\n"; +# print "got day\n"; ($fromday, $today) = split '-', shift(@list); next; } if (lc $f eq 'info' && $list[0]) { - print "got info\n"; +# print "got info\n"; $info = shift @list; next; } if (lc $f eq 'spotter' && $list[0]) { - print "got spotter\n"; +# print "got spotter\n"; $spotter = uc shift @list; next; } @@ -100,7 +100,7 @@ if ($spotter) { $expr .= "\$f4 =~ /$spotter/o"; } -print "expr: $expr from: $from to: $to fromday: $fromday today: $today\n"; +#print "expr: $expr from: $from to: $to fromday: $fromday today: $today\n"; # now do the search my @res = Spot::search($expr, $fromday, $today, $from, $to); diff --git a/cmd/show/dxcc.hlp b/cmd/show/dxcc.hlp new file mode 100644 index 00000000..9cef8716 --- /dev/null +++ b/cmd/show/dxcc.hlp @@ -0,0 +1,28 @@ +=== 0^EN^SHOW/DXCC^Interrogate the spot database by country + SHOW/DXCC + + This command takes the (which can be a full or partial + callsign if desired), looks up which internal country number it is + and then displays all the spots as per SH/DX for that country. + + In addition you can add any number of these commands in very nearly + any order to the basic SHOW/DXCC command, they are:- + + on - eg 160m 20m 2m 23cm 6mm + on - eg hf vhf uhf shf + + - the number of spots you want + - - spot no spot no in the selected list + + day - starting days ago + day - - days days ago + + info - any spots containing in the info or remarks + + spotter - any spots spotted by + + e.g. + + SH/DX G + SH/DX W on 20m info iota + See also SHOW/DXCC diff --git a/cmd/show/prefix.hlp b/cmd/show/prefix.hlp new file mode 100644 index 00000000..942073a3 --- /dev/null +++ b/cmd/show/prefix.hlp @@ -0,0 +1,7 @@ +=== 0^EN^SHOW/PREFIX^Interrogate the spot database by country + SHOW/PREFIX or + + This command takes the (which can be a full or partial + callsign if desired), looks up which internal country number it is + and then displays all the relevant prefixes for that country + together with the internal country no, the CQ and ITU regions. diff --git a/cmd/talk.pl b/cmd/talk.pl index 953d5f2d..21adc556 100644 --- a/cmd/talk.pl +++ b/cmd/talk.pl @@ -24,7 +24,7 @@ if ($dxchan && $dxchan->is_user) { $dxchan->send("$to de $from $line"); } else { $line =~ s/\^//og; # remove any ^ characters - my $prot = DXProt::pc10($self, $to, $via, $line); + my $prot = DXProt::pc10($from, $to, $via, $line); DXProt::route($via?$via:$to, $prot); } diff --git a/cmd/wx.pl b/cmd/wx.pl index ad9f0d47..ecc15401 100644 --- a/cmd/wx.pl +++ b/cmd/wx.pl @@ -39,7 +39,7 @@ if ($sort eq "FULL") { DXProt::broadcast_list("WX de $from <$t>: $line", @locals); if ($to ne "LOCAL") { $line =~ s/\^//og; # remove ^ characters! - my $pc = DXProt::pc12($self, $line, $tonode, $sysopflag, 1); + my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 1); DXProt::broadcast_ak1a($pc); } diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 970832d5..5a9ca3b2 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -57,6 +57,7 @@ use vars qw(%channels %valid); confmode => '0,In Conference?,yesno', dx => '0,DX Spots,yesno', redirect => '0,Redirect messages to', + lang => '0,Language', ); # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)] diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 3f2eda8e..3269073a 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -216,10 +216,11 @@ sub del sub update_users { my $self = shift; - if (%{$self->{list}}) { - $self->{users} = scalar %{$self->{list}}; + my $count = shift; + if ((keys %{$self->{list}})) { + $self->{users} = (keys %{$self->{list}}); } else { - $self->{users} = shift; + $self->{users} = $count; } } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index ddfefc6e..b51d9c4c 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -53,6 +53,7 @@ sub start $self->msg('pr', $call); $self->state('prompt'); # a bit of room for further expansion, passwords etc $self->{priv} = $user->priv; + $self->{lang} = $user->lang; $self->{priv} = 0 if $line =~ /^(ax|te)/; # set the connection priv to 0 - can be upgraded later $self->{consort} = $line; # save the connection type @@ -217,7 +218,7 @@ sub search my ($apath, $acmd) = split ',', $cmd_cache{$short_cmd}; if ($apath && $acmd) { dbg('command', "cached $short_cmd = ($apath, $acmd)\n"); - return ($apath, $acmd) if $apath; + return ($apath, $acmd); } # if not guess @@ -226,6 +227,7 @@ sub search my $curdir = $path; my $p; my $i; + my @lparts; for ($i = 0; $i < @parts; $i++) { my $p = $parts[$i]; @@ -242,14 +244,16 @@ sub search $curdir .= "/$l"; last; } - } else { # we are dealing with commands - next if !$l =~ /\.$suffix$/; # only look for .$suffix files + } else { # we are dealing with commands + @lparts = split /\./, $l; + next if $lparts[$#lparts] ne $suffix; # only look for .$suffix files if ($p eq substr($l, 0, length $p)) { - $l =~ s/\.$suffix$//; # remove the suffix - chop $dirfn; # remove trailing / - $cmd_cache{"$short_cmd"} = join(',', ($path, "$dirfn/$l")); # cache it - dbg('command', "got path: $path cmd: $dirfn/$l\n"); - return ($path, "$dirfn/$l"); + pop @lparts; # remove the suffix + $l = join '.', @lparts; +# chop $dirfn; # remove trailing / + $cmd_cache{"$short_cmd"} = join(',', ($path, "$dirfn$l")); # cache it + dbg('command', "got path: $path cmd: $dirfn$l\n"); + return ($path, "$dirfn$l"); } } } diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm new file mode 100644 index 00000000..e69de29b diff --git a/perl/DXProtVars.pm b/perl/DXProtVars.pm index 9f04f668..dcd51d61 100644 --- a/perl/DXProtVars.pm +++ b/perl/DXProtVars.pm @@ -28,7 +28,7 @@ $def_hopcount = 15; # some variable hop counts based on message type %hopcount = ( - 11 => 1, + 11 => 10, 16 => 10, 17 => 10, 19 => 10, diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 7857daa2..4f2e8dea 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -22,13 +22,12 @@ use strict; # All the PCxx generation routines # -# create a talk string (called $self->pc10(...) +# create a talk string ($from, $to, $via, $text) sub pc10 { - my ($self, $to, $via, $text) = @_; + my ($from, $to, $via, $text) = @_; my $user2 = $via ? $to : ' '; my $user1 = $via ? $via : $to; - my $from = $self->call(); $text = unpad($text); $text = ' ' if !$text; return "PC10^$from^$user1^$text^*^$user2^$main::mycall^~"; @@ -47,13 +46,13 @@ sub pc11 # create an announce message sub pc12 { - my ($self, $text, $tonode, $sysop, $wx) = @_; + my ($call, $text, $tonode, $sysop, $wx) = @_; my $hops = get_hops(12); $sysop = ' ' if !$sysop; $text = ' ' if !$text; $wx = '0' if !$wx; $tonode = '*' if !$tonode; - return "PC12^$self->{call}^$tonode^$text^$sysop^$main::mycall^$wx^$hops^~"; + return "PC12^$call^$tonode^$text^$sysop^$main::mycall^$wx^$hops^~"; } # diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 08c5824a..f2273a7a 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -43,7 +43,8 @@ $filename = undef; lockout => '9,Locked out?,yesno', # won't let them in at all dxok => '9,DX Spots?,yesno', # accept his dx spots? annok => '9,Announces?,yesno', # accept his announces? - reg => '0,Registered?,yesno', # is this user registered? + reg => '0,Registered?,yesno', # is this user registered? + lang => '0,Language', ); no strict;