X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=bce0255fd4750002963821575ccd462f5173ddda;hb=8942c27356acc5d5f5a20134461bcf7e6bd6a044;hp=91d268b0fc33398f9a4721c2f85daf131c15c6eb;hpb=337f38bfac57a5e5df34c63094fb869b0e2f6bee;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 91d268b0..bce0255f 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -22,6 +22,7 @@ use DXLogPrint; use DXBearing; use CmdAlias; use FileHandle; +use Filter; use Carp; use strict; @@ -39,7 +40,7 @@ $errstr = (); # error string from eval sub new { my $self = DXChannel::alloc(@_); - $self->{sort} = 'U'; # in absence of how to find out what sort of an object I am + $self->{'sort'} = 'U'; # in absence of how to find out what sort of an object I am return $self; } @@ -65,7 +66,7 @@ sub start $self->{consort} = $line; # save the connection type # set some necessary flags on the user if they are connecting - $self->{beep} = $self->{wwv} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1; + $self->{beep} = $self->{wwv} = $self->{wx} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1; # $self->prompt() if $self->{state} =~ /^prompt/o; # add yourself to the database @@ -86,7 +87,10 @@ sub start $self->send($self->msg('qthe1')) if !$user->qth; $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long); $self->send($self->msg('hnodee1')) if !$user->qth; + $self->send($self->msg('msgnew')) if DXMsg::for_me($call); + # get the filters + $self->{spotfilter} = Filter::read_in('spots', $call); $self->send($self->msg('pr', $call)); } @@ -130,7 +134,7 @@ sub normal $self->state('prompt'); } } else { - @ans = run_cmd($self, $cmdline) if length $cmdline; + @ans = run_cmd($self, $cmdline); # if length $cmdline; if ($self->{pagelth} && @ans > $self->{pagelth}) { my $i; @@ -175,6 +179,8 @@ sub run_cmd return (1, "Syserr: Eval err $errstr on stored func $self->{func}"); } } else { + + return () if length $cmdline == 0; # strip out // $cmdline =~ s|//|/|og; @@ -199,20 +205,25 @@ sub run_cmd ($path, $fcmd) = search($main::localcmd, $cmd, "pl"); ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd; - dbg('command', "path: $cmd cmd: $fcmd"); - - my $package = find_cmd_name($path, $fcmd); - @ans = (0) if !$package ; + if ($path && $cmd) { + dbg('command', "path: $cmd cmd: $fcmd"); - if ($package) { - dbg('command', "package: $package"); + my $package = find_cmd_name($path, $fcmd); + @ans = (0) if !$package ; - my $c = qq{ \@ans = $package(\$self, \$args) }; - dbg('eval', "cluster cmd = $c\n"); - eval $c; - if ($@) { - @ans = (0, "Syserr: Eval err cached $package\n$@"); + if ($package) { + dbg('command', "package: $package"); + + my $c = qq{ \@ans = $package(\$self, \$args) }; + dbg('eval', "cluster cmd = $c\n"); + eval $c; + if ($@) { + @ans = (0, "Syserr: Eval err cached $package\n$@"); + } } + } else { + dbg('command', "cmd: $cmd not found"); + @ans = (0); } } } @@ -237,16 +248,16 @@ sub run_cmd sub process { my $t = time; - my @chan = DXChannel->get_all(); - my $chan; + my @dxchan = DXChannel->get_all(); + my $dxchan; - foreach $chan (@chan) { - next if $chan->sort ne 'U'; + foreach $dxchan (@dxchan) { + next if $dxchan->sort ne 'U'; # send a prompt if no activity out on this channel - if ($t >= $chan->t + $main::user_interval) { - $chan->prompt() if $chan->{state} =~ /^prompt/o; - $chan->t($t); + if ($t >= $dxchan->t + $main::user_interval) { + $dxchan->prompt() if $dxchan->{state} =~ /^prompt/o; + $dxchan->t($t); } } } @@ -258,12 +269,21 @@ sub finish { my $self = shift; my $call = $self->call; - + + # log out text + if (-e "$main::data/logout") { + open(I, "$main::data/logout") or confess; + my @in = ; + close(I); + $self->send_now('D', @in); + sleep(1); + } + if ($call eq $main::myalias) { # unset the channel if it is us really my $node = DXNode->get($main::mycall); $node->{dxchan} = 0; } - my $ref = DXNodeuser->get($call); + my $ref = DXCluster->get_exact($call); # issue a pc17 to everybody interested my $nchan = DXChannel->get($main::mycall); @@ -281,9 +301,7 @@ sub finish sub prompt { my $self = shift; - my $call = $self->{call}; - $self->send($self->msg('pr', $call)); - #DXChannel::msg($self, 'pr', $call); + $self->send($self->msg($self->here ? 'pr' : 'pr2', $self->call)); } # broadcast a message to all users [except those mentioned after buffer] @@ -293,14 +311,14 @@ sub broadcast 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 ($chan, $except); + my ($dxchan, $except); - L: foreach $chan (@list) { - next if !$chan->sort eq 'U'; # only interested in user channels + L: foreach $dxchan (@list) { + next if !$dxchan->sort eq 'U'; # only interested in user channels foreach $except (@except) { - next L if $except == $chan; # ignore channels in the 'except' list + next L if $except == $dxchan; # ignore channels in the 'except' list } - chan->send($s); # send it + $dxchan->send($s); # send it } } @@ -333,7 +351,7 @@ sub search return () if $short_cmd =~ /\/$/; # return immediately if we have it - my ($apath, $acmd) = split ',', $cmd_cache{$short_cmd}; + ($apath, $acmd) = split ',', $cmd_cache{$short_cmd} if $cmd_cache{$short_cmd}; if ($apath && $acmd) { dbg('command', "cached $short_cmd = ($apath, $acmd)\n"); return ($apath, $acmd); @@ -369,6 +387,7 @@ sub search pop @lparts; # remove the suffix $l = join '.', @lparts; # chop $dirfn; # remove trailing / + $dirfn = "" unless $dirfn; $cmd_cache{"$short_cmd"} = join(',', ($path, "$dirfn$l")); # cache it dbg('command', "got path: $path cmd: $dirfn$l\n"); return ($path, "$dirfn$l"); @@ -459,7 +478,7 @@ sub find_cmd_name { # return if we can't find it $errstr = undef; - if (undef $mtime) { + unless (defined $mtime) { $errstr = DXM::msg('e1'); return undef; } @@ -470,6 +489,8 @@ sub find_cmd_name { #print STDERR "already compiled $package->handler\n"; ; } else { + delete_package($package) if defined $Cache{$package}{mtime}; + my $fh = new FileHandle; if (!open $fh, $filename) { $errstr = "Syserr: can't open '$filename' $!"; @@ -480,11 +501,7 @@ sub find_cmd_name { close $fh; #wrap the code into a subroutine inside our unique package - my $eval = qq{ - sub $package - { - $sub - } }; + my $eval = qq{ sub $package { $sub } }; if (isdbg('eval')) { my @list = split /\n/, $eval; @@ -506,7 +523,7 @@ sub find_cmd_name { delete_package($package); } else { #cache it unless we're cleaning out each time - $Cache{$package}{mtime} = $mtime; + $Cache{$package}{'mtime'} = $mtime; } }