Return to db_copy.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

- adding scripts to allow morphing 32bit to 64 bit db

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