cmd/dbimport.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 ($name, $fn) = split /\s+/, $line;
   9 my @out;
  10
  11 return (1, $self->msg('e5')) if $self->priv < 9;
  12
  13 my $db = DXDb::getdesc($name);
  14 return (1, $self->msg('db3', $name)) unless $db;
  15 return (1, $self->msg('db1', $db->remote )) if $db->remote;
  16 return (1, $self->msg('e3', 'dbimport', $fn)) unless -e $fn;
  17
  18 my $state = 0;
  19 my $key;
  20 my $value;
  21 my $count;
  22
  23 open(IMP, $fn) or return (1, "Cannot open $fn $!");
  24 while (<IMP>) {
  25         s/[\r\n]+$//g;
  26         if ($state == 0) {
  27                 if (/^\&\&/) {
  28                         $state = 0;
  29                         next;
  30                 }
  31                 $key = uc $_;
  32                 $value = undef;
  33                 ++$state if $key;
  34         } elsif ($state == 1) {
  35                 if (/^\&\&/) {
  36                         if ($key =~ /^#/) {
  37                         } elsif ($key && $value) {
  38                                 $db->putkey($key, $value);
  39                                 $count++;
  40                         }
  41                         $state = 0;
  42                         next;
  43                 } elsif (/^\%\%/) {
  44                         $state = 0;
  45                         next;
  46                 }
  47                 $value .= $_ . "\n";
  48         }
  49 }
  50 close (IMP);
  51
  52 push @out, $self->msg('db10', $count, $fn, $db->name);
  53 return (1, @out);