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 while (@f) {
  18         my $f = lc shift @f;
  19         if ($f eq 'remote') {
  20                 $remote = uc shift @f if @f;
  21                 next;
  22         }
  23         if ($f eq 'chain') {
  24                 if (@f) {
  25                         $chain = [ @f ];
  26                         last;
  27                 }
  28         }
  29 }
  30 DXDb::new($name, $remote, $chain);
  31 push @out, $self->msg($remote ? 'db7' : 'db8', $name, $remote);
  32 return (1, @out);