package DXCommandmode;
+use POSIX;
+use IO::File;
+
@ISA = qw(DXChannel);
use DXUtil;
use DXLogPrint;
use DXBearing;
use CmdAlias;
-use IO::File;
use Filter;
use Carp;
+use Minimuf;
use strict;
use vars qw(%Cache %cmd_cache $errstr %aliases);
$self->send($self->msg('hnodee1')) if !$user->qth;
$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));
}
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 {
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};
+ @ans = &{$c}($self, $args);
}
} 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);
}
#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
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 IO::File;
if (!open $fh, $filename) {
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;
}
}
- {
- #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;
}