X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=b51d9c4c3716e12cb12130ee06ac0b387f7245f6;hb=171a7a0bf86e9732a33c7829e808129ec01c51c2;hp=9f7b3885712d7366a1daa66d4f272985502d528f;hpb=e5b0e3dee551a224de284a5ba550098256fcb268;p=spider.git

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 9f7b3885..b51d9c4c 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -53,13 +53,23 @@ sub start
   $self->msg('pr', $call);
   $self->state('prompt');                  # a bit of room for further expansion, passwords etc
   $self->{priv} = $user->priv;
+  $self->{lang} = $user->lang;
   $self->{priv} = 0 if $line =~ /^(ax|te)/;     # set the connection priv to 0 - can be upgraded later
   $self->{consort} = $line;                # save the connection type
 
   # set some necessary flags on the user if they are connecting
   $self->{wwv} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1;
   $self->prompt() if $self->{state} =~ /^prompt/o;
-
+  
+  # add yourself to the database
+  my $node = DXNode->get($main::mycall) or die "$main::mycall not allocated in DXNode database";
+  my $cuser = DXNodeuser->new($self, $node, $call, 0, 1);
+  $node->dxchan($self) if $call eq $main::myalias;       # send all output for mycall to myalias
+  
+  # issue a pc16 to everybody interested
+  my $nchan = DXChannel->get($main::mycall);
+  my @pc16 = DXProt::pc16($nchan, $cuser);
+  DXProt::broadcast_ak1a(@pc16);
 }
 
 #
@@ -133,7 +143,21 @@ sub process
 #
 sub finish
 {
+  my $self = shift;
+  my $call = $self->call;
 
+  if ($call eq $main::myalias) {   # unset the channel if it is us really
+    my $node = DXNode->get($main::mycall);
+	$node->{dxchan} = 0;
+  }
+  my $ref = DXNodeuser->get($call);
+
+  # issue a pc17 to everybody interested
+  my $nchan = DXChannel->get($main::mycall);
+  my $pc17 = $nchan->pc17($self);
+  DXProt::broadcast_ak1a($pc17);
+  
+  $ref->del() if $ref;
 }
 
 #
@@ -194,7 +218,7 @@ sub search
   my ($apath, $acmd) = split ',', $cmd_cache{$short_cmd};
   if ($apath && $acmd) {
     dbg('command', "cached $short_cmd = ($apath, $acmd)\n");
-    return ($apath, $acmd) if $apath;
+    return ($apath, $acmd);
   }
   
   # if not guess
@@ -203,6 +227,7 @@ sub search
   my $curdir = $path;
   my $p;
   my $i;
+  my @lparts;
   
   for ($i = 0; $i < @parts; $i++) {
     my  $p = $parts[$i];
@@ -219,14 +244,16 @@ sub search
 		  $curdir .= "/$l";
 		  last;
 		}
-      } else {                       # we are dealing with commands
-		next if !$l =~ /\.$suffix$/;       # only look for .$suffix files
+      } else {                # we are dealing with commands
+	    @lparts = split /\./, $l;                  
+		next if $lparts[$#lparts] ne $suffix;       # only look for .$suffix files
 		if ($p eq substr($l, 0, length $p)) {
-		  $l =~ s/\.$suffix$//;      # remove the suffix
-		  chop $dirfn;               # remove trailing /
-		  $cmd_cache{"$short_cmd"} = join(',', ($path, "$dirfn/$l"));   # cache it
-          dbg('command', "got path: $path cmd: $dirfn/$l\n");
-		  return ($path, "$dirfn/$l"); 
+		  pop @lparts;        #  remove the suffix
+		  $l = join '.', @lparts;
+#		  chop $dirfn;               # remove trailing /
+		  $cmd_cache{"$short_cmd"} = join(',', ($path, "$dirfn$l"));   # cache it
+          dbg('command', "got path: $path cmd: $dirfn$l\n");
+		  return ($path, "$dirfn$l"); 
 		}
 	  }
 	}
@@ -319,7 +346,7 @@ sub eval_file {
 	}
 	if ($@) {
 	  delete_package($package);
-	  return (0, "Syserr: Eval err $@ on $package");
+	  return (1, "Syserr: Eval err $@ on $package");
 	}
 		
 	#cache it unless we're cleaning out each time
@@ -329,10 +356,10 @@ sub eval_file {
   my @r;
   my $c = qq{ \@r = \$self->$package(\@_); };
   dbg('eval', "cluster cmd = $c\n");
-  eval  $c; ;
+  eval  $c;
   if ($@) {
     delete_package($package);
-	return (0, "Syserr: Eval err $@ on cached $package");
+	return (1, "Syserr: Eval err $@ on cached $package");
   }
 
   #take a look if you want