started Database work

removed error checking in cluster.pl
added readfilestr

diff --git a/Changes b/Changes
index 557561ee2e8a826a4d5fb5e4a997628f6811fdf1..99ffb8b9e6417e59e530b0d4af9d1614503036b4 100644 (file)
--- 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 12c84c009d7310d1ac7b57f163caca3f62153aaa..b7f8e8f4fc9e78a15f43b928c6aad5b900081c27 100644 (file)
--- 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 e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..1641a8401997cd0eb37057838acc1ecd7c86d9ee 100644 (file)
--- 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 b2665df8f0a6cf5786782e1f85035e93b3d91723..bc6ed47e455d70dbeb5d332f8f634b26700bc6f2 100644 (file)
--- 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 86dc91998fb6408bd6f2e4e3b293019a86ef51ec..7fae63170d015345b5372ab41c234d7d14a538fc 100644 (file)
--- 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 308b1d90b987104618df84182a10399b6f94ea38..c3f61038fda99ed19f746b92e58b6c99d5bb423a 100755 (executable)
--- 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);