X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=71efaef733d2db6d0c0f68b51384bb74d0b87535;hb=c1a9cb4e04fb7db7898b05542e671c4e9e55fb93;hp=29840c410e4c788359f97cbe26780dce0ce0519d;hpb=cbf3c0cd90df4c4df05dae6a00d03f7f9482d631;p=spider.git

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 29840c41..71efaef7 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;
@@ -35,6 +36,7 @@ use Net::Telnet;
 use QSL;
 use DB_File;
 use VE7CC;
+use DXXml;
 
 use strict;
 use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug
@@ -53,10 +55,7 @@ $cmdimportdir = "$main::root/cmd_import"; # the base directory for importing com
 					  #
 
 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;
+($VERSION, $BRANCH) = dxver(q$Revision$);
 
 #
 # obtain a new connection this is derived from dxchannel
@@ -73,7 +72,10 @@ sub new
 
 	# ALWAYS output the user
 	my $ref = Route::User::get($call);
-	$main::me->route_pc16($main::mycall, undef, $main::routeroot, $ref) if $ref;
+	if ($ref) {
+		$main::me->route_pc16($main::mycall, undef, $main::routeroot, $ref);
+		$main::me->route_pc92a($main::mycall, undef, $main::routeroot, $ref);
+	}
 
 	return $self;
 }
@@ -93,7 +95,7 @@ sub start
 	my $host = $self->{conn}->{peerhost};
 	$host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport};
 	$host ||= "unknown";
-	Log('DXCommand', "$call connected from $host");
+	LogDbg('DXCommand', "$call connected from $host");
 
 	$self->{name} = $name ? $name : $call;
 	$self->send($self->msg('l2',$self->{name}));
@@ -149,10 +151,21 @@ sub start
 	$self->{priv} = 0 if $line =~ /^(ax|te)/ && !$self->conn->{usedpasswd};
 
 	# get the filters
-	$self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'user_default', 0);
-	$self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'user_default', 0);
-	$self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'user_default', 0);
-	$self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'user_default', 0) ;
+	my $nossid = $call;
+	$nossid =~ s/-\d+$//;
+	
+	$self->{spotsfilter} = Filter::read_in('spots', $call, 0) 
+		|| Filter::read_in('spots', $nossid, 0)
+			|| Filter::read_in('spots', 'user_default', 0);
+	$self->{wwvfilter} = Filter::read_in('wwv', $call, 0) 
+		|| Filter::read_in('wwv', $nossid, 0) 
+			|| Filter::read_in('wwv', 'user_default', 0);
+	$self->{wcyfilter} = Filter::read_in('wcy', $call, 0) 
+		|| Filter::read_in('wcy', $nossid, 0) 
+			|| Filter::read_in('wcy', 'user_default', 0);
+	$self->{annfilter} = Filter::read_in('ann', $call, 0) 
+		|| Filter::read_in('ann', $nossid, 0) 
+			|| Filter::read_in('ann', 'user_default', 0) ;
 
 	# clean up qra locators
 	my $qra = $user->qra;
@@ -172,6 +185,7 @@ sub start
 	}
 	
 	$self->tell_login('loginu');
+	$self->tell_buddies('loginb');
 	
 	# do we need to send a forward/opernam?
 	my $lastoper = $user->lastoper || 0;
@@ -189,12 +203,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;
 }
