--- loncom/debugging_tools/dump_db.pl	2003/09/04 14:32:46	1.3
+++ loncom/debugging_tools/dump_db.pl	2006/08/08 18:20:50	1.7
@@ -4,7 +4,7 @@
 #
 # dump_db.pl - dump a GDBM database to standard output, unescaping if asked to.
 #
-# $Id: dump_db.pl,v 1.3 2003/09/04 14:32:46 matthew Exp $
+# $Id: dump_db.pl,v 1.7 2006/08/08 18:20:50 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -32,6 +32,12 @@
 use strict;
 use Getopt::Long;
 use GDBM_File;
+use Data::Dumper;
+use Storable qw(thaw);
+use lib '/home/httpd/lib/perl/';
+use LONCAPA;
+use LONCAPA::Configuration;
+use Cwd;
 
 #
 # Options
@@ -62,33 +68,39 @@ END
     exit;
 }
 
+my  %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
+
 #
 # Loop through ARGV getting files.
 while (my $fname = shift) {
-    my %db;
-    if (! tie(%db,'GDBM_File',$fname,&GDBM_READER,0640)) {
+    $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";
         next;
     }
-    while (my ($key,$value) = each(%db)) {
+    while (my ($key,$value) = each(%$dbref)) {
+        if ($value =~ s/^__FROZEN__//) {
+            #$value = thaw(&unescape($value));
+        }
         if ($unesc) {
             $key = &unescape($key);
-            $value = &unescape($value);
+            $value = &unescape($value) if (! ref($value));
         }
-        if ($localize_times) {
-            if ($value =~ /^\s*([0-9]{10,10})\s*$/) {
-                $value = $value.' [ '.localtime($1).' ]';
-            }
+        if ($localize_times && ! ref($value)) {
+            $value =~ s/([0-9]{10,10})/localtime($1)/ge;
         }
-        print "$key = $value\n";
+        print "$key = ".(ref($value)?Dumper($value):$value)."\n";
     }
-    untie %db;
+    &LONCAPA::locking_hash_untie($dbref);
 }
 exit;
 
-######################################
-sub unescape {
-    my $str=shift;
-    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
-    return $str;
-}