Return to db_copy.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

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

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