Return to db_copy.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

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

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: 
                     22: {
                     23:     my $straight;
                     24:     sub lock_db {
                     25: 	my ($fname) = @_;
                     26: 	my $dbref;
                     27: 	$fname = &Cwd::abs_path($fname);
                     28: 	if ($fname =~ m/^\Q$perlvar{'lonUsersDir'}\E/) {
                     29: 	    $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
                     30: 	    $straight=0;
                     31: 	} else {
                     32: 	    if (tie(my %db,'GDBM_File',$fname,&GDBM_READER(),0640)) {
                     33: 		$dbref = \%db;
                     34: 	    }
                     35: 	    $straight=1;
                     36: 	}
                     37: 	return $dbref;
                     38:     }
                     39: 
                     40:     sub unlock_db {
                     41: 	my ($dbref) = @_;
                     42: 	if ($straight) {
                     43: 	    untie($dbref);
                     44: 	} else {
                     45: 	    &LONCAPA::locking_hash_untie($dbref);
                     46: 	}
                     47:     }
                     48: }
                     49: 
                     50: sub process_db {
                     51:     return if ($_!~m/\.db$/);
                     52:     my $file = $_;
                     53:     my $dbref =&lock_db($file);
1.2       albertel   54:     print("attempting $file\n");
1.1       albertel   55:     my %newdb;
                     56:     my $new_file = $file.'.new';
1.2       albertel   57:     system("$dump_db -f $file|$create_db -f $new_file");
                     58: #    print("finishing $dbref\n");
1.1       albertel   59:     untie($dbref);
                     60:     system("/bin/mv $file $file.old");
                     61:     system("/bin/mv $file.new $file");
                     62:     &unlock_db($dbref);
                     63: }
                     64: 
                     65: sub main {
                     66:     find(
                     67: 	 {
                     68: 	     no_chdir   => 1,
                     69: 	     wanted     => \&process_db,
                     70: 	 }, 
1.3     ! albertel   71: 	 $perlvar{'lonUsersDir'}
1.1       albertel   72: 	 );
                     73: }
                     74: 
                     75: &main();