[LON-CAPA-cvs] cvs: loncom /debugging_tools dump_db.pl
albertel
lon-capa-cvs@mail.lon-capa.org
Tue, 08 Aug 2006 18:20:50 -0000
albertel Tue Aug 8 14:20:50 2006 EDT
Modified files:
/loncom/debugging_tools dump_db.pl
Log:
- dump_db.pl needs to lock /home/httpd/lonUsers dbs differently then other dbs
Index: loncom/debugging_tools/dump_db.pl
diff -u loncom/debugging_tools/dump_db.pl:1.6 loncom/debugging_tools/dump_db.pl:1.7
--- loncom/debugging_tools/dump_db.pl:1.6 Mon Jun 19 05:36:22 2006
+++ loncom/debugging_tools/dump_db.pl Tue Aug 8 14:20:50 2006
@@ -4,7 +4,7 @@
#
# dump_db.pl - dump a GDBM database to standard output, unescaping if asked to.
#
-# $Id: dump_db.pl,v 1.6 2006/06/19 09:36:22 www Exp $
+# $Id: dump_db.pl,v 1.7 2006/08/08 18:20:50 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -36,6 +36,8 @@
use Storable qw(thaw);
use lib '/home/httpd/lib/perl/';
use LONCAPA;
+use LONCAPA::Configuration;
+use Cwd;
#
# Options
@@ -66,10 +68,20 @@
exit;
}
+my %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
+
#
# Loop through ARGV getting files.
while (my $fname = shift) {
- my $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
+ $fname = &Cwd::abs_path($fname);
+ my $dbref;
+ if ($fname =~ m/^\Q$perlvar{'lonUsersDir'}\E/) {
+ $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
+ } else {
+ if (tie(my %db,'GDBM_File',$fname,&GDBM_READER(),0640)) {
+ $dbref = \%db;
+ }
+ }
if (!$dbref) {
warn "Unable to tie to $fname";
@@ -77,7 +89,7 @@
}
while (my ($key,$value) = each(%$dbref)) {
if ($value =~ s/^__FROZEN__//) {
- $value = thaw(&unescape($value));
+ #$value = thaw(&unescape($value));
}
if ($unesc) {
$key = &unescape($key);