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

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: 
1.7     ! albertel   20: 
        !            21: my $return_code = system("$create_db >& /dev/null");
        !            22: # create_db exits on 1 if no filename to create was specified and is thus
        !            23: # a successful start and stop of the program
        !            24: if ($return_code == -1
        !            25:     || (($return_code >> 8) != 1)) {
        !            26:     $create_db = '/home/httpd/perl/debug/create_db_dynamic_64_so.3';
        !            27:     printf("booM %d %d!\n",$return_code,($return_code >> 8 ));
        !            28:     $return_code = system("$create_db >& /dev/null");
        !            29:     if ($return_code == -1
        !            30: 	|| (($return_code >> 8) != 1)) {
        !            31: 	printf("booM2 %d %d!\n",$return_code,($return_code >> 8 ));
        !            32: 	die("Unable to run need helper program create_db_dynamic_64");
        !            33:     }
        !            34: }
        !            35: 
1.1       albertel   36: my  %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
                     37: 
1.4       albertel   38: my $do_locks = 1;
1.1       albertel   39: {
                     40:     sub lock_db {
1.4       albertel   41:         my ($fname) = @_;
                     42:         my $sym;
                     43:         if ($do_locks) {
                     44:             open($sym,">>$fname.lock");
                     45:             flock($sym,(LOCK_EX));
                     46:         }
                     47:         return $sym;
1.1       albertel   48:     }
                     49: 
                     50:     sub unlock_db {
1.4       albertel   51:         my ($sym) = @_;
                     52:         if (ref($sym)) {
                     53:             flock($sym,(LOCK_UN));
                     54:         }
1.1       albertel   55:     }
                     56: }
                     57: 
1.4       albertel   58: my $count=0;
                     59: sub count_db {
                     60:     return if ($_!~m/\.db$/);
                     61:     $count++;
                     62: }
                     63: 
                     64: my $done=0;
1.5       albertel   65: my $skip=0;
1.4       albertel   66: my $starttime;
                     67: my $last_100_start_time;
1.1       albertel   68: sub process_db {
                     69:     return if ($_!~m/\.db$/);
1.4       albertel   70:     if (!-e "$_.old") {
                     71: 	my $file = $_;
                     72: 	my $dbref =&lock_db($file);
                     73: 	#print("attempting $file\n");
                     74: 	system("$dump_db -f $file|$create_db -f $file.new");
1.2       albertel   75: #    print("finishing $dbref\n");
1.4       albertel   76: 	rename($file,"$file.old");
                     77: 	rename("$file.new","$file");
                     78: 	&unlock_db($dbref);
1.5       albertel   79:     } else {
                     80: 	#print("skip $_\n");
                     81: 	$skip++;
1.4       albertel   82:     }
                     83:     $done++;
                     84:     if (!($done %100)) {
                     85:         print("$_\n");
                     86:         my $took = time()-$starttime;
                     87:         my $togo = int(($took/$done) * ($count-$done));
                     88:         my $total = $togo+$took;
1.5       albertel   89: 	my $per = ($done-$skip)?$took/($done-$skip):0;
1.4       albertel   90:         my $last_per = (time()-$last_100_start_time)/100;
1.5       albertel   91:         printf("%6d (%6d) in %6d, togo %6d, overall %6d, %.3f (each), %.3f\n",
                     92: 	       $done,$skip,$took,$togo,$total,$per,$last_per);
1.4       albertel   93:         $last_100_start_time = time();
                     94:     }
1.1       albertel   95: }
                     96: 
                     97: sub main {
1.6       albertel   98:     my $dir = $perlvar{'lonUsersDir'};
1.4       albertel   99:     print("Doing $dir\n");
                    100:     &find({ no_chdir   => 1,
                    101:             wanted     => \&count_db, },
                    102:           $dir);
                    103:     print("Found $count db to do\n");
                    104:     $last_100_start_time = $starttime = time();
                    105:     &find({ no_chdir   => 1,
                    106:             wanted     => \&process_db, },
                    107:           $dir);
                    108: 
1.1       albertel  109: }
                    110: 
                    111: &main();

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