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

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;
                     11: use Cwd;
                     12: 
1.3       albertel   13: my $dump_db = '/home/httpd/perl/debug/dump_db_static_32';
                     14: my $create_db = '/home/httpd/perl/debug/create_db_dynamic';
                     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;
        !            49: my $starttime;
        !            50: my $last_100_start_time;
1.1       albertel   51: sub process_db {
                     52:     return if ($_!~m/\.db$/);
1.4     ! albertel   53:     if (!-e "$_.old") {
        !            54: 	my $file = $_;
        !            55: 	my $dbref =&lock_db($file);
        !            56: 	#print("attempting $file\n");
        !            57: 	system("$dump_db -f $file|$create_db -f $file.new");
1.2       albertel   58: #    print("finishing $dbref\n");
1.4     ! albertel   59: 	rename($file,"$file.old");
        !            60: 	rename("$file.new","$file");
        !            61: 	&unlock_db($dbref);
        !            62:     }
        !            63:     $done++;
        !            64:     if (!($done %100)) {
        !            65:         print("$_\n");
        !            66:         my $took = time()-$starttime;
        !            67:         my $togo = int(($took/$done) * ($count-$done));
        !            68:         my $total = $togo+$took;
        !            69:         my $per = $took/$done;
        !            70:         my $last_per = (time()-$last_100_start_time)/100;
        !            71:         printf("%6d in %6d, togo %6d, overall %6d, %.4f (for one), %.4f)\n",
        !            72: 	       $done,$took,$togo,$total,$per,$last_per);
        !            73:         $last_100_start_time = time();
        !            74:     }
1.1       albertel   75: }
                     76: 
                     77: sub main {
1.4     ! albertel   78:     my $dir = $perlvar{'lonUsersDir'}.'/temp/y/';
        !            79:     print("Doing $dir\n");
        !            80:     &find({ no_chdir   => 1,
        !            81:             wanted     => \&count_db, },
        !            82:           $dir);
        !            83:     print("Found $count db to do\n");
        !            84:     $last_100_start_time = $starttime = time();
        !            85:     &find({ no_chdir   => 1,
        !            86:             wanted     => \&process_db, },
        !            87:           $dir);
        !            88: 
1.1       albertel   89: }
                     90: 
                     91: &main();

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