X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXChannel.pm;h=8dae7cd6d54dc3e66a2f31a317f3268628b6c7d0;hb=6ca67477693e7f808e972df82b860398ee8706df;hp=c4a81c7f509b503a9c3025217f2a3f80b45c5177;hpb=f9fbccb42b30e28358cf59ee06e17a2d610561f6;p=spider.git diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index c4a81c7f..8dae7cd6 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -85,7 +85,7 @@ $count = 0; inwcyfilter => '5,WCY Filt-inp', inspotsfilter => '5,Spot Filt-inp', inroutefilter => '5,Route Filt-inp', - passwd => '9,Passwd List,parray', + passwd => '9,Passwd List,yesno', pingint => '5,Ping Interval ', nopings => '5,Ping Obs Count', lastping => '5,Ping last sent,atime', @@ -105,6 +105,10 @@ $count = 0; width => '0,Column Width', disconnecting => '9,Disconnecting,yesno', ann_talk => '0,Suppress Talk Anns,yesno', + metric => '1,Route metric', + badcount => '1,Bad Word Count', + edit => '7,Edit Function', + registered => '9,Registered?,yesno', ); use vars qw($VERSION $BRANCH); @@ -489,12 +493,12 @@ sub decode_input # the above regexp must work unless (defined $sort && defined $call && defined $line) { # $data =~ s/([\x00-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg; - dbg("DUFF Line on $chcall: $data") if isdbg('err'); + dbg("DUFF Line on $chcall: $data"); return (); } if(ref($dxchan) && $call ne $chcall) { - dbg("DUFF Line come in for $call on wrong channel $chcall") if isdbg('err'); + dbg("DUFF Line come in for $call on wrong channel $chcall"); return(); } @@ -505,22 +509,116 @@ sub rspfcheck { my ($self, $flag, $node, $user) = @_; my $nref = Route::Node::get($node); - if ($nref) { - if ($nref->dxchan == $self) { + my $dxchan = $nref->dxchan if $nref; + if ($nref && $dxchan) { + if ($dxchan == $self) { return 1 unless $user; + return 1 if $user eq $node; my @users = $nref->users; return 1 if @users == 0 || grep $user eq $_, @users; - dbg("RSPF: $user not on $node") if isdbg('rspf'); + dbg("RSPF: $user not on $node") if isdbg('chanerr'); } else { - dbg("RSPF: Shortest path for $node is " . $nref->dxchan->{call}) if isdbg('rspf'); + dbg("RSPF: Shortest path for $node is " . $nref->dxchan->{call}) if isdbg('chanerr'); } } else { return 1 if $flag; - dbg("RSPF: required $node not found" ) if isdbg('rspf'); + dbg("RSPF: required $node not found" ) if isdbg('chanerr'); } return 0; } +# broadcast a message to all clusters taking into account isolation +# [except those mentioned after buffer] +sub broadcast_nodes +{ + my $s = shift; # the line to be rebroadcast + my @except = @_; # to all channels EXCEPT these (dxchannel refs) + my @dxchan = DXChannel::get_all_nodes(); + my $dxchan; + + # send it if it isn't the except list and isn't isolated and still has a hop count + foreach $dxchan (@dxchan) { + next if grep $dxchan == $_, @except; + next if $dxchan == $main::me; + + my $routeit = $dxchan->can('adjust_hops') ? $dxchan->adjust_hops($s) : $s; # adjust its hop count by node name + + $dxchan->send($routeit) unless $dxchan->{isolate} || !$routeit; + } +} + +# broadcast a message to all clusters ignoring isolation +# [except those mentioned after buffer] +sub broadcast_all_nodes +{ + my $s = shift; # the line to be rebroadcast + my @except = @_; # to all channels EXCEPT these (dxchannel refs) + my @dxchan = DXChannel::get_all_nodes(); + my $dxchan; + + # send it if it isn't the except list and isn't isolated and still has a hop count + foreach $dxchan (@dxchan) { + next if grep $dxchan == $_, @except; + next if $dxchan == $main::me; + + my $routeit = $dxchan->can('adjust_hops') ? $dxchan->adjust_hops($s) : $s; # adjust its hop count by node name + $dxchan->send($routeit); + } +} + +# broadcast to all users +# storing the spot or whatever until it is in a state to receive it +sub broadcast_users +{ + my $s = shift; # the line to be rebroadcast + my $sort = shift; # the type of transmission + my $fref = shift; # a reference to an object to filter on + my @except = @_; # to all channels EXCEPT these (dxchannel refs) + my @dxchan = DXChannel::get_all_users(); + my $dxchan; + my @out; + + foreach $dxchan (@dxchan) { + next if grep $dxchan == $_, @except; + push @out, $dxchan; + } + broadcast_list($s, $sort, $fref, @out); +} + + +# broadcast to a list of users +sub broadcast_list +{ + my $s = shift; + my $sort = shift; + my $fref = shift; + my $dxchan; + + foreach $dxchan (@_) { + my $filter = 1; + next if $dxchan == $main::me; + + if ($sort eq 'dx') { + next unless $dxchan->{dx}; + ($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}; + next if $sort eq 'wx' && !$dxchan->{wx}; + + $s =~ s/\a//og unless $dxchan->{beep}; + + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { + $dxchan->send($s); + } else { + $dxchan->delay($s); + } + } +} + + no strict; sub AUTOLOAD {