X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=0218aafefc8657655b25d98b7b75d9fa530b0685;hb=c675748ded5843f7bbd3819bb550f66b2534193a;hp=798351773c998c62f603facd84c093c782873d34;hpb=f67292b60a4b1567c0c370818fa2a7f0bc308fbc;p=spider.git

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 79835177..0218aafe 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -51,7 +51,7 @@ $maxbadcount = 3;				# no of bad words allowed before disconnection
 $msgpolltime = 3600;			# the time between polls for new messages 
 $cmdimportdir = "$main::root/cmd_import"; # the base directory for importing command scripts 
                                           # this does not exist as default, you need to create it manually
-					  #
+#
 
 #
 # obtain a new connection this is derived from dxchannel
@@ -521,10 +521,10 @@ sub run_cmd
 			my $package = find_cmd_name($path, $fcmd);
 			return ($@) if $@;
 				
-			if ($package && DXCommandmode->can($package)) {
+			if ($package && $self->can("${package}::handle")) {
 				no strict 'refs';
 				dbg("cmd: package $package") if isdbg('command');
-				eval { @ans = &$package($self, $args) };
+				eval { @ans = &{"${package}::handle"}($self, $args) };
 				return (DXDebug::shortmess($@)) if $@;
 			} else {
 				dbg("cmd: $package not present") if isdbg('command');
@@ -745,12 +745,14 @@ sub clear_cmd_cache
 {
 	no strict 'refs';
 	
-	for (keys %Cache) {
-		undef *{$_} unless /cmd_cache/;
-		dbg("Undefining cmd $_") if isdbg('command');
+	for my $k (keys %Cache) {
+		unless ($k =~ /cmd_cache/) {
+			dbg("Undefining cmd $k") if isdbg('command');
+			undef $DXCommandmode::{"${k}::"};
+		}
 	}
 	%cmd_cache = ();
-	%Cache = ();
+	%Cache = ( cmd_clear_cmd_cache  => $Cache{cmd_clear_cmd_cache} );
 }
 
 #
@@ -761,11 +763,10 @@ sub clear_cmd_cache
 # 
 # This has been nicked directly from the perlembed pages
 #
-
 #require Devel::Symdump;  
 
 sub valid_package_name {
-	my($string) = @_;
+	my $string = shift;
 	$string =~ s|([^A-Za-z0-9_/])|sprintf("_%2x",unpack("C",$1))|eg;
 	
 	$string =~ s|/|_|g;
@@ -788,7 +789,7 @@ sub find_cmd_name {
 		return undef;
 	}
 	
-	if(defined $Cache{$package}->{mtime} &&$Cache{$package}->{mtime} <= $mtime) {
+	if(exists $Cache{$package} && exists $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";
@@ -802,7 +803,14 @@ sub find_cmd_name {
 		};
 		
 		#wrap the code into a subroutine inside our unique package
-		my $eval = qq( sub $package { $sub } );
+		my $eval = qq(package DXCommandmode::$package; use POSIX qw{:math_h}; use DXLog; use DXDebug; use DXUser; use DXUtil; use Minimuf; use Sun; our \@ISA = qw{DXCommandmode}; );
+
+
+		if ($sub =~ m|\s*sub\s+handle\n|) {
+			$eval .= $sub;
+		} else {
+			$eval .= qq(sub handle { $sub });
+		}
 		
 		if (isdbg('eval')) {
 			my @list = split /\n/, $eval;
@@ -817,7 +825,8 @@ sub find_cmd_name {
 
 		if (exists $Cache{$package}) {
 			dbg("find_cmd_name: Redefining $package") if isdbg('command');
-			undef *$package;
+			undef $DXCommandmode::{"${package}::"};
+			delete $Cache{$package};
 		} else {
 			dbg("find_cmd_name: Defining $package") if isdbg('command');
 		}
@@ -825,10 +834,9 @@ sub find_cmd_name {
 		eval $eval;
 
 		$Cache{$package} = {mtime => $mtime } unless $@;
-	    
 	}
 
-	return $package;
+	return "DXCommandmode::$package";
 }
 
 sub send