cmd/dbcreate.pl

   1 #!/usr/bin/perl
   2 #
   3 # Database update routine
   4 #
   5 # Copyright (c) 1999 Dirk Koopman G1TLH
   6 #
   7 my ($self, $line) = @_;
   8 my @f = split /\s+/, $line;
   9 my $name = shift @f if @f;
  10 my @out;
  11
  12 return (1, $self->msg('e5')) if $self->priv < 9;
  13 return (1, $self->msg('db6', $name)) if DXDb::getdesc($name);
  14
  15 my $remote;
  16 my $chain;
  17 my $cmd;
  18 while (@f) {
  19         my $f = lc shift @f;
  20         if ($f eq 'remote') {
  21                 $remote = uc shift @f if @f;
  22                 next;
  23         }
  24         if ($f eq 'cmd') {
  25                 $cmd = lc shift @f if @f;
  26                 next;
  27         }
  28         if ($f eq 'chain') {
  29                 if (@f) {
  30                         $chain = [ @f ];
  31                         last;
  32                 }
  33         }
  34 }
  35 DXDb::new($name, $remote, $chain, $cmd);
  36 push @out, $self->msg($remote ? 'db7' : 'db8', $name, $remote);
  37 return (1, @out);