@@ -297,7 +322,7 @@ sub normal
 					my @bad;
 					if (@bad = BadWords::check($l)) {
 						$self->badcount(($self->badcount||0) + @bad);
-						Log('DXCommand', "$self->{call} swore: $l");
+						LogDbg('DXCommand', "$self->{call} swore: $l with words:" . join(',', @bad) . ")");
 					} else {
 						for (@{$self->{talklist}}) {
 							$self->send_talks($_, $l);
@@ -359,11 +384,11 @@ sub send_talks
 	
 	my ($to, $via) = $ent =~ /(\S+)>(\S+)/;
 	$to = $ent unless $to;
-	my $call = $via ? $via : $to;
+	my $call = $via && $via ne '*' ? $via : $to;
 	my $clref = Route::get($call);
 	my $dxchan = $clref->dxchan if $clref;
 	if ($dxchan) {
-		$dxchan->talk($self->{call}, $to, $via, $line);
+		$dxchan->talk($self->{call}, $to, undef, $line);
 	} else {
 		$self->send($self->msg('disc2', $via ? $via : $to));
 		my @l = grep { $_ ne $ent } @{$self->{talklist}};
@@ -552,6 +577,7 @@ sub disconnect
 
 		# issue a pc17 to everybody interested
 		$main::me->route_pc17($main::mycall, undef, $main::routeroot, $uref);
+		$main::me->route_pc92d($main::mycall, undef, $main::routeroot, $uref);
 	} else {
 		confess "trying to disconnect a non existant user $call";
 	}
@@ -561,8 +587,9 @@ sub disconnect
 		
 	# send info to all logged in thingies
 	$self->tell_login('logoutu');
+	$self->tell_buddies('logoutb');
 
-	Log('DXCommand', "$call disconnected");
+	LogDbg('DXCommand', "$call disconnected");
 
 	$self->SUPER::disconnect;
 }
@@ -574,6 +601,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);
@@ -771,6 +801,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) = @_;
@@ -790,7 +832,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) {
@@ -832,9 +880,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);
 }
 
@@ -852,9 +905,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);
 }
 
@@ -909,6 +967,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};
@@ -932,8 +1008,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);
 }
 
@@ -951,8 +1033,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);
 }
 
@@ -963,7 +1050,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);
+		}
 	}
 }
 
@@ -1026,8 +1117,7 @@ sub import_cmd
 	# are there any to do in this directory?
 	return unless -d $cmdimportdir;
 	unless (opendir(DIR, $cmdimportdir)) {
-		dbg("can\'t open $cmdimportdir $!");
-		Log('err', "can\'t open $cmdimportdir $!");
+		LogDbg('err', "can\'t open $cmdimportdir $!");
 		return;
 	} 
 
@@ -1039,9 +1129,7 @@ sub import_cmd
 
 		my $s = Script->new($name, $cmdimportdir);
 		if ($s) {
-
-			dbg("Run import cmd file $name");
-			Log('DXCommand', "Run import cmd file $name");
+			LogDbg('DXCommand', "Run import cmd file $name");
 			my @cat = split /[^A-Za-z0-9]+/, $name;
 			my ($call) = grep {is_callsign(uc $_)} @cat;
 			$call ||= $main::mycall;
@@ -1072,22 +1160,26 @@ sub import_cmd
 						$dxchan->{priv} = $priv;
 						$dxchan->{user} = $user;
 					} else {
-						Log('err', "Trying to run import cmd for non-existant user $call");
-						dbg( "Trying to run import cmd for non-existant user $call");
+						LogDbg('err', "Trying to run import cmd for non-existant user $call");
 					}
 				}
 			}
 			$s->erase;
 			for (@out) {
-				Log('DXCommand', "Import cmd $name/$call: $_");
-				dbg("Import cmd $name/$call: $_");
+				LogDbg('DXCommand', "Import cmd $name/$call: $_");
 			}
 		} else {
-			Log("Failed to open $cmdimportdir/$name $!");
-			dbg("Failed to open $cmdimportdir/$name $!");
+			LogDbg('err', "Failed to open $cmdimportdir/$name $!");
 			unlink "$cmdimportdir/$name";
 		}
 	}
 }
+
+sub print_find_reply
+{
+	my ($self, $node, $target, $flag, $ms) = @_;
+	my $sort = $flag == 2 ? "External" : "Local";
+	$self->send("$sort $target found at $node in $ms ms" );
+}
 1;
 __END__