fixed a couple of errors and done a bit of tidying

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 065a78c8d7af7e06293117a99332935634cfbab2..9ba985a6773b0b1425a8d4bbf27b7ddd0fc33b45 100644 (file)
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -46,6 +46,7 @@ sub new
   $self->{user} = $user if defined $user; 
   $self->{t} = time;
   $self->{state} = 0;
+  $self->{oldstate} = 0;
   bless $self, $pkg; 
   return $channels{$call} = $self;
 }
@@ -106,8 +107,8 @@ sub send_now
     foreach $line (@_) {
       my $t = atime;
          chomp $line;
-      print main::DEBUG "$t > $sort $call $line\n" if defined DEBUG;
-         print "> $sort $call $line\n";
+      print main::DEBUG "$t -> $sort $call $line\n" if defined DEBUG;
+         print "-> $sort $call $line\n";
       $conn->send_now("$sort$call|$line");
        }
   }
@@ -135,8 +136,8 @@ sub send              # this is always later and always data
     foreach $line (@_) {
       my $t = atime;
          chomp $line;
-         print main::DEBUG "$t > D $call $line\n" if defined DEBUG;
-         print "> D $call $line\n";
+         print main::DEBUG "$t -> D $call $line\n" if defined DEBUG;
+         print "-> D $call $line\n";
          $conn->send_later("D$call|$line");
        }
   }
@@ -163,5 +164,14 @@ sub msg
   $self->send(DXM::msg(@_));
 }
 
+# change the state of the channel - lots of scope for debugging here :-)
+sub state
+{
+  my $self = shift;
+  $self->{oldstate} = $self->{state};
+  $self->{state} = shift;
+  print "Db   $self->{call} channel state $self->{oldstate} -> $self->{state}\n" if $main::debug;
+}
+
 1;
 __END__;

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index fb2957da39da7798035ca96890ae87faebb138a7..ae016cc6fd038250cf11d7158c80ce4486da7024 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -34,7 +34,7 @@ sub user_start
   $self->msg('l2',$name);
   $self->send_file($main::motd) if (-e $main::motd);
   $self->msg('pr', $call);
-  $self->{state} = 10;                # a bit of room for further expansion, passwords etc
+  $self->state('prompt');                  # a bit of room for further expansion, passwords etc
   $self->{priv} = 0;                  # set the connection priv to 0 - can be upgraded later
 }
 
@@ -52,12 +52,19 @@ sub user_normal
   scan_cmd_dirs if (!defined %cmd);
   
   # strip out any nasty characters like $@%&|. and double // etc.
-  $cmd =~ s/[\%\@\$\&\|\.\`\~]//og;
+  $cmd =~ s/[%\@\$&\\.`~]//og;
   $cmd =~ s|//|/|og;
   
   # split the command up into parts
-  my @parts = split |[/\b]+|, $cmd;
-  
+  my @part = split /[\/\b]+/, $cmd;
+
+  # the bye command - temporary probably
+  if ($part[0] =~ /^b/io) {
+    $self->user_finish();
+       $self->state('bye');
+       return;
+  }
+
   # first expand out the entry to a command, note that I will accept 
   # anything in any case with any (reasonable) seperator
   $self->prompt();
@@ -150,7 +157,7 @@ sub eval_file {
   my($self, $path, $cmdname) = @_;
   my $package = valid_package_name($cmdname);
   my $filename = "$path/$cmdname";
-  my $mtime = -m $filename;
+  my $mtime = -M $filename;
   my @r;
   
   if(defined $Cache{$package}{mtime} && $Cache{$package}{mtime } <= $mtime) {
@@ -179,7 +186,7 @@ sub eval_file {
        }
                
        #cache it unless we're cleaning out each time
-       $Cache{$package}{mtime} = $mtime unless $delete;
+       $Cache{$package}{mtime} = $mtime;
   }
 
   @r = eval {$package->handler;};

diff --git a/perl/DXVars.pm b/perl/DXVars.pm
index 11c26012735ede6361f65eae60b3ef50ffce02c7..beab79530728bea1cfe716b9e5c871dcaa6b8eb5 100644 (file)
--- a/perl/DXVars.pm
+++ b/perl/DXVars.pm
@@ -82,3 +82,6 @@ $userfn = "$data/users";
 
 # the "message of the day" file
 $motd = "$data/motd";
+
+# are we debugging ?
+$debug = 1;

diff --git a/perl/cluster.pl b/perl/cluster.pl
index bdd1f7d9c2020b5252be34f54d9cddf736488459..2f96af8814e9a2e2333e0d9118716bf61e28210e 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -98,8 +98,8 @@ sub process_inqueue
   my ($sort, $call, $line) = $data =~ /^(\w)(\S+)\|(.*)$/;
   
   # do the really sexy console interface bit! (Who is going to do the TK interface then?)
-  print DEBUG atime, " < $sort $call $line\n" if defined DEBUG;
-  print "< $sort $call $line\n";
+  print DEBUG atime, " <- $sort $call $line\n" if defined DEBUG;
+  print "<- $sort $call $line\n";
   
   # handle A records
   my $user = $dxchan->{user};
@@ -117,6 +117,7 @@ sub process_inqueue
        } else {
          $dxchan->user_normal($line);
        }
+    disconnect($dxchan) if ($dxchan->{state} eq 'bye');
   } elsif ($sort eq 'Z') {
     disconnect($dxchan);
   } else {