add user startup script maintenance
authorminima <minima>
Wed, 12 Jan 2005 20:41:30 +0000 (20:41 +0000)
committerminima <minima>
Wed, 12 Jan 2005 20:41:30 +0000 (20:41 +0000)
Changes
cmd/Commands_en.hlp
cmd/send.pl
cmd/set/startup.pl [new file with mode: 0644]
cmd/show/startup.pl [new file with mode: 0644]
cmd/unset/startup.pl [new file with mode: 0644]
perl/DXCommandmode.pm
perl/Messages
perl/Script.pm

diff --git a/Changes b/Changes
index a2d22cd3558e0a356b657591659017ef1a018bf8..155e5d04e7b88cf29fa05e33e1a811c50e64969f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -15,6 +15,9 @@ as before.
 comment to be recorded.
 6. Fix bug counting backwards over a leap year in Julian.pm which meant that
 sh/dxstats doesn't start at 'yesterday' anymore.
+7. Added set/startup and show/startup commands to allow users and sysops
+to create and display startup scripts. There is also an unset/startup to
+remove a script.
 27Dec04=======================================================================
 1. add improved VE data from Charlie K1XX. You should update usdb as well.
 22Dec04=======================================================================
index eaa862ef50483d01cdd7fd7de4dc55b2b995b5e4..3aecaab0bb6cc7e55be735141ba9d03978e6ac50 100644 (file)
@@ -1724,10 +1724,6 @@ The standard prompt is defined as:
 UNSET/PROMPT will undo the SET/PROMPT command and set your prompt back to
 normal.
 
-=== 5^SET/SPIDER <call> [<call>..]^Make the callsign an DXSpider node
-Tell the system that the call(s) are to be treated as DXSpider node and
-fed new style DX Protocol rather normal user commands.
-
 === 9^SET/SYS_QRA <locator>^Set your cluster QRA Grid locator
 === 0^SET/QRA <locator>^Set your QRA Grid locator
 Tell the system what your QRA (or Maidenhead) locator is. If you have not
@@ -1755,7 +1751,27 @@ cannot use DX, ANN etc.
 
 The only exception to this is that a non-registered user can TALK or
 SEND messages to the sysop.
+
+=== 6^SET/STARTUP <call>^Create a user startup script
+=== 0^SET/STARTUP^Create your own startup script
+=== 6^UNSET/STARTUP <call>^Remove a user startup script
+=== 0^UNSET/STARTUP^Remove your own startup script
+Create a startup script of DXSpider commands which will be executed
+everytime that you login into this node. You can only input the whole
+script afresh, it is not possible to 'edit' it. Inputting a new script is
+just like typing in a message using SEND. To finish inputting type: /EX
+on a newline, to abandon the script type: /ABORT.
+
+You may find the (curiously named) command BLANK useful to break 
+up the output. If you simply want a blank line, it is easier to 
+input one or more spaces and press the <return> key.
+
+You can remove your startup script with UNSET/STARTUP.  
+
+=== 5^SET/SPIDER <call> [<call>..]^Make the callsign an DXSpider node
+Tell the system that the call(s) are to be treated as DXSpider node and
+fed new style DX Protocol rather normal user commands.
+
 === 0^SET/TALK^Allow TALK messages to come out on your terminal
 === 0^UNSET/TALK^Stop TALK messages coming out on your terminal
 
@@ -2285,6 +2301,10 @@ So for example:-
  SH/SAT AO-10 
  SH/SAT FENGYUN1 12 2
 
+=== 6^SHOW/STARTUP <call>^View a user startup script
+=== 0^SHOW/STARTUP^View your own startup script
+View the contents of a startup script created with SET/STARTUP.
+
 === 6^SHOW/STATION ALL [<regex>]^Show list of users in the system
 === 0^SHOW/STATION [<callsign> ..]^Show information about a callsign
 Show the information known about a callsign and whether (and where)
index e78aabd311eaf020852e52574aa1c54c7c340456..722200b70e031c6004938810ea1f79e1af87ef74 100644 (file)
@@ -18,6 +18,7 @@
 #
 my ($self, $line) = @_;
 return (1, $self->msg('e5')) if $self->remotecmd;
+return (1, $self->msg('e36')) unless $self->state =~ /^prompt/;
 
 my @out;
 my $loc = $self->{loc} = {};
diff --git a/cmd/set/startup.pl b/cmd/set/startup.pl
new file mode 100644 (file)
index 0000000..0c0c24b
--- /dev/null
@@ -0,0 +1,24 @@
+#
+# create or replace a startup script
+#
+# Copyright (c) 2005 Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return (1, $self->msg('e5')) if $self->remotecmd;
+return (1, $self->msg('e5')) if $line && $self->priv < 6;
+return (1, $self->msg('e36')) unless $self->state =~ /^prompt/;
+
+my @out;
+my $loc = $self->{loc} = { call => ($line || $self->call),
+                                                  endaction => "store_startup_script",
+                                                  lines => [],
+                                                };
+# find me and set the state and the function on my state variable to
+# keep calling me for every line until I relinquish control
+$self->func("do_entry_stuff");
+$self->state('enterbody');
+push @out, $self->msg('m8');
+return (1, @out);
+
diff --git a/cmd/show/startup.pl b/cmd/show/startup.pl
new file mode 100644 (file)
index 0000000..1f160c1
--- /dev/null
@@ -0,0 +1,16 @@
+#
+# print a startup script
+#
+# Copyright (c) 2005 Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return (1, $self->msg('e5')) if $self->remotecmd;
+return (1, $self->msg('e5')) if $line && $self->priv < 5;
+
+my @out;
+
+my $s = Script->new($line || $self->call);
+push @out, $s->lines if $s;
+return (1, @out);
diff --git a/cmd/unset/startup.pl b/cmd/unset/startup.pl
new file mode 100644 (file)
index 0000000..36ee830
--- /dev/null
@@ -0,0 +1,16 @@
+#
+# remove a startup script
+#
+# Copyright (c) 2005 Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return (1, $self->msg('e5')) if $self->remotecmd;
+return (1, $self->msg('e5')) if $line && $self->priv < 5;
+
+my @out;
+
+Script::erase($line || $self->call);
+push @out, $self->msg('done');
+return (1, @out);
index 1004544255610b92df8beea126e2ec90f4caa37d..7b69ad22c1b17d4e462f588b196418e5121c04d0 100644 (file)
@@ -948,6 +948,54 @@ sub broadcast_debug
        }
 }
 
