X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=fda298b13e54ddf8e8fe3c333e47b2cc6550ce5c;hb=a895f396222d99b306bbabe53dcb184131f7af2d;hp=e6b612fad342942b8733a6e9fce402aaa2e86ac7;hpb=2747e0fe4269e9a7e095c333598191eb9dca63fc;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index e6b612fa..fda298b1 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -111,7 +111,8 @@ sub start my $pagelth = $user->pagelth; $pagelth = $default_pagelth unless defined $pagelth; $self->{pagelth} = $pagelth; - ($self->{width}) = $line =~ /width=(\d+)/; $line =~ s/\s*width=\d+\s*//; + ($self->{width}) = $line =~ /\s*width=(\d+)/; $line =~ s/\s*width=\d+//; + $self->{enhanced} = $line =~ /\s+enhanced/; $line =~ s/\s*enhanced//; if ($line =~ /host=/) { my ($h) = $line =~ /host=(\d+\.\d+\.\d+\.\d+)/; $line =~ s/\s*host=\d+\.\d+\.\d+\.\d+// if $h; @@ -124,7 +125,7 @@ sub start $self->{width} = 80 unless $self->{width} && $self->{width} > 80; $self->{consort} = $line; # save the connection type - LogDbg('DXCommand', "$call connected from $self->{hostname}"); + LogDbg('DXCommand', "$call connected from $self->{hostname} cols $self->{width}" . ($self->{enhanced}?" enhanced":'')); # set some necessary flags on the user if they are connecting $self->{beep} = $user->wantbeep; @@ -147,13 +148,16 @@ sub start $user->wantusstate(0) unless defined $user->{wantusstate}; # sort out registration - if ($main::reqreg == 1) { - $self->{registered} = $user->registered; - } elsif ($main::reqreg == 2) { + if ($main::reqreg == 2) { $self->{registered} = !$user->registered; } else { - $self->{registered} = 1; - } + $self->{registered} = $user->registered; + } + + # establish slug queue, if required + $self->{sluggedpcs} = []; + $self->{isslugged} = $DXProt::pc92_slug_changes + $DXProt::last_pc92_slug + 5 if $DXProt::pc92_slug_changes; + $self->{isslugged} = 0 if $self->{priv} || $user->registered || $user->homenode eq $main::mycall; # send the relevant MOTD $self->send_motd; @@ -516,7 +520,7 @@ sub run_cmd # check cmd if ($cmd =~ m|^/| || $cmd =~ m|[^-?\w/]|) { - LogDbg('DXCommand', "cmd: invalid characters in '$cmd'"); + LogDbg('DXCommand', "cmd: $self->{call} - invalid characters in '$cmd'"); return $self->_error_out('e1'); } @@ -548,6 +552,7 @@ sub run_cmd if ($package && $self->can("${package}::handle")) { no strict 'refs'; dbg("cmd: package $package") if isdbg('command'); +# Log('cmd', "$self->{call} on $self->{hostname} : '$cmd $args'"); my $t0 = [gettimeofday]; eval { @ans = &{"${package}::handle"}($self, $args) }; if ($@) { @@ -609,11 +614,17 @@ sub process } ++$users; $maxusers = $users if $users > $maxusers; - } - while (my ($k, $v) = each %nothereslug) { - if ($main::systime >= $v + 300) { - delete $nothereslug{$k}; + if ($dxchan->{isslugged} && $main::systime > $dxchan->{isslugged}) { + foreach my $ref (@{$dxchan->{sluggedpcs}}) { + if ($ref->[0] == 61) { + Spot::add(@{$ref->[2]}); + DXProt::send_dx_spot($dxchan, $ref->[1], @{$ref->[2]}); + } + } + + $dxchan->{isslugged} = 0; + $dxchan->{sluggedpcs} = []; } } @@ -638,7 +649,7 @@ sub disconnect # @rout = $main::routeroot->del_user($uref); @rout = DXProt::_del_thingy($main::routeroot, [$call, 0]); - dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route'); + # dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route'); # issue a pc17 to everybody interested $main::me->route_pc17($main::mycall, undef, $main::routeroot, $uref); @@ -959,7 +970,7 @@ sub announce $buf = dd(['ann', $to, $target, $text, @_]) } else { $buf = "$to$target de $_[0]: $text"; - $buf =~ s/\%5E/^/g; + #$buf =~ s/\%5E/^/g; $buf .= "\a\a" if $self->{beep}; } $self->local_send($target eq 'WX' ? 'W' : 'N', $buf); @@ -984,7 +995,7 @@ sub chat $buf = dd(['chat', $to, $target, $text, @_]) } else { $buf = "$target de $_[0]: $text"; - $buf =~ s/\%5E/^/g; + #$buf =~ s/\%5E/^/g; $buf .= "\a\a" if $self->{beep}; } $self->local_send('C', $buf); @@ -995,42 +1006,55 @@ sub format_dx_spot my $self = shift; my $t = ztime($_[2]); - my $loc = ''; - my $clth = 30; - --$clth if $self->{consort} eq 'local'; + my ($slot1, $slot2) = ('', ''); - my $comment = substr (($_[3] || ''), 0, $clth); + my $clth = 30 + $self->{width} - 80; # allow comment to grow according the screen width + my $c = $_[3]; + $c =~ s/\t/ /g; + my $comment = substr (($c || ''), 0, $clth); $comment .= ' ' x ($clth - (length($comment))); - if ($self->{user}->wantgrid) { - my $ref = DXUser::get_current($_[4]); + if (!$slot1 && $self->{user}->wantgrid) { + my $ref = DXUser::get_current($_[1]); if ($ref && $ref->qra) { - $loc = ' ' . substr($ref->qra, 0, 4); + $slot1 = ' ' . substr($ref->qra, 0, 4); } } - - if ($self->{user}->wantgrid) { - my $ref = DXUser::get_current($_[1]); + if (!$slot1 && $self->{user}->wantusstate) { + $slot1 = " $_[12]" if $_[12]; + } + unless ($slot1) { + if ($self->{user}->wantdxitu) { + $slot1 = sprintf(" %2d", $_[8]) if defined $_[8]; + } elsif ($self->{user}->wantdxcq) { + $slot1 = sprintf(" %2d", $_[9]) if defined $_[9]; + } + } + $comment = substr($comment, 0, $clth-length($slot1)) . $slot1 if $slot1; + + if (!$slot2 && $self->{user}->wantgrid) { + my $origin = $_[4]; + $origin =~ s/-#$//; # sigh...... + my $ref = DXUser::get_current($origin); if ($ref && $ref->qra) { - $loc = ' ' . substr($ref->qra, 0, 4); - $comment = substr $comment, 0, ($clth - (length($comment)+length($loc))); - $comment .= $loc; - $loc = ''; + $slot2 = ' ' . substr($ref->qra, 0, 4); + } + } + if (!$slot2 && $self->{user}->wantusstate) { + $slot2 = " $_[13]" if $_[13]; + } + unless ($slot2) { + if ($self->{user}->wantdxitu) { + $slot2 = sprintf(" %2d", $_[10]) if defined $_[10]; + } elsif ($self->{user}->wantdxcq) { + $slot2 = sprintf(" %2d", $_[11]) if defined $_[11]; } - } elsif ($self->{user}->wantdxitu) { - $loc = ' ' . sprintf("%2d", $_[10]) if defined $_[10]; - $comment = substr($comment, 0, $clth-3) . ' ' . sprintf("%2d", $_[8]) if defined $_[8]; - } elsif ($self->{user}->wantdxcq) { - $loc = ' ' . sprintf("%2d", $_[11]) if defined $_[11]; - $comment = substr($comment, 0, $clth-3) . ' ' . sprintf("%2d", $_[9]) if defined $_[9]; - } elsif ($self->{user}->wantusstate) { - $loc = ' ' . $_[13] if $_[13]; - $comment = substr($comment, 0, $clth-3) . ' ' . $_[12] if $_[12]; } - return sprintf "DX de %-7.7s%11.1f %-12.12s %-s $t$loc", "$_[4]:", $_[0], $_[1], $comment; + return sprintf "DX de %-8.8s%10.1f %-12.12s %-s $t$slot2", "$_[4]:", $_[0], $_[1], $comment; } + # send a dx spot sub dx_spot { @@ -1072,7 +1096,7 @@ sub dx_spot } else { $buf = $self->format_dx_spot(@_); $buf .= "\a\a" if $self->{beep}; - $buf =~ s/\%5E/^/g; + #$buf =~ s/\%5E/^/g; } $self->local_send('X', $buf); @@ -1275,7 +1299,7 @@ sub send_motd my $self = shift; my $motd; - unless ($self->{registered}) { + unless ($self->isregistered) { $motd = "${main::motd}_nor_$self->{lang}"; $motd = "${main::motd}_nor" unless -e $motd; } @@ -1337,11 +1361,16 @@ sub spawn_cmd sub { my $subpro = shift; if (isdbg('progress')) { - my $s = qq{line: "$line"}; + my $s = qq{$call line: "$line"}; $s .= ", args: " . join(', ', map { defined $_ ? qq{'$_'} : q{'undef'} } @$args) if $args && @$args; dbg($s); } - eval { @out = $cmdref->(@$args); }; + eval { + ++$self->{_in_sub_process}; + dbg "\$self->{_in_sub_process} = $self->{_in_sub_process}"; + @out = $cmdref->(@$args); + --$self->{_in_sub_process} if $self->{_in_sub_process} > 0; + }; if ($@) { DXDebug::dbgprintring(25); push @out, DXDebug::shortmess($@); @@ -1381,5 +1410,6 @@ sub user_count { return ($users, $maxusers); } + 1; __END__