# db8_update - updates given db with minimal changes # Usage: db8_update($strOrFile, $db) # 2013-2017 Vlado Keselj, version 1.4; documentation in DB822.txt sub db8_update { my $arg = shift; my $db=shift; my $file=''; if ($arg =~ /^file=/) { $file = $'; die "file=''!?" if $file eq ''; local $F; open(F, $file) or die "cannot open $file:$!"; $arg = join('', ); close(F); } my $arg_save = $arg; my $dbi = 0; my $argcopy = ''; while ($arg) { # allow comments and space betwen records if ($arg =~ /^(\s*\n|[ \t]*#.*\n)*/) { $argcopy.=$&; $arg = $'; } my $record; if ($arg =~ /\n(\n+)/) { $record = "$`\n"; $arg = $1.$'; } else { $record = $arg; $arg = ''; } if ($dbi > $#{$db}) { last } my $r = {}; my %savedkeys = (); while ($record) { my $avpair = ''; if ($record =~ /^.*/) { $avpair = $& } while ($record =~ /^(.*)(\\\n|\n[ \t]+)(.*)/) { $record = "$1 $3$'"; $avpair.= $2.$3; } $record =~ /^([^\n:]*):(.*)\n/ or die; my $k = $1; my $v = $2; $record = $'; $avpair .= "\n"; if (exists($r->{$k})) { my $c = 0; while (exists($r->{"$k-$c"})) { ++$c } $k = "$k-$c"; } $r->{$k} = $v; if (exists($db->[$dbi]->{$k}) && $db->[$dbi]->{$k} eq $v) { $argcopy .= $avpair } elsif (exists($db->[$dbi]->{$k})) { my $newv = $db->[$dbi]->{$k}; $newv =~ s/\s/ /g; #to be improved $argcopy .= "$k:$newv\n"; } # else skip it $savedkeys{$k} = 1; } for my $k (keys %{ $db->[$dbi] }) { if (!exists($savedkeys{$k})) { my $newv = $db->[$dbi]->{$k}; $newv =~ s/\s/ /g; #to be improved $argcopy .= "$k:$newv\n"; } } ++$dbi; } while ($dbi <= $#{$db}) { $argcopy .= "\n"; for my $k (sort(keys(%{ $db->[$dbi] }))) { my $newv = $db->[$dbi]->{$k}; $newv =~ s/\s/ /g; #to be improved $argcopy .= "$k:$newv\n"; } ++$dbi; } if ($file ne '') { if ($argcopy ne $arg_save) { rename($file, "$file.bak"); local $F; open(F,">$file"); print F $argcopy; close(F); } return; } else { return $argcopy } } # end of db8_update