From 06392dc488efff54948322d2c312f2899d12b7d9 Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Wed, 25 May 2005 19:49:40 +0000
Subject: [PATCH] add cmd import function

---
 Changes               |  3 ++
 perl/DXCommandmode.pm | 81 +++++++++++++++++++++++++++++++++++++++++--
 perl/Script.pm        | 57 +++++++++++++++++++++---------
 3 files changed, 123 insertions(+), 18 deletions(-)

diff --git a/Changes b/Changes
index a4858312..9d6fb71d 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+25May05=======================================================================
+1. Added a means to import a script of arbitrary commands to allow external
+programs to do stuff.
 23Mar05=======================================================================
 1. fix (un)set/badspotter so that it only stores non-ssid calls.
 2. mention action on talk and ann/full in help.
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 79ba03b0..9b395c0c 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -38,7 +38,7 @@ use VE7CC;
 
 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
@@ -48,7 +48,9 @@ $scriptbase = "$main::root/scripts"; # the place where all users start scripts g
 $maxerrors = 20;				# the maximum number of concurrent errors allowed before disconnection
 $maxbadcount = 3;				# no of bad words allowed before disconnection
 $msgpolltime = 3600;			# the time between polls for new messages 
-
+$cmdimportdir = "$main::root/cmd_import"; # the base directory for importing command scripts 
+                                          # this does not exist as default, you need to create it manually
+					  #
 
 use vars qw($VERSION $BRANCH);
 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
@@ -525,6 +527,8 @@ sub process
 			delete $nothereslug{$k};
 		}
 	}
+
+	import_cmd();
 }
 
 #
@@ -1011,5 +1015,78 @@ 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/Script.pm b/perl/Script.pm
index 24593aee..4c8d0f3b 100644
--- 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};
 }
-- 
2.43.0