X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXChannel.pm;h=cfa3d150fe1b3f3ff6220135e81dd6264480fbcd;hb=6b6a8002929017b6d4217f68fa492a2d728ee1fe;hp=065a78c8d7af7e06293117a99332935634cfbab2;hpb=f46017e7bef9ee062cd5a8648d214eabe585da25;p=spider.git diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 065a78c8..cfa3d150 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -25,16 +25,28 @@ # package DXChannel; -require Exporter; -@ISA = qw(DXCommandmode DXProt Exporter); - use Msg; use DXUtil; use DXM; +use DXDebug; %channels = undef; -# create a new connection object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)] +%valid = ( + call => 'Callsign', + conn => 'Msg Connection ref', + user => 'DXUser ref', + t => 'Time', + priv => 'Privilege', + state => 'Current State', + oldstate => 'Last State', + list => 'Dependant DXChannels list', + name => 'User Name', + connsort => 'Connection Type' +); + + +# create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)] sub new { my ($pkg, $call, $conn, $user) = @_; @@ -46,25 +58,26 @@ sub new $self->{user} = $user if defined $user; $self->{t} = time; $self->{state} = 0; + $self->{oldstate} = 0; bless $self, $pkg; return $channels{$call} = $self; } -# obtain a connection object by callsign [$obj = DXChannel->get($call)] +# obtain a channel object by callsign [$obj = DXChannel->get($call)] sub get { my ($pkg, $call) = @_; - return $connect{$call}; + return $channels{$call}; } -# obtain all the connection objects +# obtain all the channel objects sub get_all { my ($pkg) = @_; return values(%channels); } -# obtain a connection object by searching for its connection reference +# obtain a channel object by searching for its connection reference sub get_by_cnum { my ($pkg, $conn) = @_; @@ -76,7 +89,7 @@ sub get_by_cnum return undef; } -# get rid of a connection object [$obj->del()] +# get rid of a channel object [$obj->del()] sub del { my $self = shift; @@ -104,10 +117,8 @@ sub send_now 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"; + dbg('chan', "-> $sort $call $line\n"); $conn->send_now("$sort$call|$line"); } } @@ -133,10 +144,8 @@ sub send # this is always later and always data 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"; + dbg('chan', "-> D $call $line\n"); $conn->send_later("D$call|$line"); } } @@ -163,5 +172,47 @@ sub msg $self->send(DXM::msg(@_)); } +# change the state of the channel - lots of scope for debugging here :-) +sub state +{ + my $self = shift; + $self->{oldstate} = $self->{state}; + $self->{state} = shift; + dbg('state', "$self->{call} channel state $self->{oldstate} -> $self->{state}\n"); +} + +# various access routines + +# +# return a list of valid elements +# + +sub fields +{ + return keys(%valid); +} + +# +# return a prompt for a field +# + +sub field_prompt +{ + my ($self, $ele) = @_; + return $valid{$ele}; +} + +sub AUTOLOAD +{ + my $self = shift; + my $name = $AUTOLOAD; + + return if $name =~ /::DESTROY$/; + $name =~ s/.*:://o; + + die "Non-existant field '$AUTOLOAD'" if !$valid{$name}; + @_ ? $self->{$name} = shift : $self->{$name} ; +} + 1; __END__;