Return to db_copy.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

- use full c solution

    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';
   14: my $create_db = './create_db';
   15: my $dir = './annarbor';
   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);
   51:     print("attempting $file\n");
   52:     my %newdb;
   53:     my $new_file = $file.'.new';
   54:     system("$dump_db -f $file|$create_db -f $new_file");
   55: #    print("finishing $dbref\n");
   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();