fleshed out some commands (particularly flag setting and unsetting)

[spider.git] / perl / DXChannel.pm

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 065a78c8d7af7e06293117a99332935634cfbab2..36a84aa162c756e9c68d78aeb643921e9fc4d1dc 100644 (file)
--- 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__;