Return to db_copy.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

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

    1: #!/usr/bin/perl
    2: 
    3: 
    4: use strict;
    5: use warnings;
    6: use lib '/home/httpd/lib/perl';
    7: use GDBM_File;
    8: use File::Find;
    9: use LONCAPA;
   10: use LONCAPA::Configuration;
   11: use Cwd;
   12: 
   13: my $dump_db = './dump_db';
   14: my $dir = './test';
   15: 
   16: my  %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
   17: 
   18: {
   19:     my $straight;
   20:     sub lock_db {
   21: 	my ($fname) = @_;
   22: 	my $dbref;
   23: 	$fname = &Cwd::abs_path($fname);
   24: 	if ($fname =~ m/^\Q$perlvar{'lonUsersDir'}\E/) {
   25: 	    $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
   26: 	    $straight=0;
   27: 	} else {
   28: 	    if (tie(my %db,'GDBM_File',$fname,&GDBM_READER(),0640)) {
   29: 		$dbref = \%db;
   30: 	    }
   31: 	    $straight=1;
   32: 	}
   33: 	return $dbref;
   34:     }
   35: 
   36:     sub unlock_db {
   37: 	my ($dbref) = @_;
   38: 	if ($straight) {
   39: 	    untie($dbref);
   40: 	} else {
   41: 	    &LONCAPA::locking_hash_untie($dbref);
   42: 	}
   43:     }
   44: }
   45: 
   46: sub process_db {
   47:     return if ($_!~m/\.db$/);
   48:     my $file = $_;
   49:     my $dbref =&lock_db($file);
   50:     print("attempting $dbref\n");
   51:     my %newdb;
   52:     my $new_file = $file.'.new';
   53:     if (!tie(%newdb,'GDBM_File',$new_file,&GDBM_WRCREAT(),0640)) {
   54: 	die("unable to create new db $new_file $! $@");
   55:     }
   56:     open(my $fh,"$dump_db -f $file|");
   57:     while (my $entry = <$fh>) {
   58: 	chomp($entry);
   59: 	if ($entry =~/^ERROR:/) {
   60: 	    die($entry);
   61: 	}
   62: 	my ($key,$value) = split(' -> ',$entry,2);
   63: 	$newdb{&unescape($key)} = &unescape($value);
   64:     }
   65:     print("finishing $dbref\n");
   66:     untie(%newdb);
   67:     untie($dbref);
   68:     system("/bin/mv $file $file.old");
   69:     system("/bin/mv $file.new $file");
   70:     &unlock_db($dbref);
   71: }
   72: 
   73: sub main {
   74:     find(
   75: 	 {
   76: 	     no_chdir   => 1,
   77: 	     wanted     => \&process_db,
   78: 	 }, 
   79: 	 $dir
   80: 	 #$perlvar->{'lonUsersDir'}
   81: 	 );
   82: }
   83: 
   84: &main();