Annotation of loncom/debugging_tools/rebuild_db_from_hist.pl, revision 1.1
1.1 ! matthew 1: #!/usr/bin/perl -w
! 2: #
! 3: # The LearningOnline Network
! 4: #
! 5: # rebuild_db_from_hist.pl Rebuild a *.db file from a *.hist file
! 6: #
! 7: # $Id: dump_db.pl,v 1.3 2003/09/04 14:32:46 matthew Exp $
! 8: #
! 9: # Copyright Michigan State University Board of Trustees
! 10: #
! 11: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
! 12: #
! 13: # LON-CAPA is free software; you can redistribute it and/or modify
! 14: # it under the terms of the GNU General Public License as published by
! 15: # the Free Software Foundation; either version 2 of the License, or
! 16: # (at your option) any later version.
! 17: #
! 18: # LON-CAPA is distributed in the hope that it will be useful,
! 19: # but WITHOUT ANY WARRANTY; without even the implied warranty of
! 20: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 21: # GNU General Public License for more details.
! 22: #
! 23: # You should have received a copy of the GNU General Public License
! 24: # along with LON-CAPA; if not, write to the Free Software
! 25: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! 26: #
! 27: # /home/httpd/html/adm/gpl.txt
! 28: #
! 29: # http://www.lon-capa.org/
! 30: #
! 31: #################################################
! 32: use strict;
! 33: use Getopt::Long;
! 34: use GDBM_File;
! 35:
! 36: #
! 37: # Options
! 38: my ($help,$debug,$test);
! 39: GetOptions("help" => \$help,
! 40: "debug" => \$debug,
! 41: "test" => \$test);
! 42:
! 43: if (! defined($debug)) { $debug = 0; }
! 44: if (! defined($test)) { $test = 0; }
! 45:
! 46: #
! 47: # Help them out if they ask for it
! 48: if ($help) {
! 49: print <<'END';
! 50: rebuild_db_from_hist.pl - recreate a db file from a hist file.
! 51: Options:
! 52: -help Display this help.
! 53: -debug Output debugging code
! 54: -sort Sort the entries by time
! 55: -test Do not write the data but verify it was created properly
! 56: Examples:
! 57: rebuild_db_from_hist.pl $file.hist
! 58: END
! 59: exit;
! 60: }
! 61:
! 62: #
! 63: # Loop through ARGV getting files.
! 64: while (my $fname = shift) {
! 65: my $db_filename = $fname;
! 66: $db_filename =~ s/\.hist$/\.db/;
! 67: if (-e $db_filename && ! $test) {
! 68: print STDERR "Aborting: The target file $db_filename exists.".$/;
! 69: next;
! 70: }
! 71: my ($error,$constructed_hash) = &process_file($fname,$db_filename);
! 72: if (! defined($error) || ! $test) {
! 73: $error = &write_hash($db_filename,$constructed_hash);
! 74: }
! 75: if ($test) {
! 76: my $error = &test_hash($db_filename,$constructed_hash);
! 77: if (defined($error)) {
! 78: print "Error processing ".$fname.$/;
! 79: print STDERR $error;
! 80: } else {
! 81: print "Everything looks good for ".$fname.$/;
! 82: }
! 83: }
! 84: if (defined($error)) {
! 85: print $error.$/;
! 86: }
! 87: }
! 88:
! 89: exit;
! 90:
! 91: ######################################################
! 92: ######################################################
! 93: sub process_file {
! 94: my ($fname,$db_filename,$debug) = @_;
! 95: #
! 96: open(HISTFILE,$fname);
! 97: my %db_to_store;
! 98: my $no_action_count = 0;
! 99: while (my $command = <HISTFILE>) {
! 100: chomp($command);
! 101: my $error = undef;
! 102: # Each line can begin with:
! 103: # P:put
! 104: # D:delete
! 105: my ($action,$time,$concatenated_data) = split(':',$command,3);
! 106: my @data = split('&',$concatenated_data);
! 107: foreach my $k_v_pair (@data) {
! 108: my ($key,$value) = split('=',$k_v_pair,2);
! 109: if (defined($action) && $action eq 'P') {
! 110: if (defined($value)) {
! 111: $db_to_store{$key}=$value;
! 112: } else {
! 113: $no_action_count++;
! 114: }
! 115: } elsif ($action eq 'D') {
! 116: delete($db_to_store{$key});
! 117: } else {
! 118: $error = "Unable to understand action '".$action."'";
! 119: }
! 120: }
! 121: if (defined($error)) {
! 122: return ('Error:'.$error.$/,undef);
! 123: }
! 124: }
! 125: if ($no_action_count) {
! 126: print $no_action_count.' lines did not require action.'.$/;
! 127: }
! 128: close(HISTFILE);
! 129: return (undef,\%db_to_store);
! 130: }
! 131:
! 132: sub write_hash {
! 133: my ($db_filename,$db_to_store) = @_;
! 134: #
! 135: # Write the gdbm file
! 136: my %db;
! 137: if (! tie(%db,'GDBM_File',$db_filename,&GDBM_WRCREAT(),0640)) {
! 138: warn "Unable to tie to $db_filename";
! 139: return "Unable to tie to $db_filename";
! 140: }
! 141: #
! 142: while (my ($k,$v) = each(%$db_to_store)) {
! 143: $db{$k}=$v;
! 144: }
! 145: #
! 146: untie(%db);
! 147: return undef;
! 148: }
! 149:
! 150: sub test_hash {
! 151: my ($db_filename,$my_db) = @_;
! 152: #
! 153: my %db;
! 154: if (! tie(%db,'GDBM_File',$db_filename,&GDBM_READER(),0640)) {
! 155: return "Unable to tie to $db_filename";;
! 156: }
! 157: my (%key_errors,%value_errors);
! 158: while (my ($k,$v) = each(%db)) {
! 159: if (exists($my_db->{$k})) {
! 160: if ($my_db->{$k} eq $v) {
! 161: delete($my_db->{$k});
! 162: } else {
! 163: $value_errors{$k}=$v;
! 164: }
! 165: } else {
! 166: $key_errors{$k}=$v;
! 167: }
! 168: }
! 169: untie(%db);
! 170: #
! 171: my $error;
! 172: my $extra_count = scalar(keys(%$my_db));
! 173: if ($extra_count) {
! 174: $error.=$extra_count.' extra key/value pairs found: '.$/;
! 175: while (my ($k,$v) = each(%$my_db)) {
! 176: $error .= ' "'.$k.'" => "'.$v.'"'.$/;
! 177: }
! 178: }
! 179: my $key_count = scalar(keys(%key_errors));
! 180: if ($key_count) {
! 181: $error.=$key_count.' missing keys found: '.$/;
! 182: while (my ($k,$v) = each(%key_errors)) {
! 183: $error .= ' "'.$k.'" => "'.$v.'"'.$/;
! 184: }
! 185: }
! 186: my $value_count = scalar(keys(%value_errors));
! 187: if ($value_count) {
! 188: $error.=$value_count.' missing values found: '.$/;
! 189: while (my ($k,$v) = each(%value_errors)) {
! 190: $error .= ' "'.$k.'" => "'.$v.'"'.$/;
! 191: }
! 192: }
! 193: #
! 194: return $error;
! 195: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to rebuild_db_from_hist.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / debugging_tools