X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXChannel.pm;h=699e87a8d8da0a4b27008413281cb0be4076af2f;hb=b9dffeff7239952814342dad19db3a51def6fab7;hp=829c6b55585bf0022e6f96c28a17be6d368d5798;hpb=23d5848190b73200389fdfc2291e3453b3b91b15;p=spider.git diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 829c6b55..699e87a8 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -101,6 +101,7 @@ $count = 0; itu => '0,ITU Zone', cq => '0,CQ Zone', enhanced => '5,Enhanced Client,yesno', + gtk => '5,Using GTK,yesno', senddbg => '8,Sending Debug,yesno', width => '0,Column Width', disconnecting => '9,Disconnecting,yesno', @@ -114,14 +115,13 @@ $count = 0; build => '1,Node Build', verified => '9,Verified?,yesno', newroute => '1,New Style Routing,yesno', + ve7cc => '0,VE7CC program special,yesno', + lastmsgpoll => '0,Last Msg Poll,atime', + inscript => '9,In a script,yesno', + handle_xml => '9,Handles XML,yesno', + inqueue => '9,Input Queue,parray', ); -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; - # object destruction sub DESTROY { @@ -148,7 +148,8 @@ sub alloc if (defined $user) { $self->{user} = $user; $self->{lang} = $user->lang; - $user->new_group() if !$user->group; + $user->new_group unless $user->group; + $user->new_buddies unless $user->buddies; $self->{group} = $user->group; $self->{sort} = $user->sort; } @@ -165,6 +166,7 @@ sub alloc $self->{itu} = $dxcc[1]->itu; $self->{cq} = $dxcc[1]->cq; } + $self->{inqueue} = []; $count++; dbg("DXChannel $self->{call} created ($count)") if isdbg('chan'); @@ -172,17 +174,34 @@ sub alloc return $channels{$call} = $self; } -# obtain a channel object by callsign [$obj = DXChannel->get($call)] +# rebless this channel as something else +sub rebless +{ + my $self = shift; + my $class = shift; + return $channels{$self->{call}} = bless $self, $class; +} + +sub rec +{ + my ($self, $msg) = @_; + + # queue the message and the channel object for later processing + if (defined $msg) { + push @{$self->{inqueue}}, $msg; + } +} + +# obtain a channel object by callsign [$obj = DXChannel::get($call)] sub get { - my ($pkg, $call) = @_; + my $call = shift; return $channels{$call}; } # obtain all the channel objects sub get_all { - my ($pkg) = @_; return values(%channels); } @@ -252,7 +271,7 @@ sub is_bbs sub is_node { my $self = shift; - return $self->{'sort'} =~ /[ACRSX]/; + return $self->{'sort'} =~ /[ACRSXW]/; } # is it an ak1a node ? sub is_ak1a @@ -275,6 +294,13 @@ sub is_clx return $self->{'sort'} eq 'C'; } +# it is Aranea +sub is_aranea +{ + my $self = shift; + return $self->{'sort'} eq 'W'; +} + # is it a spider node sub is_spider { @@ -327,7 +353,8 @@ sub send_now my @lines = split /\n/; for (@lines) { $conn->send_now("$sort$call|$_"); - dbg("-> $sort $call $_") if isdbg('chan'); + # debug log it, but not if it is a log message + dbg("-> $sort $call $_") if $sort ne 'L' && isdbg('chan'); } } $self->{t} = time; @@ -350,7 +377,8 @@ sub send_later my @lines = split /\n/; for (@lines) { $conn->send_later("$sort$call|$_"); - dbg("-> $sort $call $_") if isdbg('chan'); + # debug log it, but not if it is a log message + dbg("-> $sort $call $_") if $sort ne 'L' && isdbg('chan'); } } $self->{t} = time; @@ -366,15 +394,16 @@ sub send # this is always later and always data return unless $conn; my $call = $self->{call}; - for (@_) { -# chomp; - my @lines = split /\n/; - for (@lines) { - $conn->send_later("D$call|$_"); - dbg("-> D $call $_") if isdbg('chan'); + foreach my $l (@_) { + for (ref $l ? @$l : $l) { + my @lines = split /\n/; + for (@lines) { + $conn->send_later("D$call|$_"); + dbg("-> D $call $_") if isdbg('chan'); + } } } - $self->{t} = time; + $self->{t} = $main::systime; } # send a file (always later) @@ -436,7 +465,6 @@ sub disconnect my $self = shift; my $user = $self->{user}; - main::clean_inqueue($self); # clear out any remaining incoming frames $user->close() if defined $user; $self->{conn}->disconnect; $self->del(); @@ -463,7 +491,30 @@ sub closeall # sub tell_login { - my ($self, $m) = @_; + my ($self, $m, $call) = @_; + + $call ||= $self->{call}; + + # send info to all logged in thingies + my @dxchan = get_all_users(); + my $dxchan; + foreach $dxchan (@dxchan) { + next if $dxchan == $self; + next if $dxchan->{call} eq $main::mycall; + $dxchan->send($dxchan->msg($m, $call)) if $dxchan->{logininfo}; + } +} + +# +# Tell all the users if a buddy is logged or out +# +sub tell_buddies +{ + my ($self, $m, $call, $node) = @_; + + $call ||= $self->{call}; + $call =~ s/-\d+$//; + $m .= 'n' if $node; # send info to all logged in thingies my @dxchan = get_all_users(); @@ -471,7 +522,7 @@ sub tell_login foreach $dxchan (@dxchan) { next if $dxchan == $self; next if $dxchan->{call} eq $main::mycall; - $dxchan->send($dxchan->msg($m, $self->{call})) if $dxchan->{logininfo}; + $dxchan->send($dxchan->msg($m, $call, $node)) if grep $_ eq $call, @{$dxchan->{user}->{buddies}} ; } } @@ -524,7 +575,7 @@ sub rspfcheck { my ($self, $flag, $node, $user) = @_; my $nref = Route::Node::get($node); - my $dxchan = $nref->bestdxchan if $nref; + my $dxchan = $nref->dxchan if $nref; if ($nref && $dxchan) { if ($dxchan == $self) { return 1 unless $user; @@ -533,7 +584,7 @@ sub rspfcheck return 1 if @users == 0 || grep $user eq $_, @users; dbg("RSPF: $user not on $node") if isdbg('chanerr'); } else { - dbg("RSPF: Shortest path for $node is " . $nref->bestdxchan->{call}) if isdbg('chanerr'); + dbg("RSPF: Shortest path for $node is " . $nref->dxchan->{call}) if isdbg('chanerr'); } } else { return 1 if $flag; @@ -548,7 +599,7 @@ 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 = get_all_nodes(); my $dxchan; # send it if it isn't the except list and isn't isolated and still has a hop count @@ -568,7 +619,7 @@ 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 = get_all_nodes(); my $dxchan; # send it if it isn't the except list and isn't isolated and still has a hop count @@ -589,7 +640,7 @@ sub broadcast_users 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 = get_all_users(); my $dxchan; my @out; @@ -633,6 +684,55 @@ sub broadcast_list } } +sub process +{ + foreach my $dxchan (get_all()) { + + while (my $data = shift @{$dxchan->{inqueue}}) { + my ($sort, $call, $line) = $dxchan->decode_input($data); + next unless defined $sort; + + # do the really sexy console interface bit! (Who is going to do the TK interface then?) + dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan'); + if ($dxchan->{disconnecting}) { + dbg('In disconnection, ignored'); + next; + } + + # handle A records + my $user = $dxchan->user; + if ($sort eq 'A' || $sort eq 'O') { + $dxchan->start($line, $sort); + } elsif ($sort eq 'I') { + die "\$user not defined for $call" if !defined $user; + + # normal input + $dxchan->normal($line); + } elsif ($sort eq 'Z') { + $dxchan->disconnect; + } elsif ($sort eq 'D') { + ; # ignored (an echo) + } elsif ($sort eq 'G') { + $dxchan->enhanced($line); + } else { + print STDERR atime, " Unknown command letter ($sort) received from $call\n"; + } + } + } +} + +sub handle_xml +{ + my $self = shift; + my $r = 0; + + if (DXXml::available()) { + $r = $self->{handle_xml} || 0; + } else { + delete $self->{handle_xml} if exists $self->{handle_xml}; + } + return $r; +} #no strict; sub AUTOLOAD