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 $dir = './test';
15:
16: my %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
17:
18: {
19: my $straight;
20: sub lock_db {
21: my ($fname) = @_;
22: my $dbref;
23: $fname = &Cwd::abs_path($fname);
24: if ($fname =~ m/^\Q$perlvar{'lonUsersDir'}\E/) {
25: $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
26: $straight=0;
27: } else {
28: if (tie(my %db,'GDBM_File',$fname,&GDBM_READER(),0640)) {
29: $dbref = \%db;
30: }
31: $straight=1;
32: }
33: return $dbref;
34: }
35:
36: sub unlock_db {
37: my ($dbref) = @_;
38: if ($straight) {
39: untie($dbref);
40: } else {
41: &LONCAPA::locking_hash_untie($dbref);
42: }
43: }
44: }
45:
46: sub process_db {
47: return if ($_!~m/\.db$/);
48: my $file = $_;
49: my $dbref =&lock_db($file);
50: print("attempting $dbref\n");
51: my %newdb;
52: my $new_file = $file.'.new';
53: if (!tie(%newdb,'GDBM_File',$new_file,&GDBM_WRCREAT(),0640)) {
54: die("unable to create new db $new_file $! $@");
55: }
56: open(my $fh,"$dump_db -f $file|");
57: while (my $entry = <$fh>) {
58: chomp($entry);
59: if ($entry =~/^ERROR:/) {
60: die($entry);
61: }
62: my ($key,$value) = split(' -> ',$entry,2);
63: $newdb{&unescape($key)} = &unescape($value);
64: }
65: print("finishing $dbref\n");
66: untie(%newdb);
67: untie($dbref);
68: system("/bin/mv $file $file.old");
69: system("/bin/mv $file.new $file");
70: &unlock_db($dbref);
71: }
72:
73: sub main {
74: find(
75: {
76: no_chdir => 1,
77: wanted => \&process_db,
78: },
79: $dir
80: #$perlvar->{'lonUsersDir'}
81: );
82: }
83:
84: &main();
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>