X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXChannel.pm;h=c2358c3dd2366f56e1d7018c23fde7d474bb288d;hb=deb52e701a0db351d06eb6fe14872dc2fa7a51cb;hp=f8af917e7e3241b43b5e3b03a8c802355fa735c0;hpb=d2b28488d70d97c2e467cd7c57077024b7241b45;p=spider.git diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index f8af917e..c2358c3d 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -80,12 +80,14 @@ $count = 0; wcyfilter => '5,WCY Filt-out', spotsfilter => '5,Spot Filt-out', routefilter => '5,Route Filt-out', + rbnfilter => '5,RBN Filt-out', pc92filter => '5,PC92 Route Filt-out', inannfilter => '5,Ann Filt-inp', inwwvfilter => '5,WWV Filt-inp', inwcyfilter => '5,WCY Filt-inp', inspotsfilter => '5,Spot Filt-inp', inroutefilter => '5,Route Filt-inp', + inrbnfilter => '5,RBN Filt-inp', inpc92filter => '5,PC92 Route Filt-inp', passwd => '9,Passwd List,yesno', pingint => '5,Ping Interval ', @@ -125,7 +127,9 @@ $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,(Proxied)Hostname', + hostname => '0,Hostname', + isslugged => '9,Still Slugged,yesno', + sluggedpcs => '9,Slugged PCxx Queue,parray', ); $maxerrors = 20; # the maximum number of concurrent errors allowed before disconnection @@ -160,12 +164,14 @@ sub alloc $user->new_buddies unless $user->buddies; $self->{group} = $user->group; $self->{sort} = $user->sort; + $self->{width} = $user->width; } - $self->{startt} = $self->{t} = time; + $self->{startt} = $self->{t} = $main::systime; $self->{state} = 0; $self->{oldstate} = 0; $self->{lang} = $main::lang if !$self->{lang}; $self->{func} = ""; + $self->{width} ||= 80; # add in all the dxcc, itu, zone info my @dxcc = Prefix::extract($call); @@ -300,62 +306,63 @@ 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} =~ /^[ACRSX]$/; + 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} =~ /^[UW]$/; + 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 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'; +} + +sub is_dslink +{ + return $_[0]->{sort} eq 'L'; } # for perl 5.004's benefit @@ -501,7 +508,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(); } @@ -680,7 +687,7 @@ sub broadcast_list if ($sort eq 'dx') { next unless $dxchan->{dx}; - ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref; + ($filter) = $dxchan->{spotsfilter}->it($fref) if $dxchan->{spotsfilter} && ref $fref; next unless $filter; } next if $sort eq 'ann' && !$dxchan->{ann} && $s !~ /^To\s+LOCAL\s+de\s+(?:$main::myalias|$main::mycall)/i; @@ -720,6 +727,8 @@ sub process_one $self->enhanced($line); } elsif ($sort eq 'A' || $sort eq 'O' || $sort eq 'W') { $self->start($line, $sort); + } elsif ($sort eq 'C') { + $self->width($line); # change number of columns } elsif ($sort eq 'Z') { $self->disconnect; } elsif ($sort eq 'D') { @@ -761,6 +770,20 @@ sub error_handler } +sub isregistered +{ + my $self = shift; + + # the sysop is registered! + return 1 if $self->{call} eq $main::myalias || $self->{call} eq $main::mycall; + + if ($main::reqreg) { + return $self->{registered}; + } else { + return 1; + } +} + #no strict; sub AUTOLOAD {