[LON-CAPA-cvs] cvs: modules /raeburn dumpdb_totext.pl

[raeburn]

raeburn		Tue Jan 27 06:05:33 2009 EDT

  Added files:                 
    /modules/raeburn	dumpdb_totext.pl 
  Log:
  - Dumps GDBM .db files to text files.
  - Useful for migration between architectures which use different byte order. 
  
  

Index: modules/raeburn/dumpdb_totext.pl
+++ modules/raeburn/dumpdb_totext.pl
#!/usr/bin/perl
#
# The LearningOnline Network
#
# dumpdb_to_text.pl - dump GDBM database files (.db) to text files (.txt) 
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
#################################################
use strict;
use Getopt::Long;
use GDBM_File;
use lib '/home/httpd/lib/perl/';
use LONCAPA;
use LONCAPA::Configuration;
use Cwd;

#
# Options
my ($help,$overwrite) = (0,0);
GetOptions("help" => \$help,
           "o"    => \$overwrite);

#
# Help them out if they ask for it
if ($help) {
    print <<END;
dumpdb_to_text.pl - dump GDBM_File databases to textfiles  
- Specify fullpath to the directory to search for .db files.
- Defaults to curent working directory.
- Will create a data file "db_to_text.dat" containing full paths
  to *.db.txt files which are the dumped .db files (in text format).
- Will append to a log file "dbdumptotext.log" in the directory where 
  this script is run.
 
Options:
   --help  Display this help.
   -o      Overwrite any existing *.db.txt files when writing out to file.    

Examples: 
    dumpdb_to_text.pl /home/httpd/lonUsers/msu 
END
    exit;
}

#  Make sure this process is running from user=www
my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
    print "User ID mismatch. dumpdb_to_text.pl must be run as user www\n";
    exit;
}

my %perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
my %alldbfiles;
my $dir;
if ($ARGV[0] ne '') {
    $dir = $ARGV[0];
} else {
    $dir = &cwd();
}
&descend_tree($dir,\%alldbfiles);

open(my $fhlist,">db_to_text.dat");
open(my $log,">>dbdumptotext.log");
print $log "\n".localtime(time)." Starting dump of db files in $dir\n";
foreach my $source (sort(keys(%alldbfiles))) {
    my $dest = $source.'.txt';
    if (-e $dest && !$overwrite) {
        print "text file $dest already exists. Not overwriting\n";
        print $log "$source skipped (text file already existed)\n";
        next;
    } else {
        my $dbref;
        if ($source =~ m/^\Q$perlvar{'lonUsersDir'}\E/) {
            $dbref=&LONCAPA::locking_hash_tie($source,&GDBM_READER());
        } else {
            if (tie(my %db,'GDBM_File',$source,&GDBM_READER(),0640)) {
                $dbref = \%db;
            }
        }
        if (!$dbref) {
            warn "Unable to tie to $source";
            print $log "$source skipped (unable to tie)\n";
            next;
        }
        if (open (my $fh,">$dest")) {
            my $count = 0;
            my $ambiguous = 0;
            while (my ($key,$value) = each(%$dbref)) {
                if ($key =~ /\s+=>\s+/) {
                   $ambiguous ++;
                } else {
                    print $fh "$key => $value\n";
                    $count ++;
                }
            }
            close($fh);
            print $fhlist "$dest\n";
            print $log "$source dumped to $dest  -- $count key=>value pairs";
            if ($ambiguous) {
                print $log " ... WARNING: $ambiguous key=>value pairs skipped (matched ' => ' separator used in text file)";
            }
            print $log "\n";
        } else {
            print "Failed to open $dest - no text file written\n";
            print $log "$source skipped (unable to open text file)\n";
        }
        if ($source =~ m/^\Q$perlvar{'lonUsersDir'}\E/) {
	    &LONCAPA::locking_hash_untie($dbref);
        } else {
	    untie($dbref);
        }
    }
}
print $log localtime(time)." Ending dump of db files\n";
close($fhlist);
close($log);
exit;

sub descend_tree {
    my ($dir,$alldbfiles) = @_;
    if (-d $dir) {
        opendir(DIR,$dir);
        my @contents = grep(!/^\./,readdir(DIR));
        closedir(DIR);
        foreach my $item (@contents) {
            if (-d $dir.'/'.$item) {
                &descend_tree($dir.'/'.$item);
            } elsif ($item =~ /\.db$/) {
                $alldbfiles->{$dir.'/'.$item} = 1;
            }
        }
    }
}