Diff for /loncom/debugging_tools/dump_db.pl between versions 1.1 and 1.8

version 1.1, 2002/08/19 14:37:14 version 1.8, 2007/07/25 17:43:34
Line 32 Line 32
 use strict;  use strict;
 use Getopt::Long;  use Getopt::Long;
 use GDBM_File;  use GDBM_File;
   use Data::Dumper;
   use Storable qw(thaw);
   use lib '/home/httpd/lib/perl/';
   use LONCAPA;
   use LONCAPA::Configuration;
   use Cwd;
   
 #  #
 # Options  # Options
 my $unesc = 0;  my ($unesc,$help,$localize_times) = (0,0,0);
 my $help = 0;  
 GetOptions("unescape" => \$unesc,  GetOptions("unescape" => \$unesc,
              "help"     => \$help);             "u"        => \$unesc,
              "t"        => \$localize_times,
              "help"     => \$help);
   
 #  #
 # Help them out if they ask for it  # Help them out if they ask for it
Line 51  database. Line 58  database.
 Options:  Options:
    --help     Display this help.     --help     Display this help.
    --unescape Unescape the keys and values before printing them out.     --unescape Unescape the keys and values before printing them out.
      -u        Same as --unescape
      -t        Localize times when possible (human readable times)
 Examples:   Examples: 
     dump_db.pl mydata.db      dump_db.pl mydata.db
     dump_db.pl mydata.db yourdata.db ourdata.db theirdata.db      dump_db.pl mydata.db yourdata.db ourdata.db theirdata.db
Line 59  END Line 68  END
     exit;      exit;
 }  }
   
   my  %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
   
 #  #
 # Loop through ARGV getting files.  # Loop through ARGV getting files.
 while (my $fname = shift) {  while (my $fname = shift) {
     my %db;      $fname = &Cwd::abs_path($fname);
     if (! tie(%db,'GDBM_File',$fname,&GDBM_READER,0640)) {      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";          warn "Unable to tie to $fname";
         next;          next;
     }      }
     while (my ($key,$value) = each(%db)) {      while (my ($key,$value) = each(%$dbref)) {
           if ($value =~ s/^__FROZEN__//) {
               $value = thaw(&unescape($value));
           }
         if ($unesc) {          if ($unesc) {
             $key = &unescape($key);              $key = &unescape($key);
             $value = &unescape($value);              $value = &unescape($value) if (! ref($value));
         }          }
         print "$key = $value\n";          if ($localize_times && ! ref($value)) {
               $value =~ s/([0-9]{10,10})/localtime($1)/ge;
           }
           print "$key = ".(ref($value)?Dumper($value):$value)."\n";
       }
       if ($fname =~ m/^\Q$perlvar{'lonUsersDir'}\E/) {
    &LONCAPA::locking_hash_untie($dbref);
       } else {
    untie($dbref);
     }      }
     untie %db;  
 }  }
 exit;  exit;
   
 ######################################  
 sub unescape {  
     my $str=shift;  
     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
     return $str;  
 }  

Removed from v.1.1  
changed lines
  Added in v.1.8


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>