]> scm.dxcluster.org Git - spider.git/blob - perl/DXChannel.pm
I think I have most the SSID probs cracked.
[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 DXM;
30 use DXUtil;
31 use DXDebug;
32 use Carp;
33
34 use strict;
35 use vars qw(%channels %valid);
36
37 %channels = undef;
38
39 %valid = (
40   call => '0,Callsign',
41   conn => '9,Msg Conn ref',
42   user => '9,DXUser ref',
43   startt => '0,Start Time,atime',
44   t => '9,Time,atime',
45   pc50_t => '9,Last PC50 Time,atime',
46   priv => '9,Privilege',
47   state => '0,Current State',
48   oldstate => '5,Last State',
49   list => '9,Dep Chan List',
50   name => '0,User Name',
51   consort => '9,Connection Type',
52   sort => '9,Type of Channel',
53   wwv => '0,Want WWV,yesno',
54   talk => '0,Want Talk,yesno',
55   ann => '0,Want Announce,yesno',
56   here => '0,Here?,yesno',
57   confmode => '0,In Conference?,yesno',
58   dx => '0,DX Spots,yesno',
59   redirect => '0,Redirect messages to',
60   lang => '0,Language',
61   func => '9,Function',
62   loc => '9,Local Vars',     # used by func to store local variables in
63   lastread => '9,Last Msg Read',
64   outbound => '9,outbound?,yesno',
65   remotecmd => '9,doing rcmd,yesno',
66   pc34to => '9,last rcmd call',
67   pc34t => '9,last rcmd time,atime',
68   pings => '9,out/st pings',
69   pagelth => '0,Page Length',
70   pagedata => '9,Page Data Store',
71 );
72
73 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
74 sub alloc
75 {
76   my ($pkg, $call, $conn, $user) = @_;
77   my $self = {};
78   
79   die "trying to create a duplicate channel for $call" if $channels{$call};
80   $self->{call} = $call;
81   $self->{conn} = $conn if defined $conn;   # if this isn't defined then it must be a list
82   $self->{user} = $user if defined $user; 
83   $self->{startt} = $self->{t} = time;
84   $self->{state} = 0;
85   $self->{oldstate} = 0;
86   $self->{lang} = $user->{lang} if defined $user;
87   $self->{lang} = $main::lang if !$self->{lang};
88   bless $self, $pkg; 
89   return $channels{$call} = $self;
90 }
91
92 # obtain a channel object by callsign [$obj = DXChannel->get($call)]
93 sub get
94 {
95   my ($pkg, $call) = @_;
96   return $channels{$call};
97 }
98
99 # obtain all the channel objects
100 sub get_all
101 {
102   my ($pkg) = @_;
103   return values(%channels);
104 }
105
106 # obtain a channel object by searching for its connection reference
107 sub get_by_cnum
108 {
109   my ($pkg, $conn) = @_;
110   my $self;
111   
112   foreach $self (values(%channels)) {
113     return $self if ($self->{conn} == $conn);
114   }
115   return undef;
116 }
117
118 # get rid of a channel object [$obj->del()]
119 sub del
120 {
121   my $self = shift;
122   delete $channels{$self->{call}};
123 }
124
125 # is it an ak1a cluster ?
126 sub is_ak1a
127 {
128   my $self = shift;
129   return $self->{sort} eq 'A';
130 }
131
132 # is it a user?
133 sub is_user
134 {
135   my $self = shift;
136   return $self->{sort} eq 'U';
137 }
138
139 # is it a connect type
140 sub is_connect
141 {
142   my $self = shift;
143   return $self->{sort} eq 'C';
144 }
145
146 # handle out going messages, immediately without waiting for the select to drop
147 # this could, in theory, block
148 sub send_now
149 {
150   my $self = shift;
151   my $conn = $self->{conn};
152   my $sort = shift;
153   my $call = $self->{call};
154   my $line;
155         
156   foreach $line (@_) {
157     chomp $line;
158         dbg('chan', "-> $sort $call $line\n") if $conn;
159         $conn->send_now("$sort$call|$line") if $conn;
160   }
161   $self->{t} = time;
162 }
163
164 #
165 # the normal output routine
166 #
167 sub send              # this is always later and always data
168 {
169   my $self = shift;
170   my $conn = $self->{conn};
171   my $call = $self->{call};
172   my $line;
173
174   foreach $line (@_) {
175     chomp $line;
176         dbg('chan', "-> D $call $line\n") if $conn;
177         $conn->send_later("D$call|$line") if $conn;
178   }
179   $self->{t} = time;
180 }
181
182 # send a file (always later)
183 sub send_file
184 {
185   my ($self, $fn) = @_;
186   my $call = $self->{call};
187   my $conn = $self->{conn};
188   my @buf;
189   
190   open(F, $fn) or die "can't open $fn for sending file ($!)";
191   @buf = <F>;
192   close(F);
193   $self->send(@buf);
194 }
195
196 # this will implement language independence (in time)
197 sub msg
198 {
199   my $self = shift;
200   return DXM::msg($self->{lang}, @_);
201 }
202
203 # change the state of the channel - lots of scope for debugging here :-)
204 sub state
205 {
206   my $self = shift;
207   if (@_) {
208     $self->{oldstate} = $self->{state};
209     $self->{state} = shift;
210     dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n");
211   }
212   return $self->{state};
213 }
214
215 # disconnect this channel
216 sub disconnect
217 {
218   my $self = shift;
219   my $user = $self->{user};
220   my $conn = $self->{conn};
221   $self->finish();
222   $user->close() if defined $user;
223   $conn->disconnect() if defined $conn;
224   $self->del();
225 }
226
227 # various access routines
228
229 #
230 # return a list of valid elements 
231
232
233 sub fields
234 {
235   return keys(%valid);
236 }
237
238 #
239 # return a prompt for a field
240 #
241
242 sub field_prompt
243
244   my ($self, $ele) = @_;
245   return $valid{$ele};
246 }
247
248 no strict;
249 sub AUTOLOAD
250 {
251   my $self = shift;
252   my $name = $AUTOLOAD;
253   return if $name =~ /::DESTROY$/;
254   $name =~ s/.*:://o;
255   
256   confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
257   @_ ? $self->{$name} = shift : $self->{$name} ;
258 }
259
260 1;
261 __END__;