X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=80a31ed517a6829d91c4cf5ae034478403cf711f;hb=5f2487385b59dbe88dc763fa9c26fe5a9b4a6b30;hp=e49498574415692f7543d95cf89e5c6050db791d;hpb=022706c9f44ade7f23fcfa76efcdcd61c98829a7;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index e4949857..80a31ed5 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -37,7 +37,7 @@ use DB_File; use VE7CC; use strict; -use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug $maxbadcount); +use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug $maxbadcount $msgpolltime); %Cache = (); # cache of dynamically loaded routine's mod times %cmd_cache = (); # cache of short names @@ -46,6 +46,7 @@ $errstr = (); # error string from eval $scriptbase = "$main::root/scripts"; # the place where all users start scripts go $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 use vars qw($VERSION $BRANCH); @@ -182,6 +183,7 @@ sub start $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long); $self->send($self->msg('hnodee1')) if !$user->qth; $self->send($self->msg('m9')) if DXMsg::for_me($call); + $self->lastmsgpoll($main::systime); $self->prompt; } @@ -492,6 +494,12 @@ sub process foreach $dxchan (@dxchan) { next if $dxchan->sort ne 'U'; + + # send a outstanding message prompt if required + if ($t >= $dxchan->lastmsgpoll + $msgpolltime) { + $dxchan->send($dxchan->msg('m9')) if DXMsg::for_me($dxchan->call); + $dxchan->lastmsgpoll($t); + } # send a prompt if no activity out on this channel if ($t >= $dxchan->t + $main::user_interval) { @@ -549,11 +557,18 @@ sub disconnect sub prompt { my $self = shift; - if ($self->{prompt}) { - $self->send($self->{prompt}); - } else { - $self->send($self->msg($self->here ? 'pr' : 'pr2', $self->call, cldate($main::systime), ztime($main::systime))); - } + my $call = $self->call; + my $date = cldate($main::systime); + my $time = ztime($main::systime); + my $prompt = $self->{prompt} || $self->msg('pr'); + + $call = "($call)" unless $self->here; + $prompt =~ s/\%C/$call/g; + $prompt =~ s/\%D/$date/g; + $prompt =~ s/\%T/$time/g; + $prompt =~ s/\%M/$main::mycall/g; + + $self->send($prompt); } # broadcast a message to all users [except those mentioned after buffer] @@ -933,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); # like this for < 5.8.0 + $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__