package DXCommandmode;
-use POSIX;
+#use POSIX;
@ISA = qw(DXChannel);
+use POSIX qw(:math_h);
use DXUtil;
use DXChannel;
use DXUser;
use QSL;
use DB_File;
use VE7CC;
+use DXXml;
use strict;
use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug
#
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
# 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;
}
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}));
$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;
}
$self->tell_login('loginu');
+ $self->tell_buddies('loginb');
# do we need to send a forward/opernam?
my $lastoper = $user->lastoper || 0;
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;
}
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);
my @bad;
if (@bad = BadWords::check($cmdline)) {
$self->badcount(($self->badcount||0) + @bad);
- Log('DXCommand', "$self->{call} swore: $cmdline");
+ LogDbg('DXCommand', "$self->{call} swore: $cmdline with words:" . join(',', @bad) . ")");
} else {
for (@{$self->{talklist}}) {
$self->send_talks($_, $rawline);
# check for excessive swearing
if ($self->{badcount} && $self->{badcount} >= $maxbadcount) {
- Log('DXCommand', "$self->{call} logged out for excessive swearing");
+ LogDbg('DXCommand', "$self->{call} logged out for excessive swearing");
$self->disconnect;
return;
}
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}};
return () if length $cmdline == 0;
-
+
+
# split the command line up into parts, the first part is the command
my ($cmd, $args) = split /\s+/, $cmdline, 2;
$args = "" unless defined $args;
# 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";
}
# 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;
}
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);
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) = @_;
{
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) {
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);
}
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);
}
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};
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);
}
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);
}
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);
+ }
}
}
# 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;
}
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;
$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__
projects / spider.git / blobdiff