+06Nov21=======================================================================
+1. Improve console.pl scrolling. Split long lines (eg on announcements.
+04Nov21=======================================================================
+1. Fix illogicalities in USDB creations and make sure that O_CREAT on tie does
+ NOT encounter an existing file to barf about. Even though it shouldn't.
+ Thanks Howard WB3FFV.
+2. Fixed a typo in show/registered that prevents a list of callsigns being
+ searched for. Got rid of some over complex code. Thnake Fabrizio iZ0UIN.
+3. Fix long line wrapping in console.pl
+03Nov21=======================================================================
+1. Move motd and issue files to local_data if not already there.
+30Nov21=======================================================================
+1. Fix sh/dx with callsigns that have /p or VE/G1TLH in them.
+2. Add unset/ak1a, unset/arcluster aliases and some minimal help for UNSET/
+ SPIDER, NODE, ARCLUSTER, AKIA and also SET/USER.
26Nov21=======================================================================
1. *Really* change spot display format and sh/dx format "back the way they
were. But They won't stay that way for long!!!! There are four (yes, count
'u' => [
'^uns?e?t?$', 'apropos unset', 'apropos',
'^uns?e?t?/dbg$', 'unset/debug', 'unset/debug',
+ '^uns?e?t?/arc', 'set/user', 'set/user',
+ '^uns?e?t?/spider$', 'set/user', 'set/user',
+ '^uns?e?t?/ak1a$', 'set/user', 'set/user',
'^uns?e?t?/node$', 'set/user', 'set/user',
'^uns?e?t?/sk', 'set/wantrbn none', 'set/wantrbn',
],
Tell the system that the call(s) are to be treated as DXSpider node and
fed new style DX Protocol rather normal user commands.
+=== 5^UNSET/SPIDER <call> [<call>..]^Make the callsign a normal user
+=== 5^UNSET/ARCLUSTER <call> [<call>..]^Make the callsign a normal user
+=== 5^UNSET/NODE <call> [<call>..]^Make the callsign a normal user
+=== 5^UNSET/AK1A <call> [<call>..]^Make the callsign a normal user
+=== 5^SET/USER <call> [<call>..]^Make the callsign a normal user
+
=== 0^SET/TALK^Allow TALK messages to come out on your terminal
=== 0^UNSET/TALK^Stop TALK messages coming out on your terminal
Log('DXCommand', $self->call . " attempted to register @args");
return (1, $self->msg('e5'));
}
-return (1, $self->msg('reginac')) unless $main::reqreg;
+#return (1, $self->msg('reginac')) unless $main::reqreg;
foreach $call (@args) {
$call = uc $call;
dbg("sh/dx list: " . join(" ", @list)) if isdbg('sh/dx');
+
+# $DB::single=1;
while (@list) { # next field
$f = shift @list;
if ($line) {
$line =~ s/[^\w\-\/]+//g;
- $line = "^\U\Q$line";
+ $line = "\U\Q$line";
}
if ($self->{_nospawn}) {
my $line = shift;
my @out;
my @val;
-
+
+# dbg("set/register line: $line");
+
+ my %call = ();
+ $call{$_} = 1 for split /\s+/, $line;
+ delete $call{'ALL'};
my ($action, $count, $key, $data) = (0,0,0,0);
- eval qq{for (\$action = DXUser::R_FIRST, \$count = 0; !\$DXUser::dbm->seq(\$key, \$data, \$action); \$action = DXUser::R_NEXT) {
- if (\$data =~ m{registered}) {
- if (!\$line || (\$line && \$key =~ /^$line/)) {
- my \$u = DXUser::get_current(\$key);
- if (\$u && \$u->registered) {
- push \@val, \$key;
- ++\$count;
+ unless (keys %call) {
+ for ($action = DXUser::R_FIRST, $count = 0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) {
+ if ($data =~ m{registered}) {
+ $call{$key} = 1; # possible candidate
}
}
}
-} };
+
+ foreach $key (sort keys %call) {
+ my $u = DXUser::get_current($key);
+ if ($u && defined (my $r = $u->registered)) {
+ push @val, "${key}($r)";
+ ++$count;
+ }
+ }
+
my @l;
foreach my $call (@val) {
if (@l >= 5) {
- push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
+ push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
@l = ();
}
push @l, $call;
}
if (@l) {
push @l, "" while @l < 5;
- push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
+ push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
}
- push @out, $@ if $@;
- push @out, , $self->msg('rec', $count);
+ push @out, $self->msg('rec', $count);
return @out;
}
Log('DXCommand', $self->call . " attempted to unregister @args");
return (1, $self->msg('e5'));
}
-return (1, $self->msg('reginac')) unless $main::reqreg;
+#return (1, $self->msg('reginac')) unless $main::reqreg;
foreach $call (@args) {
$call = uc $call;
timeout 15
-abort (Busy|Sorry|Fail)
-# don't forget to chmod 4775 netrom_call!
-connect ax25 /usr/sbin/netrom_call bbs gb7djk g1tlh-0
-'Connect' ''
-'Connect' 'ak1a'
-'Connect' ''
-client gb7tlh ax25
+connect telnet dirk7.int.tobit.co.uk 7300
+'ogin:' 'gb7tlh-1'
{
my $in = shift;
$in =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;
+ $in =~ s|\\/|/|g;
return '^' . $in . "\$";
}
# check the line for non legal characters
dbg("Filter::parse line: '$line'") if isdbg('filter');
- return ('ill', $dxchan->msg('e19')) if $line !~ /{.*}/ && $line =~ /[^\s\w,_\.:\-\*\/\(\)\$!]/;
+ my @ch = $line =~ m|([^\s\w,_\.:\/\-\*\(\)\$!])|g;
+ return ('ill', $dxchan->msg('e19', join(' ', @ch))) if $line !~ /{.*}/ && @ch;
$line = lc $line;
e16 => 'File \"$_[0]\" exists',
e17 => 'Please don\'t use the words: @_ on here',
e18 => 'Cannot connect to $_[0] ($!)',
- e19 => 'Invalid character in line',
+ e19 => 'Invalid character(s) in line $_[0]',
e20 => qq{token '$_[0]' not recognised},
e21 => '$_[0] is not numeric',
e22 => '$_[0] is not a callsign',
e16 => 'Le fichier \"$_[0]\" existe déjà',
e17 => 'Prière de ne pas utiliser les mots : @_ ici !',
e18 => 'Connexion impossible avec $_[0] ($!)',
- e19 => 'Caractère non valide dans la ligne',
+ e19 => 'Caractère non valide dans la ligne $_[0]',
e20 => 'Symbole $_[0] non reconnu',
e21 => '$_[0] n\'est pas une valeur numérique',
e22 => '$_[0] n\'est pas un indicatif',
e16 => 'El fichero \"$_[0]\" ya existe',
e17 => 'Por favor no uses la palabra: @_ aquí',
e18 => 'No se puede conectar con $_[0] ($!)',
- e19 => 'Carácter no válido en la línea',
+ e19 => 'Carácter no válido en la línea $_[0]',
e20 => 'Símbolo $_[0] no reconocido',
e21 => '$_[0] no es numérico',
e22 => '$_[0] no es un indicativo',
e16 => 'Datei \"$_[0]\" existiert',
e17 => 'Bitte gebrauche dieses Wort: @_ nicht hier',
e18 => 'Kann nicht verbinden mit $_[0] ($!)',
- e19 => 'Ungueltiger Character in der Zeile',
+ e19 => 'Ungueltiger Character in der Zeile $_[0]',
e20 => 'Kuerzel $_[0] nicht erkannt',
e21 => '$_[0] nicht numerisch',
e22 => '$_[0] kein Rufzeichen',
e16 => 'Il file \"$_[0]\" esiste',
e17 => 'Non usare le parole: @_ qui',
e18 => 'Impossibile connettere $_[0] ($!)',
- e19 => 'Carattere non valido nella linea',
+ e19 => 'Carattere non valido nella linea $_[0]',
e20 => 'separatore $_[0] non riconosciuto',
e21 => '$_[0] non e\' numerico',
e22 => '$_[0] non e\' un nominativo',
e16 => 'Soubor \"$_[0]\" uz existuje',
e17 => 'Prosim nepouzivej zde toto slovo: @_',
e18 => 'Nemohu se pripojit na $_[0] ($!)',
- e19 => 'neplatny znak v radku',
+ e19 => 'neplatny znak v radku $_[0]',
e20 => 'retezec $_0] nebyl rozpoznan',
e21 => '$_[0] neni cislo',
e22 => '$_[0] neni znacka',
e16 => 'O ficheiro \"$_[0]\" existe',
e17 => 'Por favor no use as palavras: @_ aqui',
e18 => 'No posso ligar a $_[0] ($!)',
- e19 => 'Caracter invlido na linha',
+ e19 => 'Caracter invlido na linha $_[0]',
e20 => 'sinal $_[0] no reconhecido',
e21 => '$_[0] no numrico',
e22 => '$_[0] no um indicativo',
$userfn = "$local_data/users";
# the "message of the day" file
-$motd = "$local_data/motd";
+$motd = "motd";
use strict;
use DXVars;
+use SysVar;
use DB_File;
use File::Copy;
use DXDebug;
my %dbn;
if (-e $dbfn ) {
- copy($dbfn, "$dbfn.new") or return "cannot copy $dbfn -> $dbfn.new $!";
+ copy($dbfn, "$dbfn.old") or return "cannot copy $dbfn -> $dbfn.old $!";
}
-
+
+ unlink "$dbfn.new";
tie %dbn, 'DB_File', "$dbfn.new", O_RDWR|O_CREAT, 0664, $a or return "cannot tie $dbfn.new $!";
# now write away all the files
$SIG{__DIE__} = $w;
}
+ # setup location of motd & issue
+ localdata_mv($motd);
+ $motd = localdata($motd);
+ localdata_mv("issue");
+
+
# try to load XML::Simple
DXXml::init();
#
#
-require 5.004;
+require 5.16.1;
use warnings;
# search local then perl directories
do_initscr();
$inscroll = 0;
+ dbg("resize: l=$lines c=$cols");
+ dbg("resize: sh=". scalar @sh );
+# my @tsh;
+# my $t;
+# while (defined ($t = shift @sh)) {
+# dbg("t: $t(" , length $t . ')');
+# if ($t =~ /^\t/) {
+# $t =~ s/^\t/ /;
+# push(@tsh, pop(@tsh) . $t)
+# } else {
+# push(@tsh, $t);
+# }
+# dbg("tsh: " . scalar @tsh);
+# }
+# dbg("resize: tsh=". scalar @tsh );
+# $spos = @tsh < $pagel ? 0 : @tsh - $pagel;
+ # addtotop(@tsh);
$spos = @sh < $pagel ? 0 : @sh - $pagel;
show_screen();
$conn->send_later("C$call|$cols") if $conn;
# add a line to the end of the top screen
sub addtotop
{
+ $Text::Wrap::Columns = $cols;
while (@_) {
my $inbuf = shift;
my $l = length $inbuf;
+ dbg("addtotop: $l $inbuf");
if ($l > $cols) {
-# $Text::Wrap::Columns = $cols;
-# push @sh, wrap('',"\t", $inbuf);
- push @sh, $inbuf;
+ $inbuf =~ s/\s+/ /g;
+ if (length $inbuf > $cols) {
+ push @sh, split /\n/, wrap('',' ' x 19, $inbuf);
+ } else {
+ push @sh, $inbuf;
+ }
} else {
push @sh, $inbuf;
}
while (@ARGV && $ARGV[0] =~ /^-/) {
my $arg = shift;
if ($arg eq '-x') {
- dbginit();
+ dbginit('console');
dbgadd('console');
$maxshist = 200;
}
$SIG{'HUP'} = \&sig_term;
-# start up
+
+# start upb
+$Text::Wrap::Columns = $cols;
doresize();
$SIG{__DIE__} = \&sig_term;
projects / spider.git / commitdiff