X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXChannel.pm;h=2c82b1371fd31c4367e05521c1eab1fb4876777a;hb=refs%2Fheads%2Fnewusers;hp=7526099e895ccff4d0d86a47c7e69ccc857ee0ef;hpb=63cd679163fe336521e95e8af821b30d4bc1b9e9;p=spider.git diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 7526099e..2c82b137 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -19,7 +19,7 @@ # firstly and OO about ninthly (if you don't like the design and you can't # improve it with better OO and thus make it smaller and more efficient, then tough). # -# Copyright (c) 1998-2000 - Dirk Koopman G1TLH +# Copyright (c) 1998-2016 - Dirk Koopman G1TLH # # # @@ -125,6 +125,7 @@ $count = 0; inqueue => '9,Input Queue,parray', next_pc92_update => '9,Next PC92 Update,atime', next_pc92_keepalive => '9,Next PC92 KeepAlive,atime', + hostname => '0,Hostname', ); $maxerrors = 20; # the maximum number of concurrent errors allowed before disconnection @@ -160,7 +161,7 @@ sub alloc $self->{group} = $user->group; $self->{sort} = $user->sort; } - $self->{startt} = $self->{t} = time; + $self->{startt} = $self->{t} = $main::systime; $self->{state} = 0; $self->{oldstate} = 0; $self->{lang} = $main::lang if !$self->{lang}; @@ -171,7 +172,7 @@ sub alloc if (@dxcc > 0) { $self->{dxcc} = $dxcc[1]->dxcc; $self->{itu} = $dxcc[1]->itu; - $self->{cq} = $dxcc[1]->cq; + $self->{cq} = $dxcc[1]->cq; } $self->{inqueue} = []; @@ -299,69 +300,65 @@ sub del # is it a bbs sub is_bbs { - my $self = shift; - return $self->{'sort'} eq 'B'; + return $_[0]->{sort} eq 'B'; } sub is_node { - my $self = shift; - return $self->{'sort'} =~ /[ACRSXW]/; + return $_[0]->{sort} =~ /^[ACRSX]$/; } # is it an ak1a node ? sub is_ak1a { - my $self = shift; - return $self->{'sort'} eq 'A'; + return $_[0]->{sort} eq 'A'; } # is it a user? sub is_user { - my $self = shift; - return $self->{'sort'} eq 'U'; + return $_[0]->{sort} =~ /^[UW]$/; } # is it a clx node sub is_clx { - my $self = shift; - return $self->{'sort'} eq 'C'; + return $_[0]->{sort} eq 'C'; } -# it is Aranea -sub is_aranea +# it is a Web connected user +sub is_web { - my $self = shift; - return $self->{'sort'} eq 'W'; + return $_[0]->{sort} eq 'W'; } # is it a spider node sub is_spider { - my $self = shift; - return $self->{'sort'} eq 'S'; + return $_[0]->{sort} eq 'S'; } # is it a DXNet node sub is_dxnet { - my $self = shift; - return $self->{'sort'} eq 'X'; + return $_[0]->{sort} eq 'X'; } # is it a ar-cluster node sub is_arcluster { - my $self = shift; - return $self->{'sort'} eq 'R'; + return $_[0]->{sort} eq 'R'; +} + +sub is_rbn +{ + return $_[0]->{sort} eq 'N'; } # for perl 5.004's benefit sub sort { my $self = shift; - return @_ ? $self->{'sort'} = shift : $self->{'sort'} ; + return @_ ? $self->{sort} = shift : $self->{sort} ; } # find out whether we are prepared to believe this callsign on this interface @@ -430,7 +427,7 @@ sub send # this is always later and always data my $call = $self->{call}; foreach my $l (@_) { - for (ref $l ? @$l : $l) { + for (ref($l) eq 'ARRAY' ? @$l : $l) { my @lines = split /\n/; for (@lines) { $conn->send_later("D$call|$_"); @@ -500,7 +497,7 @@ sub disconnect my $self = shift; my $user = $self->{user}; - $user->close() if defined $user; + $user->close($self->{startt}, $self->{hostname}) if defined $user; $self->{conn}->disconnect if $self->{conn}; $self->del(); } @@ -587,7 +584,7 @@ sub decode_input { my $dxchan = shift; my $data = shift; - my ($sort, $call, $line) = $data =~ /^([A-Z])([A-Z0-9\/\-]{3,25})\|(.*)$/; + my ($sort, $call, $line) = $data =~ /^([A-Z])(#?[A-Z0-9\/\-]{3,25})\|(.*)$/; my $chcall = (ref $dxchan) ? $dxchan->call : "UN.KNOWN"; @@ -682,6 +679,11 @@ sub broadcast_list ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref; next unless $filter; } + if ($sort eq 'rbn') { + next unless $dxchan->{dx}; # this is deliberate! + ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref; + next unless $filter; + } next if $sort eq 'ann' && !$dxchan->{ann} && $s !~ /^To\s+LOCAL\s+de\s+(?:$main::myalias|$main::mycall)/i; next if $sort eq 'wwv' && !$dxchan->{wwv}; next if $sort eq 'wcy' && !$dxchan->{wcy}; @@ -717,7 +719,7 @@ sub process_one $self->normal($line); } elsif ($sort eq 'G') { $self->enhanced($line); - } elsif ($sort eq 'A' || $sort eq 'O') { + } elsif ($sort eq 'A' || $sort eq 'O' || $sort eq 'W') { $self->start($line, $sort); } elsif ($sort eq 'Z') { $self->disconnect;