From adf3cc7462a4544d2bca7f380593631edcff120b Mon Sep 17 00:00:00 2001 From: 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