add import_cmd and other tidyups

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 1c581b5fdc12d48a1430d608fda77529077aa8e6..f6049236703af8b3a3b6ddbf187bd6126c3473cd 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -42,7 +42,7 @@ use Thingy::Bye;
 
 use strict;
 use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug
-                       $maxbadcount $msgpolltime $default_pagelth);
+                       $maxbadcount $msgpolltime $default_pagelth $cmdimportdir);
 
 %Cache = ();                                   # cache of dynamically loaded routine's mod times
 %cmd_cache = ();                               # cache of short names
@@ -53,6 +53,8 @@ $maxerrors = 20;                              # the maximum number of concurrent errors allowed before dis
 $maxbadcount = 3;                              # no of bad words allowed before disconnection
 $msgpolltime = 3600;                   # the time between polls for new messages 
 $default_pagelth = 20;                 # the default page length 0 = unlimited
+$cmdimportdir = "$main::root/cmd_import"; # the base directory for importing command scripts 
+                                          # this does not exist as default, you need to create it manually
 
 
 
@@ -531,6 +533,8 @@ sub process
                        delete $nothereslug{$k};
                }
        }
+
+       import_cmd();
 }
 
 #
@@ -614,14 +618,6 @@ sub get_all
        return grep {$_->{sort} eq 'U'} DXChannel::get_all();
 }
 
-# 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
 #
@@ -963,5 +959,79 @@ sub store_startup_script
        return @out;
 }
 
