Return to db_copy.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

- add in default refs to correct programs
- addin some helpful error messages

    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 = '/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: }
   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);
   54:     print("attempting $file\n");
   55:     my %newdb;
   56:     my $new_file = $file.'.new';
   57:     system("$dump_db -f $file|$create_db -f $new_file");
   58: #    print("finishing $dbref\n");
   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: 	 }, 
   71: 	 $perlvar{'lonUsersDir'}
   72: 	 );
   73: }
   74: 
   75: &main();