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=======================================================================
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
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
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)
#
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} = {};
--- /dev/null
+#
+# 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);
+
--- /dev/null
+#
+# 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);
--- /dev/null
+#
+# 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);
}
}
+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__
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',
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',
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]',
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;
}
$fh->close;
$self->{lines} = \@lines;
- return $self;
+ return bless $self, $pkg;
}
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;
+}