X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXChannel.pm;h=36a84aa162c756e9c68d78aeb643921e9fc4d1dc;hb=07ea293f3919d2da76220b5fbc55b734008ed44c;hp=065a78c8d7af7e06293117a99332935634cfbab2;hpb=f46017e7bef9ee062cd5a8648d214eabe585da25;p=spider.git diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 065a78c8..36a84aa1 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 => '0,Callsign', + conn => '9,Msg Conn ref', + user => '9,DXUser ref', + t => '0,Time,atime', + priv => '9,Privilege', + state => '0,Current State', + oldstate => '5,Last State', + list => '9,Dep Chan List', + name => '0,User Name', + consort => '9,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__;