]> scm.dxcluster.org Git - spider.git/blob - perl/DXChannel.pm
24b875664c25d4174932bec8f450a0301c2839c0
[spider.git] / perl / DXChannel.pm
1 #
2 # module to manage channel lists & data
3 #
4 # This is the base class for all channel operations, which is everything to do 
5 # with input and output really.
6 #
7 # The instance variable in the outside world will be generally be called $dxchann
8 #
9 # This class is 'inherited' (if that is the goobledegook for what I am doing)
10 # by various other modules. The point to understand is that the 'instance variable'
11 # is in fact what normal people would call the state vector and all useful info
12 # about a connection goes in there.
13 #
14 # Another point to note is that a vector may contain a list of other vectors. 
15 # I have simply added another variable to the vector for 'simplicity' (or laziness
16 # as it is more commonly called)
17 #
18 # PLEASE NOTE - I am a C programmer using this as a method of learning perl
19 # firstly and OO about ninthly (if you don't like the design and you can't 
20 # improve it with better OO by make it smaller and more efficient, then tough). 
21 #
22 # Copyright (c) 1998 - Dirk Koopman G1TLH
23 #
24 # $Id$
25 #
26 package DXChannel;
27
28 use Msg;
29 use DXUtil;
30 use DXM;
31 use DXDebug;
32
33 %channels = undef;
34
35 %valid = (
36   call => '0,Callsign',
37   conn => '9,Msg Conn ref',
38   user => '9,DXUser ref',
39   startt => '0,Start Time,atime',
40   t => '9,Time,atime',
41   priv => '9,Privilege',
42   state => '0,Current State',
43   oldstate => '5,Last State',
44   list => '9,Dep Chan List',
45   name => '0,User Name',
46   consort => '9,Connection Type',
47   sort => '9,Type of Channel',
48 );
49
50
51 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
52 sub new
53 {
54   my ($pkg, $call, $conn, $user) = @_;
55   my $self = {};
56   
57   die "trying to create a duplicate channel for $call" if $channels{$call};
58   $self->{call} = $call;
59   $self->{conn} = $conn if defined $conn;   # if this isn't defined then it must be a list
60   $self->{user} = $user if defined $user; 
61   $self->{startt} = $self->{t} = time;
62   $self->{state} = 0;
63   $self->{oldstate} = 0;
64   bless $self, $pkg; 
65   return $channels{$call} = $self;
66 }
67
68 # obtain a channel object by callsign [$obj = DXChannel->get($call)]
69 sub get
70 {
71   my ($pkg, $call) = @_;
72   return $channels{$call};
73 }
74
75 # obtain all the channel objects
76 sub get_all
77 {
78   my ($pkg) = @_;
79   return values(%channels);
80 }
81
82 # obtain a channel object by searching for its connection reference
83 sub get_by_cnum
84 {
85   my ($pkg, $conn) = @_;
86   my $self;
87   
88   foreach $self (values(%channels)) {
89     return $self if ($self->{conn} == $conn);
90   }
91   return undef;
92 }
93
94 # get rid of a channel object [$obj->del()]
95 sub del
96 {
97   my $self = shift;
98   delete $channels{$self->{call}};
99 }
100
101
102 # handle out going messages, immediately without waiting for the select to drop
103 # this could, in theory, block
104 sub send_now
105 {
106   my $self = shift;
107   my $conn = $self->{conn};
108   my $sort = shift;
109   my $call = $self->{call};
110   my $line;
111         
112   foreach $line (@_) {
113     chomp $line;
114         dbg('chan', "-> $sort $call $line\n");
115         $conn->send_now("$sort$call|$line");
116   }
117   $self->{t} = time;
118 }
119
120 #
121 # the normal output routine
122 #
123 sub send              # this is always later and always data
124 {
125   my $self = shift;
126   my $conn = $self->{conn};
127   my $call = $self->{call};
128   my $line;
129
130   foreach $line (@_) {
131     chomp $line;
132         dbg('chan', "-> D $call $line\n");
133         $conn->send_later("D$call|$line");
134   }
135   $self->{t} = time;
136 }
137
138 # send a file (always later)
139 sub send_file
140 {
141   my ($self, $fn) = @_;
142   my $call = $self->{call};
143   my $conn = $self->{conn};
144   my @buf;
145   
146   open(F, $fn) or die "can't open $fn for sending file ($!)";
147   @buf = <F>;
148   close(F);
149   $self->send(@buf);
150 }
151
152 # just a shortcut for $dxchan->send(msg(...));
153 sub msg
154 {
155   my $self = shift;
156   $self->send(DXM::msg(@_));
157 }
158
159 # change the state of the channel - lots of scope for debugging here :-)
160 sub state
161 {
162   my $self = shift;
163   $self->{oldstate} = $self->{state};
164   $self->{state} = shift;
165   dbg('state', "$self->{call} channel state $self->{oldstate} -> $self->{state}\n");
166 }
167
168 # various access routines
169
170 #
171 # return a list of valid elements 
172
173
174 sub fields
175 {
176   return keys(%valid);
177 }
178
179 #
180 # return a prompt for a field
181 #
182
183 sub field_prompt
184
185   my ($self, $ele) = @_;
186   return $valid{$ele};
187 }
188
189 sub AUTOLOAD
190 {
191   my $self = shift;
192   my $name = $AUTOLOAD;
193   
194   return if $name =~ /::DESTROY$/;
195   $name =~ s/.*:://o;
196   
197   die "Non-existant field '$AUTOLOAD'" if !$valid{$name};
198   @_ ? $self->{$name} = shift : $self->{$name} ;
199 }
200
201 1;
202 __END__;