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         chomp;
  26         s/\r//g;
  27         if ($state == 0) {
  28                 if (/^\&\&/) {
  29                         $state = 0;
  30                         next;
  31                 }
  32                 $key = uc $_;
  33                 $value = undef;
  34                 ++$state if $key;
  35         } elsif ($state == 1) {
  36                 if (/^\&\&/) {
  37                         if ($key =~ /^#/) {
  38                         } elsif ($key && $value) {
  39                                 $db->putkey($key, $value);
  40                                 $count++;
  41                         }
  42                         $state = 0;
  43                         next;
  44                 } elsif (/^\%\%/) {
  45                         $state = 0;
  46                         next;
  47                 }
  48                 $value .= $_ . "\n";
  49         }
  50 }
  51 close (IMP);
  52
  53 push @out, $self->msg('db10', $count, $db->name);
  54 return (1, @out);