X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=5439fc4d21bcc8cfee490cb541ba19551e83f660;hb=1fcf24aae37e929a6b9c2dab9ca5afff00d8db57;hp=d05af70a2936bd67c3ee9aec70b5a3142c8c0426;hpb=6aca4e461103870de99b0ce452f21cf7fedeb54b;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index d05af70a..5439fc4d 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -9,6 +9,8 @@ package DXCommandmode; +use POSIX; + @ISA = qw(DXChannel); use DXUtil; @@ -21,17 +23,19 @@ use DXLog; use DXLogPrint; use DXBearing; use CmdAlias; -use FileHandle; use Filter; use Carp; +use Minimuf; +use DXDb; use strict; -use vars qw(%Cache %cmd_cache $errstr %aliases); +use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase); %Cache = (); # cache of dynamically loaded routine's mod times %cmd_cache = (); # cache of short names $errstr = (); # error string from eval %aliases = (); # aliases for (parts of) commands +$scriptbase = "$main::root/scripts"; # the place where all users start scripts go # # obtain a new connection this is derived from dxchannel @@ -77,7 +81,9 @@ sub start # issue a pc16 to everybody interested my $nchan = DXChannel->get($main::mycall); my @pc16 = DXProt::pc16($nchan, $cuser); - DXProt::broadcast_ak1a(@pc16); + for (@pc16) { + DXProt::broadcast_all_ak1a($_); + } Log('DXCommand', "$call connected"); # send prompts and things @@ -87,10 +93,8 @@ 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); + $self->send($self->msg('m9')) if DXMsg::for_me($call); - # get the filters - $self->{spotfilter} = Filter::read_in('spots', $call); $self->send($self->msg('pr', $call)); } @@ -144,6 +148,8 @@ sub normal } else { $self->send($self->msg('sorry')); } + } else { + $self->send($self->msg('sorry')); } delete $self->{passwd}; $self->state('prompt'); @@ -190,7 +196,7 @@ sub run_cmd dbg('eval', "stored func cmd = $c\n"); eval $c; if ($@) { - return (1, "Syserr: Eval err $errstr on stored func $self->{func}"); + return ("Syserr: Eval err $errstr on stored func $self->{func}", $@); } } else { @@ -200,7 +206,8 @@ sub run_cmd $cmdline =~ s|//|/|og; # split the command line up into parts, the first part is the command - my ($cmd, $args) = $cmdline =~ /^([\S\/]+)\s*(.*)/o; + my ($cmd, $args) = split /\s+/, $cmdline, 2; + $args = "" unless $args; if ($cmd) { @@ -211,7 +218,8 @@ sub run_cmd # alias it if possible my $acmd = CmdAlias::get_cmd($cmd); if ($acmd) { - ($cmd, $args) = "$acmd $args" =~ /^([\w\/]+)\s*(.*)/o; + ($cmd, $args) = split /\s+/, "$acmd $args", 2; + $args = "" unless $args; dbg('command', "aliased cmd: $cmd $args"); } @@ -227,31 +235,29 @@ sub run_cmd 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$@"); + my $c; + unless (exists $Cache{$package}->{sub}) { + $c = eval $Cache{$package}->{eval}; + if ($@) { + return ("Syserr: Syntax error in $package", $@); + } + $Cache{$package}->{sub} = $c; } + $c = $Cache{$package}->{sub}; + eval { + @ans = &{$c}($self, $args); + }; + + return ($@) if $@; } } else { dbg('command', "cmd: $cmd not found"); - @ans = (0); + return ($self->msg('e1')); } } } - if ($ans[0]) { - shift @ans; - } else { - shift @ans; - if (@ans > 0) { - unshift @ans, $self->msg('e2'); - } else { - @ans = $self->msg('e1'); - } - } + shift @ans; return (@ans); } @@ -302,7 +308,7 @@ sub finish # issue a pc17 to everybody interested my $nchan = DXChannel->get($main::mycall); my $pc17 = $nchan->pc17($self); - DXProt::broadcast_ak1a($pc17); + DXProt::broadcast_all_ak1a($pc17); Log('DXCommand', "$call disconnected"); $ref->del() if $ref; @@ -348,6 +354,14 @@ sub get_all return @out; } +# run a script for this user +sub run_script +{ + my $self = shift; + my $silent = shift || 0; + +} + # # search for the command in the cache of short->long form commands # @@ -438,22 +452,7 @@ sub valid_package_name { #Dress it up as a real package name $string =~ s/\//_/og; - return "Emb_" . $string; -} - -#borrowed from Safe.pm -sub delete_package { - my $pkg = shift; - my ($stem, $leaf); - - no strict 'refs'; - $pkg = "DXCommandmode::$pkg\::"; # expand to full symbol table name - ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/; - - if ($stem && $leaf) { - my $stem_symtab = *{$stem}{HASH}; - delete $stem_symtab->{$leaf}; - } + return $string; } # find a cmd reference @@ -497,25 +496,21 @@ sub find_cmd_name { return undef; } - if(defined $Cache{$package}{mtime} && $Cache{$package}{mtime } <= $mtime) { + if(defined $Cache{$package}->{mtime} &&$Cache{$package}->{mtime} <= $mtime) { #we have compiled this subroutine already, #it has not been updated on disk, nothing left to do #print STDERR "already compiled $package->handler\n"; ; } else { - delete_package($package) if defined $Cache{$package}{mtime}; - - my $fh = new FileHandle; - if (!open $fh, $filename) { + + my $sub = readfilestr($filename); + unless ($sub) { $errstr = "Syserr: can't open '$filename' $!"; return undef; }; - local $/ = undef; - my $sub = <$fh>; - close $fh; #wrap the code into a subroutine inside our unique package - my $eval = qq{ sub $package { $sub } }; + my $eval = qq( sub { $sub } ); if (isdbg('eval')) { my @list = split /\n/, $eval; @@ -525,25 +520,9 @@ sub find_cmd_name { } } - { - #hide our variables within this block - my($filename,$mtime,$package,$sub); - eval $eval; - } - - if ($@) { - print "\$\@ = $@"; - $errstr = $@; - delete_package($package); - } else { - #cache it unless we're cleaning out each time - $Cache{$package}{'mtime'} = $mtime; - } + $Cache{$package} = {mtime => $mtime, eval => $eval }; } - - #print Devel::Symdump->rnew($package)->as_string, $/; - $package = "DXCommandmode::$package" if $package; - $package = undef if $errstr; + return $package; }