Annotation of loncom/debugging_tools/db_copy.pl, revision 1.6

1.1       albertel    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;
1.5       albertel   11: use Fcntl qw(:flock);
1.1       albertel   12: 
1.3       albertel   13: my $dump_db = '/home/httpd/perl/debug/dump_db_static_32';
1.5       albertel   14: my $create_db = '/home/httpd/perl/debug/create_db_dynamic_64';
1.3       albertel   15: if (!-x $dump_db || !-x $create_db) {
                     16:     print("Unable to run needed helper programs\n $dump_db\n $create_db\n.");
                     17:     exit(-1);
                     18: }
1.1       albertel   19: 
                     20: my  %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
                     21: 
1.4       albertel   22: my $do_locks = 1;
1.1       albertel   23: {
                     24:     sub lock_db {
1.4       albertel   25:         my ($fname) = @_;
                     26:         my $sym;
                     27:         if ($do_locks) {
                     28:             open($sym,">>$fname.lock");
                     29:             flock($sym,(LOCK_EX));
                     30:         }
                     31:         return $sym;
1.1       albertel   32:     }
                     33: 
                     34:     sub unlock_db {
1.4       albertel   35:         my ($sym) = @_;
                     36:         if (ref($sym)) {
                     37:             flock($sym,(LOCK_UN));
                     38:         }
1.1       albertel   39:     }
                     40: }
                     41: 
1.4       albertel   42: my $count=0;
                     43: sub count_db {
                     44:     return if ($_!~m/\.db$/);
                     45:     $count++;
                     46: }
                     47: 
                     48: my $done=0;
1.5       albertel   49: my $skip=0;
1.4       albertel   50: my $starttime;
                     51: my $last_100_start_time;
1.1       albertel   52: sub process_db {
                     53:     return if ($_!~m/\.db$/);
1.4       albertel   54:     if (!-e "$_.old") {
                     55: 	my $file = $_;
                     56: 	my $dbref =&lock_db($file);
                     57: 	#print("attempting $file\n");
                     58: 	system("$dump_db -f $file|$create_db -f $file.new");
1.2       albertel   59: #    print("finishing $dbref\n");
1.4       albertel   60: 	rename($file,"$file.old");
                     61: 	rename("$file.new","$file");
                     62: 	&unlock_db($dbref);
1.5       albertel   63:     } else {
                     64: 	#print("skip $_\n");
                     65: 	$skip++;
1.4       albertel   66:     }
                     67:     $done++;
                     68:     if (!($done %100)) {
                     69:         print("$_\n");
                     70:         my $took = time()-$starttime;
                     71:         my $togo = int(($took/$done) * ($count-$done));
                     72:         my $total = $togo+$took;
1.5       albertel   73: 	my $per = ($done-$skip)?$took/($done-$skip):0;
1.4       albertel   74:         my $last_per = (time()-$last_100_start_time)/100;
1.5       albertel   75:         printf("%6d (%6d) in %6d, togo %6d, overall %6d, %.3f (each), %.3f\n",
                     76: 	       $done,$skip,$took,$togo,$total,$per,$last_per);
1.4       albertel   77:         $last_100_start_time = time();
                     78:     }
1.1       albertel   79: }
                     80: 
                     81: sub main {
1.6     ! albertel   82:     my $dir = $perlvar{'lonUsersDir'};
1.4       albertel   83:     print("Doing $dir\n");
                     84:     &find({ no_chdir   => 1,
                     85:             wanted     => \&count_db, },
                     86:           $dir);
                     87:     print("Found $count db to do\n");
                     88:     $last_100_start_time = $starttime = time();
                     89:     &find({ no_chdir   => 1,
                     90:             wanted     => \&process_db, },
                     91:           $dir);
                     92: 
1.1       albertel   93: }
                     94: 
                     95: &main();

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