X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=6306226d7e6862f87b4ae61c02753e36e3094961;hb=01ba3df164dca5b803527a4b7db6e5d36a334f91;hp=d88d879ee9678d7209a89c546bb3375cd6e85858;hpb=e83b70ecab022dbbeac0b56f67ed2e4bed609e86;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index d88d879e..6306226d 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -29,6 +29,7 @@ use DXDb; use AnnTalk; use WCY; use Sun; +use Internet; use strict; use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase); @@ -64,8 +65,8 @@ sub start $self->send($self->msg('l2',$self->{name})); $self->send_file($main::motd) if (-e $main::motd); $self->state('prompt'); # a bit of room for further expansion, passwords etc - $self->{priv} = $user->priv; - $self->{lang} = $user->lang; + $self->{priv} = $user->priv || 0; + $self->{lang} = $user->lang || $main::lang || 'en'; $self->{pagelth} = $user->pagelth || 20; $self->{priv} = 0 if $line =~ /^(ax|te)/; # set the connection priv to 0 - can be upgraded later $self->{consort} = $line; # save the connection type @@ -81,6 +82,12 @@ sub start $self->{logininfo} = $user->wantlogininfo; $self->{here} = 1; + # get the filters + $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'user_default', 0); + $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'user_default', 0); + $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'user_default', 0); + $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'user_default', 0) ; + # clean up qra locators my $qra = $user->qra; $qra = undef if ($qra && !DXBearing::is_qra($qra)); @@ -111,7 +118,7 @@ sub start $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long); $self->send($self->msg('hnodee1')) if !$user->qth; $self->send($self->msg('m9')) if DXMsg::for_me($call); - $self->send($self->msg('pr', $call)); + $self->prompt; # decide on echo if (!$user->wantecho) { @@ -177,30 +184,96 @@ sub normal } delete $self->{passwd}; $self->state('prompt'); - } else { - @ans = run_cmd($self, $cmdline); # if length $cmdline; - - if ($self->{pagelth} && @ans > $self->{pagelth}) { - my $i; - for ($i = $self->{pagelth}; $i-- > 0; ) { - my $line = shift @ans; - $line =~ s/\s+$//o; # why am having to do this? - $self->send($line); + } elsif ($self->{state} eq 'talk') { + if ($cmdline =~ m{^(?:/EX|/ABORT)}i) { + for (@{$self->{talklist}}) { + $self->send_talks($_, $self->msg('talkend')); } - $self->{pagedata} = \@ans; - $self->state('page'); - $self->send($self->msg('page', scalar @ans)); - } else { - for (@ans) { - $self->send($_) if $_; + $self->state('prompt'); + delete $self->{talklist}; + } elsif ($cmdline =~ m(^/\w+)) { + $cmdline =~ s(^/)(); + $self->send_ans(run_cmd($self, $cmdline)); + $self->send($self->talk_prompt); + } elsif ($self->{talklist} && @{$self->{talklist}}) { + # send what has been said to whoever is in this person's talk list + for (@{$self->{talklist}}) { + $self->send_talks($_, $cmdline); } - } + $self->send($self->talk_prompt) if $self->{state} eq 'talk'; + } else { + # for safety + $self->state('prompt'); + } + } else { + $self->send_ans(run_cmd($self, $cmdline)); } # send a prompt only if we are in a prompt state $self->prompt() if $self->{state} =~ /^prompt/o; } +# send out the talk messages taking into account vias and connectivity +sub send_talks +{ + my ($self, $ent, $line) = @_; + + my ($to, $via) = $ent =~ /(\S+)>(\S+)/; + $to = $ent unless $to; + my $call = $via ? $via : $to; + my $clref = DXCluster->get_exact($call); + my $dxchan = $clref->dxchan if $clref; + if ($dxchan) { + $dxchan->talk($self->{call}, $to, $via, $line); + } else { + $self->send($self->msg('disc2', $via ? $via : $to)); + my @l = grep { $_ ne $ent } @{$self->{talklist}}; + if (@l) { + $self->{talklist} = \@l; + } else { + delete $self->{talklist}; + $self->state('prompt'); + } + } +} + +sub talk_prompt +{ + my $self = shift; + my @call; + for (@{$self->{talklist}}) { + my ($to, $via) = /(\S+)>(\S+)/; + $to = $_ unless $to; + push @call, $to; + } + return $self->msg('talkprompt', join(',', @call)); +} + +# +# send a load of stuff to a command user with page prompting +# and stuff +# + +sub send_ans +{ + my $self = shift; + + if ($self->{pagelth} && @_ > $self->{pagelth}) { + my $i; + for ($i = $self->{pagelth}; $i-- > 0; ) { + my $line = shift @_; + $line =~ s/\s+$//o; # why am having to do this? + $self->send($line); + } + $self->{pagedata} = [ @_ ]; + $self->state('page'); + $self->send($self->msg('page', scalar @_)); + } else { + for (@_) { + $self->send($_) if $_; + } + } +} # # this is the thing that runs the command, it is done like this for the # benefit of remote command execution @@ -230,7 +303,7 @@ sub run_cmd # split the command line up into parts, the first part is the command my ($cmd, $args) = split /\s+/, $cmdline, 2; - $args = "" unless $args; + $args = "" unless defined $args; if ($cmd) { @@ -242,7 +315,7 @@ sub run_cmd my $acmd = CmdAlias::get_cmd($cmd); if ($acmd) { ($cmd, $args) = split /\s+/, "$acmd $args", 2; - $args = "" unless $args; + $args = "" unless defined $args; dbg('command', "aliased cmd: $cmd $args"); } @@ -272,7 +345,7 @@ sub run_cmd }; if ($@) { - cluck($@); + #cluck($@); return (DXDebug::shortmess($@)); }; } @@ -329,10 +402,10 @@ sub finish sleep(1); } - if ($call eq $main::myalias) { # unset the channel if it is us really - my $node = DXNode->get($main::mycall); - $node->{dxchan} = 0; - } +# if ($call eq $main::myalias) { # unset the channel if it is us really +# my $node = DXNode->get($main::mycall); +# $node->{dxchan} = 0; +# } # issue a pc17 to everybody interested my $nchan = DXChannel->get($main::mycall); @@ -354,7 +427,7 @@ sub finish sub prompt { my $self = shift; - $self->send($self->msg($self->here ? 'pr' : 'pr2', $self->call)); + $self->send($self->msg($self->here ? 'pr' : 'pr2', $self->call, cldate($main::systime), ztime($main::systime))); } # broadcast a message to all users [except those mentioned after buffer] @@ -559,5 +632,26 @@ sub find_cmd_name { return $package; } +# 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}; + Log('talk', $to, $from, $main::mycall, $line); +} + +# send an announce +sub announce +{ + +} + +# send a dx spot +sub dx_spot +{ + +} + 1; __END__