X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXChannel.pm;h=be5feee32b2915308464961f9884c5b4e9dee218;hb=b50b7a1c99679f3624852f29068a6cde268e9560;hp=17f34919e7eb970f4eef85a2cc893e3dd95469d2;hpb=29ec5bb85c591182dd868e7a3d87f510d7b47e9b;p=spider.git diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 17f34919..be5feee3 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -4,7 +4,7 @@ # This is the base class for all channel operations, which is everything to do # with input and output really. # -# The instance variable in the outside world will be generally be called $dxchann +# The instance variable in the outside world will be generally be called $dxchan # # This class is 'inherited' (if that is the goobledegook for what I am doing) # by various other modules. The point to understand is that the 'instance variable' @@ -17,9 +17,9 @@ # # PLEASE NOTE - I am a C programmer using this as a method of learning perl # firstly and OO about ninthly (if you don't like the design and you can't -# improve it with better OO by make it smaller and more efficient, then tough). +# improve it with better OO and thus make it smaller and more efficient, then tough). # -# Copyright (c) 1998 - Dirk Koopman G1TLH +# Copyright (c) 1998-2000 - Dirk Koopman G1TLH # # $Id$ # @@ -28,13 +28,16 @@ package DXChannel; use Msg; use DXM; use DXUtil; +use DXVars; use DXDebug; use Filter; +use Prefix; use strict; -use vars qw(%channels %valid); +use vars qw(%channels %valid @ISA $count); %channels = (); +$count = 0; %valid = ( call => '0,Callsign', @@ -56,7 +59,7 @@ use vars qw(%channels %valid); talk => '0,Want Talk,yesno', ann => '0,Want Announce,yesno', here => '0,Here?,yesno', - confmode => '0,In Conference?,yesno', + conf => '0,In Conference?,yesno', dx => '0,DX Spots,yesno', redirect => '0,Redirect messages to', lang => '0,Language', @@ -74,11 +77,13 @@ use vars qw(%channels %valid); annfilter => '5,Announce Filter', wwvfilter => '5,WWV Filter', wcyfilter => '5,WCY Filter', - spotfilter => '5,Spot Filter', + spotsfilter => '5,Spot Filter', + routefilter => '5,route Filter', inannfilter => '5,Input Ann Filter', inwwvfilter => '5,Input WWV Filter', inwcyfilter => '5,Input WCY Filter', - inspotfilter => '5,Input Spot Filter', + inspotsfilter => '5,Input Spot Filter', + inroutefilter => '5,Input Route Filter', passwd => '9,Passwd List,parray', pingint => '5,Ping Interval ', nopings => '5,Ping Obs Count', @@ -87,27 +92,28 @@ use vars qw(%channels %valid); pingave => '0,Ping ave time', logininfo => '9,Login info req,yesno', talklist => '0,Talk List,parray', - node => '5,Node data', + cluster => '5,Cluster data', + isbasic => '9,Internal Connection', + errors => '9,Errors', + route => '9,Route Data', + dxcc => '0,Country Code', + itu => '0,ITU Zone', + cq => '0,CQ Zone', + enhanced => '5,Enhanced Client,yesno', + senddbg => '8,Sending Debug,yesno', ); # object destruction sub DESTROY { my $self = shift; - undef $self->{user}; - undef $self->{conn}; - undef $self->{loc}; - undef $self->{pagedata}; - undef $self->{group}; - undef $self->{delayed}; - undef $self->{annfilter}; - undef $self->{wwvfilter}; - undef $self->{spotfilter}; - undef $self->{inannfilter}; - undef $self->{inwwvfilter}; - undef $self->{inspotfilter}; - undef $self->{passwd}; - undef $self->{node}; + for (keys %$self) { + if (ref($self->{$_})) { + delete $self->{$_}; + } + } + dbg("DXChannel $self->{call} destroyed ($count)") if isdbg('chan'); + $count--; } # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)] @@ -133,12 +139,16 @@ sub alloc $self->{lang} = $main::lang if !$self->{lang}; $self->{func} = ""; - # get the filters - $self->{spotfilter} = Filter::read_in('spots', $call, 0); - $self->{wwvfilter} = Filter::read_in('wwv', $call, 0); - $self->{wcyfilter} = Filter::read_in('wcy', $call, 0); - $self->{annfilter} = Filter::read_in('ann', $call, 0); + # add in all the dxcc, itu, zone info + my @dxcc = Prefix::extract($call); + if (@dxcc > 0) { + $self->{dxcc} = $dxcc[1]->dxcc; + $self->{itu} = $dxcc[1]->itu; + $self->{cq} = $dxcc[1]->cq; + } + $count++; + dbg("DXChannel $self->{call} created ($count)") if isdbg('chan'); bless $self, $pkg; return $channels{$call} = $self; } @@ -289,7 +299,30 @@ sub send_now my @lines = split /\n/; for (@lines) { $conn->send_now("$sort$call|$_"); - dbg('chan', "-> $sort $call $_"); + dbg("-> $sort $call $_") if isdbg('chan'); + } + } + $self->{t} = time; +} + +# +# send later with letter (more control) +# + +sub send_later +{ + my $self = shift; + my $conn = $self->{conn}; + return unless $conn; + my $sort = shift; + my $call = $self->{call}; + + for (@_) { +# chomp; + my @lines = split /\n/; + for (@lines) { + $conn->send_later("$sort$call|$_"); + dbg("-> $sort $call $_") if isdbg('chan'); } } $self->{t} = time; @@ -310,7 +343,7 @@ sub send # this is always later and always data my @lines = split /\n/; for (@lines) { $conn->send_later("D$call|$_"); - dbg('chan', "-> D $call $_"); + dbg("-> D $call $_") if isdbg('chan'); } } $self->{t} = time; @@ -358,7 +391,7 @@ sub state $self->{oldstate} = $self->{state}; $self->{state} = shift; $self->{func} = '' unless defined $self->{func}; - dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n"); + dbg("$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n") if isdbg('state'); # if there is any queued up broadcasts then splurge them out here if ($self->{delayed} && ($self->{state} eq 'prompt' || $self->{state} eq 'talk')) { @@ -374,12 +407,9 @@ sub disconnect { my $self = shift; my $user = $self->{user}; - my $conn = $self->{conn}; - my $call = $self->{call}; - $self->finish($conn); $user->close() if defined $user; - $conn->disconnect() if $conn; + $self->{conn}->disconnect; $self->del(); } @@ -446,12 +476,16 @@ sub decode_input my $chcall = (ref $dxchan) ? $dxchan->call : "UN.KNOWN"; # the above regexp must work - if (!defined $sort || !defined $call || !defined $line || - (ref $dxchan && $call ne $chcall)) { - $data =~ s/([\x00-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg; - dbg('chan', "DUFF Line from $chcall: $data"); + 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'); return (); } + + if(ref($dxchan) && $call ne $chcall) { + dbg("DUFF Line come in for $call on wrong channel $chcall") if isdbg('err'); + return(); + } return ($sort, $call, $line); }