Annotation of loncom/debugging_tools/rebuild_db_from_hist.pl, revision 1.3
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: #
1.3 ! matthew 7: # $Id: rebuild_db_from_hist.pl,v 1.2 2004/12/08 22:34:30 matthew Exp $
1.1 matthew 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.
1.2 matthew 53: -debug Output debugging code (not much is output yet)
54: -test Verify the given *.hist file will reconstruct the current db file
55: Sends error messages to STDERR.
1.1 matthew 56: Examples:
1.2 matthew 57: rebuild_db_from_hist.pl -t $file.hist # Perform a test rebuild
58: rebuild_db_from_hist.pl $file.hist
1.1 matthew 59: END
60: exit;
61: }
62:
63: #
64: # Loop through ARGV getting files.
65: while (my $fname = shift) {
66: my $db_filename = $fname;
67: $db_filename =~ s/\.hist$/\.db/;
68: if (-e $db_filename && ! $test) {
69: print STDERR "Aborting: The target file $db_filename exists.".$/;
70: next;
71: }
1.3 ! matthew 72: my ($error,$constructed_hash) = &process_file($fname,$db_filename,$debug);
1.1 matthew 73: if (! defined($error) || ! $test) {
74: $error = &write_hash($db_filename,$constructed_hash);
75: }
76: if ($test) {
77: my $error = &test_hash($db_filename,$constructed_hash);
78: if (defined($error)) {
79: print "Error processing ".$fname.$/;
80: print STDERR $error;
81: } else {
82: print "Everything looks good for ".$fname.$/;
83: }
84: }
85: if (defined($error)) {
86: print $error.$/;
87: }
88: }
89:
90: exit;
91:
92: ######################################################
93: ######################################################
94: sub process_file {
95: my ($fname,$db_filename,$debug) = @_;
96: #
97: open(HISTFILE,$fname);
98: my %db_to_store;
99: my $no_action_count = 0;
100: while (my $command = <HISTFILE>) {
101: chomp($command);
102: my $error = undef;
103: # Each line can begin with:
104: # P:put
105: # D:delete
106: my ($action,$time,$concatenated_data) = split(':',$command,3);
1.3 ! matthew 107: if ($fname eq 'roles.hist' && $concatenated_data =~ /^.*:.*:/) {
! 108: (undef,undef,$concatenated_data) = split(':',$concatenated_data,3);
! 109: }
1.1 matthew 110: my @data = split('&',$concatenated_data);
111: foreach my $k_v_pair (@data) {
112: my ($key,$value) = split('=',$k_v_pair,2);
113: if (defined($action) && $action eq 'P') {
114: if (defined($value)) {
115: $db_to_store{$key}=$value;
116: } else {
117: $no_action_count++;
118: }
119: } elsif ($action eq 'D') {
120: delete($db_to_store{$key});
121: } else {
122: $error = "Unable to understand action '".$action."'";
123: }
124: }
125: if (defined($error)) {
126: return ('Error:'.$error.$/,undef);
127: }
128: }
129: if ($no_action_count) {
130: print $no_action_count.' lines did not require action.'.$/;
131: }
132: close(HISTFILE);
133: return (undef,\%db_to_store);
134: }
135:
136: sub write_hash {
137: my ($db_filename,$db_to_store) = @_;
138: #
139: # Write the gdbm file
140: my %db;
141: if (! tie(%db,'GDBM_File',$db_filename,&GDBM_WRCREAT(),0640)) {
142: warn "Unable to tie to $db_filename";
143: return "Unable to tie to $db_filename";
144: }
145: #
146: while (my ($k,$v) = each(%$db_to_store)) {
147: $db{$k}=$v;
148: }
149: #
150: untie(%db);
151: return undef;
152: }
153:
154: sub test_hash {
155: my ($db_filename,$my_db) = @_;
156: #
157: my %db;
158: if (! tie(%db,'GDBM_File',$db_filename,&GDBM_READER(),0640)) {
159: return "Unable to tie to $db_filename";;
160: }
161: my (%key_errors,%value_errors);
162: while (my ($k,$v) = each(%db)) {
163: if (exists($my_db->{$k})) {
164: if ($my_db->{$k} eq $v) {
165: delete($my_db->{$k});
166: } else {
167: $value_errors{$k}=$v;
168: }
169: } else {
170: $key_errors{$k}=$v;
171: }
172: }
173: untie(%db);
174: #
175: my $error;
176: my $extra_count = scalar(keys(%$my_db));
177: if ($extra_count) {
178: $error.=$extra_count.' extra key/value pairs found: '.$/;
179: while (my ($k,$v) = each(%$my_db)) {
180: $error .= ' "'.$k.'" => "'.$v.'"'.$/;
181: }
182: }
183: my $key_count = scalar(keys(%key_errors));
184: if ($key_count) {
185: $error.=$key_count.' missing keys found: '.$/;
186: while (my ($k,$v) = each(%key_errors)) {
187: $error .= ' "'.$k.'" => "'.$v.'"'.$/;
188: }
189: }
190: my $value_count = scalar(keys(%value_errors));
191: if ($value_count) {
192: $error.=$value_count.' missing values found: '.$/;
193: while (my ($k,$v) = each(%value_errors)) {
194: $error .= ' "'.$k.'" => "'.$v.'"'.$/;
195: }
196: }
197: #
198: return $error;
199: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>