X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXChannel.pm;h=24b875664c25d4174932bec8f450a0301c2839c0;hb=20b0104deaeab77fa7ab1444dbcedfcdbf5865f8;hp=093bfb003ca2ae6e9b824f0e097d8e8f4eb48d6a;hpb=0121434f428d8e7d1f31a9d69a4ee250b952b468;p=spider.git diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 093bfb00..24b87566 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -28,23 +28,27 @@ package DXChannel; use Msg; use DXUtil; use DXM; +use DXDebug; %channels = undef; %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', + call => '0,Callsign', + conn => '9,Msg Conn ref', + user => '9,DXUser ref', + startt => '0,Start Time,atime', + t => '9,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', + sort => '9,Type of Channel', ); -# create a new connection object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)] +# create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)] sub new { my ($pkg, $call, $conn, $user) = @_; @@ -54,28 +58,28 @@ sub new $self->{call} = $call; $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->{startt} = $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) = @_; @@ -87,7 +91,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; @@ -101,27 +105,16 @@ sub send_now { my $self = shift; my $conn = $self->{conn}; - - # 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; + 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"); - } + foreach $line (@_) { + chomp $line; + dbg('chan', "-> $sort $call $line\n"); + $conn->send_now("$sort$call|$line"); } + $self->{t} = time; } # @@ -131,26 +124,15 @@ sub send # this is always later and always data { my $self = shift; my $conn = $self->{conn}; - - # 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"); - } + my $call = $self->{call}; + my $line; + + foreach $line (@_) { + chomp $line; + dbg('chan', "-> D $call $line\n"); + $conn->send_later("D$call|$line"); } + $self->{t} = time; } # send a file (always later) @@ -180,10 +162,30 @@ sub state my $self = shift; $self->{oldstate} = $self->{state}; $self->{state} = shift; - print "Db $self->{call} channel state $self->{oldstate} -> $self->{state}\n" if $main::debug; + 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;