+# Import any commands contained in any files in import_cmd directory
+#
+# If the filename has a recogisable callsign as some delimited part
+# of it, then this is the user the command will be run as. 
+#
+sub import_cmd
+{
+       # are there any to do in this directory?
+       return unless -d $cmdimportdir;
+       unless (opendir(DIR, $cmdimportdir)) {
+               dbg("can\'t open $cmdimportdir $!");
+               Log('err', "can\'t open $cmdimportdir $!");
+               return;
+       } 
+
+       my @names = readdir(DIR);
+       closedir(DIR);
+       my $name;
+       foreach $name (@names) {
+               next if $name =~ /^\./;
+
+               my $s = Script->new($name, $cmdimportdir);
+               if ($s) {
+
+                       dbg("Run import cmd file $name");
+                       Log('DXCommand', "Run import cmd file $name");
+                       my @cat = split /[^A-Za-z0-9]+/, $name;
+                       my ($call) = grep {is_callsign(uc $_)} @cat;
+                       $call ||= $main::mycall;
+                       $call = uc $call;
+                       my @out;
+                       
+                       
+                       $s->inscript(0);        # switch off script checks
+                       
+                       if ($call eq $main::mycall) {
+                               @out = $s->run($main::me, 1);
+                       } else {
+                               my $dxchan = DXChannel::get($call);
+                           if ($dxchan) {
+                                       @out = $s->run($dxchan, 1);
+                               } else {
+                                       my $u = DXUser->get($call);
+                                       if ($u) {
+                                               $dxchan = $main::me;
+                                               my $old = $dxchan->{call};
+                                               my $priv = $dxchan->{priv};
+                                               my $user = $dxchan->{user};
+                                               $dxchan->{call} = $call;
+                                               $dxchan->{priv} = $u->priv;
+                                               $dxchan->{user} = $u;
+                                               @out = $s->run($dxchan, 1);
+                                               $dxchan->{call} = $call;
+                                               $dxchan->{priv} = $priv;
+                                               $dxchan->{user} = $user;
+                                       } else {
+                                               Log('err', "Trying to run import cmd for non-existant user $call");
+                                               dbg( "Trying to run import cmd for non-existant user $call");
+                                       }
+                               }
+                       }
+                       $s->erase;
+                       for (@out) {
+                               Log('DXCommand', "Import cmd $name/$call: $_");
+                               dbg("Import cmd $name/$call: $_");
+                       }
+               } else {
+                       Log("Failed to open $cmdimportdir/$name $!");
+                       dbg("Failed to open $cmdimportdir/$name $!");
+                       unlink "$cmdimportdir/$name";
+               }
+       }
+}
+
 1;
 __END__

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index ec395d207b174459118d637179ed402cd8c481a8..16c91803950701bfccd329de119a87208aa66dc7 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -2415,7 +2415,6 @@ sub import_chat
        my $name;
        foreach $name (@names) {
                next if $name =~ /^\./;
-               my $splitit = $name =~ /^split/;
                my $fn = "$chatimportfn/$name";
                next unless -f $fn;
                unless (open(MSG, $fn)) {

diff --git a/perl/Script.pm b/perl/Script.pm
index 24593aee92fa22e85b436a2efca7c134b467cdc3..4c8d0f3bf3f3af1a55b3dc699e22375068fe0bc1 100644 (file)
--- a/perl/Script.pm
+++ b/perl/Script.pm
@@ -35,12 +35,22 @@ sub clean
 sub new
 {
        my $pkg = shift;
-       my $script = clean(lc shift);
-       my $fn = "$base/$script";
+       my $script = clean(shift);
+       my $mybase = shift || $base;
+       my $fn = "$mybase/$script";
 
-       my $fh = new IO::File $fn;
-       return undef unless $fh;
-       my $self = bless {call => $script}, $pkg;
+       my $self = {call => $script};
+       my $fh = IO::File->new($fn);
+       if ($fh) {
+               $self->{fn} = $fn;
+       } else {
+               $fh = IO::File->new(lc $fn);
+               if ($fh) {
+                       $self->{fn} = $fn;
+               } else {
+                       return undef;
+               }
+       }
        my @lines;
        while (<$fh>) {
                chomp;
@@ -48,6 +58,7 @@ sub new
        }
        $fh->close;
        $self->{lines} = \@lines;
+       $self->{inscript} = 1;
        return bless $self, $pkg;
 }
 
@@ -55,19 +66,34 @@ sub run
 {
        my $self = shift;
        my $dxchan = shift;
+       my $return_output = shift;
+       my @out;
+       
        foreach my $l (@{$self->{lines}}) {
                unless ($l =~ /^\s*\#/ || $l =~ /^\s*$/) {
-                       $dxchan->inscript(1);
-                       my @out = DXCommandmode::run_cmd($dxchan, $l);
-                       $dxchan->inscript(0);
-                       if ($dxchan->can('send_ans')) {
-                               $dxchan->send_ans(@out);
-                       } else {
-                               dbg($_) for @out;
-                       }
+                       $dxchan->inscript(1) if $self->{inscript};
+                       push @out, DXCommandmode::run_cmd($dxchan, $l);
+                       $dxchan->inscript(0) if $self->{inscript};
                        last if @out && $l =~ /^pri?v?/i;
                }
        }
+       if ($return_output) {
+               return @out;
+       } else {
+               if ($dxchan->can('send_ans')) {
+                       $dxchan->send_ans(@out);
+               } else {
+                       dbg($_) for @out;
+               }
+       }
+       return ();
+}
+
+sub inscript
+{
+       my $self = shift;
+       $self->{inscript} = shift if @_;
+       return $self->{inscript};
 }
 
 sub store
@@ -97,7 +123,6 @@ sub lines
 
 sub erase
 {
-       my $call = clean(lc shift);
-       my $fn = "$base/$call";
-       unlink $fn;
+       my $self = shift;
+       unlink $self->{fn};
 }

diff --git a/perl/cluster.pl b/perl/cluster.pl
index af1fe2e70cc26e8abd6f08b8b7b9accdf9269029..359ab0975ddd767f923c93d0ed3fe9babe329e3d 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -165,7 +165,9 @@ $build = "$build.$branch" if $branch;
 Log('cluster', "DXSpider V$version, build $build started");
 
 # banner
-dbg("Copyright (c) 1998-2002 Dirk Koopman G1TLH");
+my ($year) = (gmtime)[5];
+$year += 1900;
+dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH");
 dbg("DXSpider Version $version, build $build started");
 
 # load Prefixes

diff --git a/perl/showdx b/perl/showdx
index 9af8f41bcfba489681c86419da5a12e819bf964f..2ca142c316f3d01e1b80972de4aec7b58641b0f6 100755 (executable)
--- a/perl/showdx
+++ b/perl/showdx
@@ -15,6 +15,8 @@ BEGIN {
        
        unshift @INC, "$root/perl";     # this IS the right way round!
        unshift @INC, "$root/local";
+
+       sub main::mkver {}
 }
 
 use IO::Handle;