3 # Database Handler module for DXSpider
5 # Copyright (c) 1999 Dirk Koopman G1TLH
17 use vars qw($opentime $dbbase %avail %valid $lastprocesstime $nextstream %stream);
19 $opentime = 5*60; # length of time a database stays open after last access
20 $dbbase = "$main::root/db"; # where all the databases are kept;
21 %avail = (); # The hash contains a list of all the databases
23 accesst => '9,Last Accs Time,atime',
24 createt => '9,Create Time,atime',
25 lastt => '9,Last Upd Time,atime',
27 db => '9,DB Tied hash',
28 remote => '0,Remote Database',
29 pre => '0,Heading txt',
31 chain => '0,Search these,parray',
32 disable => '0,Disabled?,yesno',
33 nf => '0,Not Found txt',
34 cal => '0,No Key txt',
35 allowread => '9,Allowed read,parray',
36 denyread => '9,Deny read,parray',
37 allowupd => '9,Allow upd,parray',
38 denyupd => '9,Deny upd,parray',
39 fwdupd => '9,Forw upd to,parray',
40 template => '9,Upd Templates,parray',
41 te => '9,End Upd txt',
42 tae => '9,End App txt',
43 atemplate => '9,App Templates,parray',
44 help => '0,Help txt,parray',
45 localcmd => '0,Local Command',
48 $lastprocesstime = time;
52 use vars qw($VERSION $BRANCH);
53 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
54 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
55 $main::build += $VERSION;
56 $main::branch += $BRANCH;
58 # allocate a new stream for this request
62 my $n = ++$nextstream;
63 $stream{$n} = { n=>$n, call=>$call, t=>$main::systime };
81 # load all the database descriptors
84 my $s = readfilestr($dbbase, "dbs", "pl");
89 %avail = ( %$a ) if ref $a;
93 # save all the database descriptors
97 writefilestr($dbbase, "dbs", "pl", \%avail);
100 # get the descriptor of the database you want.
103 return undef unless %avail;
106 my $r = $avail{$name};
108 # search for a partial if not found direct
110 for (sort { $a->{name} cmp $b->{name} }values %avail) {
111 if ($_->{name} =~ /^$name/) {
124 $self->{accesst} = $main::systime;
125 return $self->{db} if $self->{db};
127 $self->{db} = tie %hash, 'DB_File', "$dbbase/$self->{name}";
146 for (values %avail) {
152 # get a value from the database
159 # make sure we are open
161 if ($self->{localcmd}) {
162 my $dxchan = $main::me;
163 $dxchan->{remotecmd} = 1; # for the benefit of any command that needs to know
164 my $oldpriv = $dxchan->{priv};
166 my @in = (DXCommandmode::run_cmd($dxchan, "$self->{localcmd} $key"));
167 $dxchan->{priv} = $oldpriv;
168 delete $dxchan->{remotecmd};
169 return @in ? join("\n", @in) : undef;
170 } elsif ($self->{db}) {
171 my $s = $self->{db}->get($key, $value);
172 return $s ? undef : $value;
177 # put a value to the database
184 # make sure we are open
187 my $s = $self->{db}->put($key, $value);
188 return $s ? undef : 1;
193 # create a new database params: <name> [<remote node call>]
202 $self->{name} = lc $name;
203 $self->{remote} = uc $remote if $remote;
204 $self->{chain} = $chain if $chain && ref $chain;
205 $self->{accesst} = $self->{createt} = $self->{lastt} = $main::systime;
206 $self->{localcmd} = lc $cmd if $cmd;
208 $avail{$self->{name}} = $self;
209 mkdir $dbbase, 02775 unless -e $dbbase;
219 unlink "$dbbase/$self->{name}";
220 delete $avail{$self->{name}};
225 # process intermediate lines for an update
226 # NOTE THAT THIS WILL BE CALLED FROM DXCommandmode and the
227 # object will be a DXChannel (actually DXCommandmode)
235 # periodic maintenance
237 # just close any things that haven't been accessed for the default
243 my ($dxchan, $line) = @_;
245 # this is periodic processing
246 if (!$dxchan || !$line) {
247 if ($main::systime - $lastprocesstime >= 60) {
249 for (values %avail) {
250 if ($main::systime - $_->{accesst} > $opentime) {
255 $lastprocesstime = $main::systime;
260 my @f = split /\^/, $line;
261 my ($pcno) = $f[0] =~ /^PC(\d\d)/; # just get the number
263 # route out ones that are not for us
264 if ($f[1] eq $main::mycall) {
267 $dxchan->route($f[1], $line);
272 if ($pcno == 37) { # probably obsolete
276 if ($pcno == 44) { # incoming DB Request
277 my @in = DXCommandmode::run_cmd($dxchan, "dbshow $f[4] $f[5]");
278 sendremote($dxchan, $f[2], $f[3], @in);
282 if ($pcno == 45) { # incoming DB Information
283 my $n = getstream($f[3]);
285 my $mchan = DXChannel->get($n->{call});
286 $mchan->send($f[2] . ":$f[4]") if $mchan;
291 if ($pcno == 46) { # incoming DB Complete
296 if ($pcno == 47) { # incoming DB Update request
300 if ($pcno == 48) { # incoming DB Update request
306 # send back a trache of data to the remote
307 # remember $dxchan is a dxchannel
315 $dxchan->send(DXProt::pc45($main::mycall, $tonode, $stream, $_));
317 $dxchan->send(DXProt::pc46($main::mycall, $tonode, $stream));
320 # print a value from the db reference
325 return $self->{$s} ? $self->{$s} : undef;
328 # various access routines
331 # return a list of valid elements
340 # return a prompt for a field
345 my ($self, $ele) = @_;
353 my $name = $AUTOLOAD;
354 return if $name =~ /::DESTROY$/;
357 confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
358 # this clever line of code creates a subroutine which takes over from autoload
359 # from OO Perl - Conway
360 *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};