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 (17 years, 11 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>