]> scm.dxcluster.org Git - spider.git/blob - cmd/dbimport.pl
add UPGRADE.mojo
[spider.git] / 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);