#!/usr/bin/perl
use strict;
use warnings;
use lib '/home/httpd/lib/perl';
use GDBM_File;
use File::Find;
use LONCAPA;
use LONCAPA::Configuration;
use Cwd;
my $dump_db = './dump_db';
my $dir = './test';
my %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
{
my $straight;
sub lock_db {
my ($fname) = @_;
my $dbref;
$fname = &Cwd::abs_path($fname);
if ($fname =~ m/^\Q$perlvar{'lonUsersDir'}\E/) {
$dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
$straight=0;
} else {
if (tie(my %db,'GDBM_File',$fname,&GDBM_READER(),0640)) {
$dbref = \%db;
}
$straight=1;
}
return $dbref;
}
sub unlock_db {
my ($dbref) = @_;
if ($straight) {
untie($dbref);
} else {
&LONCAPA::locking_hash_untie($dbref);
}
}
}
sub process_db {
return if ($_!~m/\.db$/);
my $file = $_;
my $dbref =&lock_db($file);
print("attempting $dbref\n");
my %newdb;
my $new_file = $file.'.new';
if (!tie(%newdb,'GDBM_File',$new_file,&GDBM_WRCREAT(),0640)) {
die("unable to create new db $new_file $! $@");
}
open(my $fh,"$dump_db -f $file|");
while (my $entry = <$fh>) {
chomp($entry);
if ($entry =~/^ERROR:/) {
die($entry);
}
my ($key,$value) = split(' -> ',$entry,2);
$newdb{&unescape($key)} = &unescape($value);
}
print("finishing $dbref\n");
untie(%newdb);
untie($dbref);
system("/bin/mv $file $file.old");
system("/bin/mv $file.new $file");
&unlock_db($dbref);
}
sub main {
find(
{
no_chdir => 1,
wanted => \&process_db,
},
$dir
#$perlvar->{'lonUsersDir'}
);
}
&main();
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>