X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=blobdiff_plain;f=perl%2FDXChannel.pm;h=065a78c8d7af7e06293117a99332935634cfbab2;hp=b661510040eebe5954bf7063b24169a2a435fa5c;hb=f46017e7bef9ee062cd5a8648d214eabe585da25;hpb=f77b59f4fcceb428142461972e94345419cbda28 diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index b6615100..065a78c8 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -1,6 +1,24 @@ # # module to manage channel lists & data # +# 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 +# +# 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' +# is in fact what normal people would call the state vector and all useful info +# about a connection goes in there. +# +# Another point to note is that a vector may contain a list of other vectors. +# I have simply added another variable to the vector for 'simplicity' (or laziness +# as it is more commonly called) +# +# 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). +# # Copyright (c) 1998 - Dirk Koopman G1TLH # # $Id$ @@ -8,30 +26,31 @@ package DXChannel; require Exporter; -@ISA = qw(Exporter); +@ISA = qw(DXCommandmode DXProt Exporter); use Msg; use DXUtil; +use DXM; -%connects = undef; +%channels = undef; -# create a new connection object [$obj = Connect->new($call, $msg_conn_obj, $user_obj)] +# create a new connection object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)] sub new { my ($pkg, $call, $conn, $user) = @_; my $self = {}; - die "trying to create a duplicate channel for $call" if $connects{$call}; + die "trying to create a duplicate channel for $call" if $channels{$call}; $self->{call} = $call; - $self->{conn} = $conn; - $self->{user} = $user; + $self->{conn} = $conn if defined $conn; # if this isn't defined then it must be a list + $self->{user} = $user if defined $user; $self->{t} = time; $self->{state} = 0; bless $self, $pkg; - return $connects{$call} = $self; + return $channels{$call} = $self; } -# obtain a connection object by callsign [$obj = Connect->get($call)] +# obtain a connection object by callsign [$obj = DXChannel->get($call)] sub get { my ($pkg, $call) = @_; @@ -42,7 +61,7 @@ sub get sub get_all { my ($pkg) = @_; - return values(%connects); + return values(%channels); } # obtain a connection object by searching for its connection reference @@ -51,7 +70,7 @@ sub get_by_cnum my ($pkg, $conn) = @_; my $self; - foreach $self (values(%connects)) { + foreach $self (values(%channels)) { return $self if ($self->{conn} == $conn); } return undef; @@ -61,42 +80,65 @@ sub get_by_cnum sub del { my $self = shift; - delete $connects{$self->{call}}; + delete $channels{$self->{call}}; } -# handle out going messages +# handle out going messages, immediately without waiting for the select to drop +# this could, in theory, block sub send_now { my $self = shift; - my $sort = shift; - my $call = $self->{call}; my $conn = $self->{conn}; - my $line; - - foreach $line (@_) { - my $t = atime; - chomp $line; - print main::DEBUG "$t > $sort $call $line\n" if defined DEBUG; - print "> $sort $call $line\n"; - $conn->send_now("$sort$call|$line"); + + # is this a list of channels ? + if (!defined $conn) { + die "tried to send_now to an invalid channel list" if !defined $self->{list}; + my $lself; + foreach $lself (@$self->{list}) { + $lself->send_now(@_); # it's recursive :-) + } + } else { + my $sort = shift; + my $call = $self->{call}; + my $line; + + foreach $line (@_) { + my $t = atime; + chomp $line; + print main::DEBUG "$t > $sort $call $line\n" if defined DEBUG; + print "> $sort $call $line\n"; + $conn->send_now("$sort$call|$line"); + } } } -sub send_later +# +# the normal output routine +# +sub send # this is always later and always data { my $self = shift; - my $sort = shift; - my $call = $self->{call}; my $conn = $self->{conn}; - my $line; - - foreach $line (@_) { - my $t = atime; - chomp $line; - print main::DEBUG "$t > $sort $call $line\n" if defined DEBUG; - print "> $sort $call $line\n"; - $conn->send_later("$sort$call|$line"); + + # is this a list of channels ? + if (!defined $conn) { + die "tried to send to an invalid channel list" if !defined $self->{list}; + my $lself; + foreach $lself (@$self->{list}) { + $lself->send(@_); # here as well :-) :-) + } + } else { + my $call = $self->{call}; + my $line; + + foreach $line (@_) { + my $t = atime; + chomp $line; + print main::DEBUG "$t > D $call $line\n" if defined DEBUG; + print "> D $call $line\n"; + $conn->send_later("D$call|$line"); + } } } @@ -111,7 +153,14 @@ sub send_file open(F, $fn) or die "can't open $fn for sending file ($!)"; @buf = ; close(F); - $self->send_later('D', @buf); + $self->send(@buf); +} + +# just a shortcut for $dxchan->send(msg(...)); +sub msg +{ + my $self = shift; + $self->send(DXM::msg(@_)); } 1;