fix DXChannel->get to DXChannel::get
[spider.git] / perl / DXCommandmode.pm
index 76bfa9314926046d12ed18a00a3221746f497b82..6eee5d457cc00aca7b0ea6143a96dca280df4d0b 100644 (file)
@@ -34,9 +34,10 @@ use Script;
 use Net::Telnet;
 use QSL;
 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
@@ -45,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);
@@ -127,7 +129,12 @@ sub start
 
 
        # decide which motd to send
-       my $motd = "${main::motd}_nor" unless $self->{registered};
+       my $motd;
+       unless ($self->{registered}) {
+               $motd = "${main::motd}_nor_$self->{lang}";
+               $motd = "${main::motd}_nor" unless -e $motd;
+       }
+       $motd = "${main::motd}_$self->{lang}" unless $motd && -e $motd;
        $motd = $main::motd unless $motd && -e $motd;
        $self->send_file($motd) if -e $motd;
 
@@ -181,6 +188,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;
 }
 
@@ -418,15 +426,14 @@ sub run_cmd
 
        return () if length $cmdline == 0;
                
-       # strip out //
-       $cmdline =~ s|//|/|og;
-               
        # split the command line up into parts, the first part is the command
        my ($cmd, $args) = split /\s+/, $cmdline, 2;
        $args = "" unless defined $args;
                
        if ($cmd) {
-                       
+               # strip out // on command only
+               $cmd =~ s|//|/|g;
+                                       
                my ($path, $fcmd);
                        
                dbg("cmd: $cmd") if isdbg('command');
@@ -487,11 +494,17 @@ sub run_cmd
 sub process
 {
        my $t = time;
-       my @dxchan = DXChannel->get_all();
+       my @dxchan = DXChannel::get_all();
        my $dxchan;
        
        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 +562,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]
@@ -562,7 +582,7 @@ sub broadcast
        my $pkg = shift;                        # ignored
        my $s = shift;                          # the line to be rebroadcast
        
-    foreach my $dxchan (DXChannel->get_all()) {
+    foreach my $dxchan (DXChannel::get_all()) {
                next unless $dxchan->{sort} eq 'U'; # only interested in user channels  
                next if grep $dxchan == $_, @_;
                $dxchan->send($s);                      # send it
@@ -572,7 +592,7 @@ sub broadcast
 # gimme all the users
 sub get_all
 {
-       return grep {$_->{sort} eq 'U'} DXChannel->get_all();
+       return grep {$_->{sort} eq 'U'} DXChannel::get_all();
 }
 
 # run a script for this user
@@ -824,35 +844,22 @@ sub chat
        $self->local_send('C', $buf);
 }
 
-# send a dx spot
-sub dx_spot
+sub format_dx_spot
 {
        my $self = shift;
-       my $line = shift;
-       my $isolate = shift;
-       my ($filter, $hops);
-
-       return unless $self->{dx};
-       
-       if ($self->{spotsfilter}) {
-               ($filter, $hops) = $self->{spotsfilter}->it(@_ );
-               return unless $filter;
-       }
 
-
-       dbg('spot: "' . join('","', @_) . '"') if isdbg('dxspot');
-       
        my $t = ztime($_[2]);
-       my $loc;
+       my $loc = '';
        my $clth = $self->{consort} eq 'local' ? 29 : 30;
        my $comment = substr $_[3], 0, $clth; 
        $comment .= ' ' x ($clth - length($comment));
-       my $ref = DXUser->get_current($_[4]);
-       if ($ref) {
-               $loc = $ref->qra || '' if $self->{user}->wantgrid; 
-               $loc = ' ' . substr($loc, 0, 4) if $loc;
-       } 
-       $loc = "" unless $loc;
+       if ($self->{user}->wantgrid) { 
+               my $ref = DXUser->get_current($_[4]);
+               if ($ref) {
+                       $loc = $ref->qra || '';
+                       $loc = ' ' . substr($loc, 0, 4) if $loc;
+               }
+       }
 
        if ($self->{user}->wantdxitu) {
                $loc = ' ' . sprintf("%2d", $_[10]) if defined $_[10];
@@ -865,10 +872,35 @@ sub dx_spot
                $comment = substr($comment, 0,  $self->{consort} eq 'local' ? 26 : 27) . ' ' . $_[12] if $_[12]; 
        }
 
-       my $buf = sprintf "DX de %-7.7s%11.1f  %-12.12s %-s $t$loc", "$_[4]:", $_[0], $_[1], $comment;
-       
-       $buf .= "\a\a" if $self->{beep};
-       $buf =~ s/\%5E/^/g;
+       return sprintf "DX de %-7.7s%11.1f  %-12.12s %-s $t$loc", "$_[4]:", $_[0], $_[1], $comment;
+}
+
+# send a dx spot
+sub dx_spot
+{
+       my $self = shift;
+       my $line = shift;
+       my $isolate = shift;
+       return unless $self->{dx};
+
+       my ($filter, $hops);
+
+       if ($self->{spotsfilter}) {
+               ($filter, $hops) = $self->{spotsfilter}->it(@_ );
+               return unless $filter;
+       }
+
+       dbg('spot: "' . join('","', @_) . '"') if isdbg('dxspot');
+
+       my $buf;
+       if ($self->{ve7cc}) {
+               $buf = VE7CC::dx_spot($self, @_);
+       } else {
+               $buf = $self->format_dx_spot(@_);
+               $buf .= "\a\a" if $self->{beep};
+               $buf =~ s/\%5E/^/g;
+       }
+
        $self->local_send('X', $buf);
 }
 
@@ -915,12 +947,60 @@ sub broadcast_debug
 {
        my $s = shift;                          # the line to be rebroadcast
        
-       foreach my $dxchan (DXChannel->get_all) {
+       foreach my $dxchan (DXChannel::get_all) {
                next unless $dxchan->{enhanced} && $dxchan->{senddbg};
                $dxchan->send_later('L', $s);
        }
 }
 
+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__