From adf3cc7462a4544d2bca7f380593631edcff120b Mon Sep 17 00:00:00 2001
From: djk <djk>
Date: Fri, 5 Nov 1999 15:24:59 +0000
Subject: [PATCH] started Database work removed error checking in cluster.pl
 added readfilestr

---
 Changes               |  1 +
 perl/DXCommandmode.pm | 22 ++++++++++++++--------
 perl/DXDb.pm          |  9 +++++++++
 perl/DXMsg.pm         | 14 ++++++++++----
 perl/DXUtil.pm        | 38 +++++++++++++++++++++++++++++++++++++-
 perl/cluster.pl       | 13 +++----------
 6 files changed, 74 insertions(+), 23 deletions(-)

diff --git a/Changes b/Changes
index 557561ee..99ffb8b9 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 04Nov99=======================================================================
 1. Removed ~ from the end of the PC18.
+2. Removed a hangover from duff character checking in cluster.pl
 03Nov99=======================================================================
 1. Simplified command caching so it uses anonymous subroutines, you should
 also get error messages back on the console now when developing.
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 12c84c00..b7f8e8f4 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -10,7 +10,6 @@
 package DXCommandmode;
 
 use POSIX;
-use IO::File;
 
 @ISA = qw(DXChannel);
 
@@ -27,14 +26,16 @@ use CmdAlias;
 use Filter;
 use Carp;
 use Minimuf;
+use DXDb;
 
 use strict;
-use vars qw(%Cache %cmd_cache $errstr %aliases);
+use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase);
 
 %Cache = ();					# cache of dynamically loaded routine's mod times
 %cmd_cache = ();				# cache of short names
 $errstr = ();					# error string from eval
 %aliases = ();					# aliases for (parts of) commands
+$scriptbase = "$main::root/scripts"; # the place where all users start scripts go
 
 #
 # obtain a new connection this is derived from dxchannel
@@ -347,6 +348,14 @@ sub get_all
 	return @out;
 }
 
+# run a script for this user
+sub run_script
+{
+	my $self = shift;
+	my $silent = shift || 0;
+	
+}
+
 #
 # search for the command in the cache of short->long form commands
 #
@@ -487,15 +496,12 @@ sub find_cmd_name {
 		#print STDERR "already compiled $package->handler\n";
 		;
 	} else {
-		
-		my $fh = new IO::File;
-		if (!open $fh, $filename) {
+
+		my $sub = readfilestr($filename);
+		unless ($sub) {
 			$errstr = "Syserr: can't open '$filename' $!";
 			return undef;
 		};
-		local $/ = undef;
-		my $sub = <$fh>;
-		close $fh;
 		
 		#wrap the code into a subroutine inside our unique package
 		my $eval = qq( sub { $sub } );
diff --git a/perl/DXDb.pm b/perl/DXDb.pm
index e69de29b..1641a840 100644
--- a/perl/DXDb.pm
+++ b/perl/DXDb.pm
@@ -0,0 +1,9 @@
+#!/usr/bin/perl -w
+#
+# Database Handler module for DXSpider
+#
+# Copyright (c) 1999 Dirk Koopman G1TLH
+#
+
+
+1;
diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index b2665df8..bc6ed47e 100644
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -889,8 +889,11 @@ sub dir
 sub load_forward
 {
 	my @out;
-	do "$forwardfn" if -e "$forwardfn";
-	push @out, $@ if $@;
+	my $s = readfilestr($forwardfn);
+	if ($s) {
+		eval $s;
+		push @out, $@ if $@;
+	}
 	return @out;
 }
 
@@ -898,8 +901,11 @@ sub load_forward
 sub load_badmsg
 {
 	my @out;
-	do "$badmsgfn" if -e "$badmsgfn";
-	push @out, $@ if $@;
+	my $s = readfilestr($badmsgfn);
+	if ($s) {
+		eval $s;
+		push @out, $@ if $@;
+	}
 	return @out;
 }
 
diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 86dc9199..7fae6317 100644
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -9,12 +9,14 @@
 package DXUtil;
 
 use Date::Parse;
+use IO::File;
+
 use Carp;
 
 require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf 
-			 parray parraypairs shellregex
+			 parray parraypairs shellregex readfilestr
              print_all_fields cltounix iscallsign
             );
 
@@ -193,3 +195,37 @@ sub iscallsign
 	return 1 if $call =~ /^\d+\w+/;
 	return undef;
 }
+
+# read in a file into a string and return it. 
+# the filename can be split into a dir and file and the 
+# file can be in upper or lower case.
+# there can also be a suffix
+sub readfilestr
+{
+	my ($dir, $file, $suffix) = @_;
+	my $fn;
+	
+	if ($suffix) {
+		$fn = "$dir/$file.$suffix";
+		unless (-e $fn) {
+			my $f = uc $file;
+			$fn = "$dir/$file.$suffix";
+		}
+	} elsif ($file) {
+		$fn = "$dir/$file";
+		unless (-e $fn) {
+			my $f = uc $file;
+			$fn = "$dir/$file";
+		}
+	} else {
+		$fn = $dir;
+	}
+	my $fh = new IO::File $fn;
+	my $s = undef;
+	if ($fh) {
+		local $/ = undef;
+		$s = <$fh>;
+		$fh->close;
+	}
+	return $s;
+}
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 308b1d90..c3f61038 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -59,6 +59,7 @@ use Geomag;
 use CmdAlias;
 use Filter;
 use Local;
+use DXDb;
 use Fcntl ':flock'; 
 
 use Carp qw(cluck);
@@ -241,9 +242,6 @@ sub process_inqueue
 	# translate any crappy characters into hex characters 
 	if ($line =~ /[\x00-\x06\x08\x0a-\x1f\x7f-\xff]/o) {
 		$line =~ s/([\x00-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;
-		++$error;
-#		dbg('chan', "<- $sort $call **CRAP**: $line");
-#		return;
 	}
 	
 	# do the really sexy console interface bit! (Who is going to do the TK interface then?)
@@ -255,13 +253,8 @@ sub process_inqueue
 		$dxchan->start($line, $sort);  
 	} elsif ($sort eq 'I') {
 		die "\$user not defined for $call" if !defined $user;
-
-		if ($error) {
-			dbg('chan', "DROPPED with $error duff characters");
-		} else {
-			# normal input
-			$dxchan->normal($line);
-		}
+		# normal input
+		$dxchan->normal($line);
 		disconnect($dxchan) if ($dxchan->{state} eq 'bye');
 	} elsif ($sort eq 'Z') {
 		disconnect($dxchan);
-- 
2.43.0