sorted out inheritance
[spider.git] / perl / DXChannel.pm
index 065a78c8d7af7e06293117a99332935634cfbab2..093bfb003ca2ae6e9b824f0e097d8e8f4eb48d6a 100644 (file)
 #
 package DXChannel;
 
-require Exporter;
-@ISA = qw(DXCommandmode DXProt Exporter);
-
 use Msg;
 use DXUtil;
 use DXM;
 
 %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',
+);
+
+
 # create a new connection object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
 sub new
 {
@@ -46,6 +56,7 @@ sub new
   $self->{user} = $user if defined $user; 
   $self->{t} = time;
   $self->{state} = 0;
+  $self->{oldstate} = 0;
   bless $self, $pkg; 
   return $channels{$call} = $self;
 }
@@ -106,8 +117,8 @@ sub send_now
     foreach $line (@_) {
       my $t = atime;
          chomp $line;
-      print main::DEBUG "$t > $sort $call $line\n" if defined DEBUG;
-         print "> $sort $call $line\n";
+      print main::DEBUG "$t -> $sort $call $line\n" if defined DEBUG;
+         print "-> $sort $call $line\n";
       $conn->send_now("$sort$call|$line");
        }
   }
@@ -135,8 +146,8 @@ sub send              # this is always later and always data
     foreach $line (@_) {
       my $t = atime;
          chomp $line;
-         print main::DEBUG "$t > D $call $line\n" if defined DEBUG;
-         print "> D $call $line\n";
+         print main::DEBUG "$t -> D $call $line\n" if defined DEBUG;
+         print "-> D $call $line\n";
          $conn->send_later("D$call|$line");
        }
   }
@@ -163,5 +174,27 @@ 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;
+  print "Db   $self->{call} channel state $self->{oldstate} -> $self->{state}\n" if $main::debug;
+}
+
+# various access routines
+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__;