#!/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();