Я разобрался с багом периодической поломки баз при сохраниении редактируемых материалов. Лечить получилось только одним путем - перезаписью баз :-(. работает немного медленнее на сервере, зато надежно!
Вот исправление:
в фале Sanitarium_WL.pm замените процедуру
sub modify_data {...}
на этот код:
#!/usr/bin/perl -w
use File::Copy; # обязательно добавить, иначе работать не будет
.......
.......
sub modify_data {
###
my ($id, $pack_rec, $new, %data);
my $self=shift;
$id=shift;
$id=~s/\\d+//go; $id=$&;
if ($id) {
# pack & check modify record
if (@_) {$pack_rec=$self->pack_rec(@_);}
else {croak "write_data: You must get data! \\@_ empty!";}
$pack_rec=~s/\\n//go;
$pack_rec=~s/\\r//go;
# read old database
#open dbm
$self->_open_db(1, 3);
# copy data of database
%data=%dbm;
#close dbm
&_close_db;
# modify data
$data{$id}=$pack_rec;
# create database-duble
$self->{DB_File}.="new";
if (-e "$self->{DB_File}.dat") {
unless (unlink "$self->{DB_File}.dat") {croak "Не удалось удалить резервную базу! $self->{DB_File}!";}
}
$self-> _open_db(1, 1);
%dbm=%data;
&_close_db;
$new=$self->{DB_File};
$self->{DB_File}=~s/new//go;
# replace new to old database
if (-e "$new.dat") {
unlink "$self->{DB_File}.dat";
unlink "$self->{DB_File}.lock";
if (-e "$self->{DB_File}.dat") {croak "Не удалось удалить основную базу! $self->{DB_File}!";}
copy ("$new.dat", "$self->{DB_File}.dat");
unlink "$new.dat";
unlink "$new.lock";
if (-e "$new.dat") {croak "Не удалось удалить резервную базу! $self->{DB_File}!";}
}
}
else { croak "modify_data: Отсутствующий или неправильный id записи! \\$id = $id"; }
### end sub
}
И все будер РУЛЕЗ!! :-)