Return to db_copy.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

- some dists use gdbm 1.8.3 which has a different so number

    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 Fcntl qw(:flock);
   12: 
   13: my $dump_db = '/home/httpd/perl/debug/dump_db_static_32';
   14: my $create_db = '/home/httpd/perl/debug/create_db_dynamic_64';
   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: }
   19: 
   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: 
   36: my  %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
   37: 
   38: my $do_locks = 1;
   39: {
   40:     sub lock_db {
   41:         my ($fname) = @_;
   42:         my $sym;
   43:         if ($do_locks) {
   44:             open($sym,">>$fname.lock");
   45:             flock($sym,(LOCK_EX));
   46:         }
   47:         return $sym;
   48:     }
   49: 
   50:     sub unlock_db {
   51:         my ($sym) = @_;
   52:         if (ref($sym)) {
   53:             flock($sym,(LOCK_UN));
   54:         }
   55:     }
   56: }
   57: 
   58: my $count=0;
   59: sub count_db {
   60:     return if ($_!~m/\.db$/);
   61:     $count++;
   62: }
   63: 
   64: my $done=0;
   65: my $skip=0;
   66: my $starttime;
   67: my $last_100_start_time;
   68: sub process_db {
   69:     return if ($_!~m/\.db$/);
   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");
   75: #    print("finishing $dbref\n");
   76: 	rename($file,"$file.old");
   77: 	rename("$file.new","$file");
   78: 	&unlock_db($dbref);
   79:     } else {
   80: 	#print("skip $_\n");
   81: 	$skip++;
   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;
   89: 	my $per = ($done-$skip)?$took/($done-$skip):0;
   90:         my $last_per = (time()-$last_100_start_time)/100;
   91:         printf("%6d (%6d) in %6d, togo %6d, overall %6d, %.3f (each), %.3f\n",
   92: 	       $done,$skip,$took,$togo,$total,$per,$last_per);
   93:         $last_100_start_time = time();
   94:     }
   95: }
   96: 
   97: sub main {
   98:     my $dir = $perlvar{'lonUsersDir'};
   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: 
  109: }
  110: 
  111: &main();