X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=6fbd9f21e8dcc8ccf58e75950d34aa48e2423ad7;hb=b9dffeff7239952814342dad19db3a51def6fab7;hp=843bccdc81d15c4b24a85ed9d0e024a62884dc1e;hpb=a9b009e5b767bcf7d9ce522902635d1d462f2bab;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 843bccdc..6fbd9f21 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -9,10 +9,11 @@ package DXCommandmode; -use POSIX; +#use POSIX; @ISA = qw(DXChannel); +use POSIX qw(:math_h); use DXUtil; use DXChannel; use DXUser; @@ -53,12 +54,6 @@ $cmdimportdir = "$main::root/cmd_import"; # the base directory for importing com # 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+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - # # obtain a new connection this is derived from dxchannel # @@ -202,12 +197,23 @@ sub start my $info = Route::cluster(); $self->send("Cluster:$info"); - # send prompts and things + # send prompts for qth, name and things $self->send($self->msg('namee1')) if !$user->name; $self->send($self->msg('qthe1')) if !$user->qth; $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); + + # send out any buddy messages for other people that are online + foreach my $call (@{$user->buddies}) { + my $ref = Route::User::get($call); + if ($ref) { + foreach my $node (@{$ref->parent}) { + $self->send($self->msg($node eq $main::mycall ? 'loginb' : 'loginbn', $call, $node)); + } + } + } + $self->lastmsgpoll($main::systime); $self->prompt; } @@ -574,7 +580,7 @@ sub disconnect # send info to all logged in thingies $self->tell_login('logoutu'); - $self->tell_login('logoutb'); + $self->tell_buddies('logoutb'); LogDbg('DXCommand', "$call disconnected"); @@ -588,6 +594,9 @@ sub disconnect sub prompt { my $self = shift; + + return if $self->{gtk}; # 'cos prompts are not a concept that applies here + my $call = $self->call; my $date = cldate($main::systime); my $time = ztime($main::systime); @@ -785,6 +794,18 @@ sub find_cmd_name { return $package; } +sub send +{ + my $self = shift; + if ($self->{gtk}) { + for (@_) { + $self->SUPER::send(dd(['cmd',$_])); + } + } else { + $self->SUPER::send(@_); + } +} + sub local_send { my ($self, $let, $buf) = @_; @@ -804,7 +825,13 @@ sub talk { my ($self, $from, $to, $via, $line) = @_; $line =~ s/\\5E/\^/g; - $self->local_send('T', "$to de $from: $line") if $self->{talk}; + if ($self->{talk}) { + if ($self->{gtk}) { + $self->local_send('T', dd(['talk',$to,$from,$via,$line])); + } else { + $self->local_send('T', "$to de $from: $line"); + } + } Log('talk', $to, $from, $via?$via:$main::mycall, $line); # send a 'not here' message if required unless ($self->{here} && $from ne $to) { @@ -846,9 +873,14 @@ sub announce return if $_[0] ne $main::myalias && $_[0] ne $main::mycall; } return if $target eq 'SYSOP' && $self->{priv} < 5; - my $buf = "$to$target de $_[0]: $text"; - $buf =~ s/\%5E/^/g; - $buf .= "\a\a" if $self->{beep}; + my $buf; + if ($self->{gtk}) { + $buf = dd(['ann', $to, $target, $text, @_]) + } else { + $buf = "$to$target de $_[0]: $text"; + $buf =~ s/\%5E/^/g; + $buf .= "\a\a" if $self->{beep}; + } $self->local_send($target eq 'WX' ? 'W' : 'N', $buf); } @@ -866,9 +898,14 @@ sub chat return unless grep uc $_ eq $target, @{$self->{user}->{group}}; $text =~ s/^\#\d+ //; - my $buf = "$target de $_[0]: $text"; - $buf =~ s/\%5E/^/g; - $buf .= "\a\a" if $self->{beep}; + my $buf; + if ($self->{gtk}) { + $buf = dd(['chat', $to, $target, $text, @_]) + } else { + $buf = "$target de $_[0]: $text"; + $buf =~ s/\%5E/^/g; + $buf .= "\a\a" if $self->{beep}; + } $self->local_send('C', $buf); } @@ -923,6 +960,24 @@ sub dx_spot my $buf; if ($self->{ve7cc}) { $buf = VE7CC::dx_spot($self, @_); + } elsif ($self->{gtk}) { + my ($dxloc, $byloc); + + my $ref = DXUser->get_current($_[4]); + if ($ref) { + $byloc = $ref->qra; + $byloc = substr($byloc, 0, 4) if $byloc; + } + + my $spot = $_[1]; + $spot =~ s|/\w{1,4}$||; + $ref = DXUser->get_current($spot); + if ($ref) { + $dxloc = $ref->qra; + $dxloc = substr($dxloc, 0, 4) if $dxloc; + } + $buf = dd(['dx', @_, ($dxloc||''), ($byloc||'')]); + } else { $buf = $self->format_dx_spot(@_); $buf .= "\a\a" if $self->{beep}; @@ -946,8 +1001,14 @@ sub wwv return unless $filter; } - my $buf = "WWV de $_[6] <$_[1]>: SFI=$_[2], A=$_[3], K=$_[4], $_[5]"; - $buf .= "\a\a" if $self->{beep}; + my $buf; + if ($self->{gtk}) { + $buf = dd(['wwv', @_]) + } else { + $buf = "WWV de $_[6] <$_[1]>: SFI=$_[2], A=$_[3], K=$_[4], $_[5]"; + $buf .= "\a\a" if $self->{beep}; + } + $self->local_send('V', $buf); } @@ -965,8 +1026,13 @@ sub wcy return unless $filter; } - my $buf = "WCY de $_[10] <$_[1]> : K=$_[4] expK=$_[5] A=$_[3] R=$_[6] SFI=$_[2] SA=$_[7] GMF=$_[8] Au=$_[9]"; - $buf .= "\a\a" if $self->{beep}; + my $buf; + if ($self->{gtk}) { + $buf = dd(['wcy', @_]) + } else { + $buf = "WCY de $_[10] <$_[1]> : K=$_[4] expK=$_[5] A=$_[3] R=$_[6] SFI=$_[2] SA=$_[7] GMF=$_[8] Au=$_[9]"; + $buf .= "\a\a" if $self->{beep}; + } $self->local_send('Y', $buf); } @@ -977,7 +1043,11 @@ sub broadcast_debug foreach my $dxchan (DXChannel::get_all) { next unless $dxchan->{enhanced} && $dxchan->{senddbg}; - $dxchan->send_later('L', $s); + if ($dxchan->{gtk}) { + $dxchan->send_later('L', dd(['db', $s])); + } else { + $dxchan->send_later('L', $s); + } } }