X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=35c92341d17cbc896a0a64d6941e9a3d156dea77;hb=fbb19552226356d5c01ba474f3923f4ccd710cab;hp=87182fc69f08b44218f9f8fb2e9b29251469280d;hpb=ca46fb0822f3998466ffbe4c669271ee2af86859;p=spider.git

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 87182fc6..35c92341 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -32,11 +32,11 @@ use WCY;
 use Sun;
 use Internet;
 use Script;
-use Net::Telnet;
 use QSL;
 use DB_File;
 use VE7CC;
 use DXXml;
+use AsyncMsg;
 
 use strict;
 use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase %nothereslug
@@ -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; 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
@@ -1186,7 +1194,7 @@ sub import_cmd
 						$dxchan->{priv} = $u->priv;
 						$dxchan->{user} = $u;
 						@out = $s->run($dxchan, 1);
-						$dxchan->{call} = $call;
+						$dxchan->{call} = $old;
 						$dxchan->{priv} = $priv;
 						$dxchan->{user} = $user;
 					} else {
@@ -1224,7 +1232,7 @@ sub send_motd
 	}
 	$motd = "${main::motd}_$self->{lang}" unless $motd && -e $motd;
 	$motd = $main::motd unless $motd && -e $motd;
-	if ($self->conn->{csort} eq 'ax25') {
+	if ($self->conn->ax25) {
 		if ($motd) {
 			$motd = "${motd}_ax25" if -e "${motd}_ax25";
 		} else {