From 625ce0adf070a7e900fa03714a391652db0c065a Mon Sep 17 00:00:00 2001
From: djk <djk>
Date: Thu, 18 Jun 1998 22:29:47 +0000
Subject: [PATCH] fixed a couple of errors and done a bit of tidying

---
 perl/DXChannel.pm     | 18 ++++++++++++++----
 perl/DXCommandmode.pm | 19 +++++++++++++------
 perl/DXVars.pm        |  3 +++
 perl/cluster.pl       |  5 +++--
 4 files changed, 33 insertions(+), 12 deletions(-)

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 065a78c8..9ba985a6 100644
--- 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 fb2957da..ae016cc6 100644
--- 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 11c26012..beab7953 100644
--- 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 bdd1f7d9..2f96af88 100755
--- 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 {
-- 
2.43.0