File:  [LON-CAPA] / loncom / debugging_tools / db_copy.pl
Revision 1.7: download - view: text, annotated - select for diffs
Fri Jun 1 19:00:05 2007 UTC (16 years, 10 months ago) by albertel
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_99_0, version_2_9_1, version_2_9_0, version_2_8_X, version_2_8_99_1, version_2_8_99_0, version_2_8_2, version_2_8_1, version_2_8_0, version_2_7_X, version_2_7_99_1, version_2_7_99_0, version_2_7_1, version_2_7_0, version_2_6_X, version_2_6_99_1, version_2_6_99_0, version_2_6_3, version_2_6_2, version_2_6_1, version_2_6_0, version_2_5_X, version_2_5_99_1, version_2_5_99_0, version_2_5_2, version_2_5_1, version_2_5_0, version_2_4_X, version_2_4_99_0, version_2_4_2, version_2_4_1, version_2_4_0, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, bz6209-base, bz6209, bz5969, bz2851, PRINT_INCOMPLETE_base, PRINT_INCOMPLETE, HEAD, GCI_3, GCI_2, GCI_1, BZ5971-printing-apage, BZ5434-fox, BZ4492-merge, BZ4492-feature_horizontal_radioresponse, BZ4492-feature_Support_horizontal_radioresponse, BZ4492-Support_horizontal_radioresponse
- some dists use gdbm 1.8.3 which has a different so number

#!/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 Fcntl qw(:flock);

my $dump_db = '/home/httpd/perl/debug/dump_db_static_32';
my $create_db = '/home/httpd/perl/debug/create_db_dynamic_64';
if (!-x $dump_db || !-x $create_db) {
    print("Unable to run needed helper programs\n $dump_db\n $create_db\n.");
    exit(-1);
}


my $return_code = system("$create_db >& /dev/null");
# create_db exits on 1 if no filename to create was specified and is thus
# a successful start and stop of the program
if ($return_code == -1
    || (($return_code >> 8) != 1)) {
    $create_db = '/home/httpd/perl/debug/create_db_dynamic_64_so.3';
    printf("booM %d %d!\n",$return_code,($return_code >> 8 ));
    $return_code = system("$create_db >& /dev/null");
    if ($return_code == -1
	|| (($return_code >> 8) != 1)) {
	printf("booM2 %d %d!\n",$return_code,($return_code >> 8 ));
	die("Unable to run need helper program create_db_dynamic_64");
    }
}

my  %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};

my $do_locks = 1;
{
    sub lock_db {
        my ($fname) = @_;
        my $sym;
        if ($do_locks) {
            open($sym,">>$fname.lock");
            flock($sym,(LOCK_EX));
        }
        return $sym;
    }

    sub unlock_db {
        my ($sym) = @_;
        if (ref($sym)) {
            flock($sym,(LOCK_UN));
        }
    }
}

my $count=0;
sub count_db {
    return if ($_!~m/\.db$/);
    $count++;
}

my $done=0;
my $skip=0;
my $starttime;
my $last_100_start_time;
sub process_db {
    return if ($_!~m/\.db$/);
    if (!-e "$_.old") {
	my $file = $_;
	my $dbref =&lock_db($file);
	#print("attempting $file\n");
	system("$dump_db -f $file|$create_db -f $file.new");
#    print("finishing $dbref\n");
	rename($file,"$file.old");
	rename("$file.new","$file");
	&unlock_db($dbref);
    } else {
	#print("skip $_\n");
	$skip++;
    }
    $done++;
    if (!($done %100)) {
        print("$_\n");
        my $took = time()-$starttime;
        my $togo = int(($took/$done) * ($count-$done));
        my $total = $togo+$took;
	my $per = ($done-$skip)?$took/($done-$skip):0;
        my $last_per = (time()-$last_100_start_time)/100;
        printf("%6d (%6d) in %6d, togo %6d, overall %6d, %.3f (each), %.3f\n",
	       $done,$skip,$took,$togo,$total,$per,$last_per);
        $last_100_start_time = time();
    }
}

sub main {
    my $dir = $perlvar{'lonUsersDir'};
    print("Doing $dir\n");
    &find({ no_chdir   => 1,
            wanted     => \&count_db, },
          $dir);
    print("Found $count db to do\n");
    $last_100_start_time = $starttime = time();
    &find({ no_chdir   => 1,
            wanted     => \&process_db, },
          $dir);

}

&main();

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>