From: djk <djk>
Date: Wed, 3 Nov 1999 21:13:11 +0000 (+0000)
Subject: changed the command mode subs thing to use anonymous subs
X-Git-Tag: R_1_34~18
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=6f9f47b53d1b6c2a52722b525695fa1c03ab1ed7;p=spider.git

changed the command mode subs thing to use anonymous subs
allow locally connect clusters to appear in the node list even if they
don't issue PC19s (but do issue PC16s)
---

diff --git a/Changes b/Changes
index 6b84bee7..c53af39d 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+03Nov99=======================================================================
+1. Simplified command caching so it uses anonymous subroutines, you should
+also get error messages back on the console now when developing.
+2. Allow locally connected AK1A clusters that for some obscure reason don't
+issue PC19s to still appear as connected and allow them to acquire users.
 31Oct99=======================================================================
 1. updated Minimuf.pm and show/muf.pl to the fixed versions sent to me by
 Steve Franke K9AN. 
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index f2ba3745..12c84c00 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -195,7 +195,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 {
 
@@ -232,31 +232,25 @@ 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};
+					@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);
 }
 
@@ -443,22 +437,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
@@ -502,13 +481,12 @@ 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 IO::File;
 		if (!open $fh, $filename) {
@@ -520,7 +498,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 { $sub } );
 		
 		if (isdbg('eval')) {
 			my @list = split /\n/, $eval;
@@ -530,25 +508,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;
 }
 
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index ee8c4aa9..32d5e3b3 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -313,20 +313,24 @@ sub normal
 		
 		if ($pcno == 16) {		# add a user
 			my $node = DXCluster->get_exact($field[1]); 
+			my $dxchan;
+			if (!$node && ($dxchan = DXChannel->get($field[1]))) {
+				# add it to the node table if it isn't present and it's
+				# connected locally
+				$node = DXNode->new($dxchan, $field[1], 0, 1, 5400);
+			}
 			return unless $node; # ignore if havn't seen a PC19 for this one yet
 			return unless $node->isa('DXNode');
 			if ($node->dxchan != $self) {
 				dbg('chan', "LOOP: $field[1] came in on wrong channel");
 				return;
 			}
-			my $dxchan;
 			if (($dxchan = DXChannel->get($field[1])) && $dxchan != $self) {
 				dbg('chan', "LOOP: $field[1] connected locally");
 				return;
 			}
 			my $i;
-			
-			
+						
 			for ($i = 2; $i < $#field; $i++) {
 				my ($call, $confmode, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o;
 				next if !$call || length $call < 3 || length $call > 8;
diff --git a/perl/cluster.pl b/perl/cluster.pl
index ceb099ca..308b1d90 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -67,7 +67,7 @@ package main;
 
 @inqueue = ();					# the main input queue, an array of hashes
 $systime = 0;					# the time now (in seconds)
-$version = "1.33";				# the version no of the software
+$version = "1.34";				# the version no of the software
 $starttime = 0;                 # the starting time of the cluster   
 $lockfn = "cluster.lock";       # lock file name