+sub do_entry_stuff
+{
+       my $self = shift;
+       my $line = shift;
+       my @out;
+       
+       if ($self->state eq 'enterbody') {
+               my $loc = $self->{loc} || confess "local var gone missing" ;
+               if ($line eq "\032" || $line eq '%1A' || uc $line eq "/EX") {
+                       no strict 'refs';
+                       push @out, $loc->{endaction}($self);
+                       $self->func(undef);
+                       $self->state('prompt');
+               } elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") {
+                       push @out, $self->msg('m10');
+                       delete $loc->{lines};
+                       delete $self->{loc};
+                       $self->func(undef);
+                       $self->state('prompt');
+               } else {
+                       push @{$loc->{lines}}, length($line) > 0 ? $line : " ";
+                       # i.e. it ain't and end or abort, therefore store the line
+               }
+       } else {
+               confess "Invalid state $self->{state}";
+       }
+       return @out;
+}
+
+sub store_startup_script
+{
+       my $self = shift;
+       my $loc = $self->{loc} || confess "local var gone missing" ;
+       my @out;
+       my $call = $loc->{call} || confess "callsign gone missing";
+       confess "lines array gone missing" unless ref $loc->{lines};
+       my $r = Script::store($call, $loc->{lines});
+       if (defined $r) {
+               if ($r) {
+                       push @out, $self->msg('m19', $call, $r);
+               } else {
+                       push @out, $self->msg('m20', $call);
+               }
+       } else {
+               push @out, "error opening startup script $call $!";
+       } 
+       return @out;
+}
 
 1;
 __END__
index a79debbc93581c33195eda81fcd6eb96df9c127e..e20adbd24e5a33d94e4a2bc5c4e504c9d82f7708 100644 (file)
@@ -98,6 +98,7 @@ package DXM;
                                e33 => '$_[0] is not a number of days or a valid date',
                                e34 => 'Need a GROUP and some text',
                                e35 => 'You are not a member of $_[0], join $_[0]',
+                               e36 => 'You can only do this in normal user prompt state',
 
                                echoon => 'Echoing enabled',
                                echooff => 'Echoing disabled',
@@ -171,9 +172,9 @@ package DXM;
                                m5 => 'Sorry, I need a message number', 
                                m6 => 'Reply to: $_[0]',
                                m7 => 'Subject : $_[0]',
-                               m8 => 'Enter Message /EX to send or /ABORT to exit',
+                               m8 => 'Enter lines of text, /EX to send or /ABORT to exit',
                                m9 => 'New mail has arrived for you',
-                               m10 => 'Message Aborted',
+                               m10 => 'Message/Script Aborted',
                                m11 => 'Message no $_[0] saved and directed to $_[1]',
                                m12 => 'Message no $_[0] deleted',
                                m13 => 'Message no $_[0] missing',
@@ -182,6 +183,8 @@ package DXM;
                                m16 => 'Need a Message number',
                                m17 => 'Sorry, cannot send messages in $_[0] mode',
                                m18 => 'Sorry, message $_[0] is currently set to KEEP',
+                               m19 => 'Startup Script for $_[0] saved, $_[1] lines',
+                               m20 => 'Empty Startup Script for $_[0] deleted',
                                msg1 => 'Bulletin Messages Queued',
                                msg2 => 'Private Messages Queued',
                                msg3 => 'Msg $_[0]: $_[1] changed from $_[2] to $_[3]',
index 3128dcde6486021bdce8ef15379f70f505108873..8fdd806496c34df3c684abad02b98b46326fb6d7 100644 (file)
@@ -25,10 +25,17 @@ $main::branch += $BRANCH;
 
 my $base = "$main::root/scripts";
 
+sub clean
+{
+       my $s = shift;
+       $s =~ s/[^-\w\.]//g;
+       return $s;
+}
+
 sub new
 {
        my $pkg = shift;
-       my $script = shift;
+       my $script = clean(lc shift);
        my $fn = "$base/$script";
 
        my $fh = new IO::File $fn;
@@ -41,7 +48,7 @@ sub new
        }
        $fh->close;
        $self->{lines} = \@lines;
-       return $self;
+       return bless $self, $pkg;
 }
 
 sub run
@@ -60,3 +67,35 @@ sub run
                }
        }
 }
+
+sub store
+{
+       my $call = clean(lc shift);
+       my @out;
+       my $ref = ref $_[0] ? shift : \@_;
+       my $count;
+       my $fn = "$base/$call";
+
+    rename $fn, "$fn.o" if -e $fn;
+       my $f = IO::File->new(">$fn") || return undef;
+       for (@$ref) {
+               $f->print("$_\n");
+               $count++;
+       }
+       $f->close;
+       unlink $fn unless $count;
+       return $count;
+}
+
+sub lines
+{
+       my $self = shift;
+       return @{$self->{lines}};
+}
+
+sub erase
+{
+       my $call = clean(lc shift);
+       my $fn = "$base/$call";
+       unlink $fn;
+}