Annotation of loncom/debugging_tools/rebuild_db_from_hist.pl, revision 1.4
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.4 ! matthew 7: # $Id: rebuild_db_from_hist.pl,v 1.3 2004/12/09 20:01:48 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
1.4 ! matthew 38: my ($help,$debug,$test,$p_is_s);
1.1 matthew 39: GetOptions("help" => \$help,
40: "debug" => \$debug,
1.4 ! matthew 41: "test" => \$test,
! 42: "p_is_s" => \$p_is_s);
1.1 matthew 43:
44: if (! defined($debug)) { $debug = 0; }
45: if (! defined($test)) { $test = 0; }
46:
47: #
48: # Help them out if they ask for it
49: if ($help) {
50: print <<'END';
51: rebuild_db_from_hist.pl - recreate a db file from a hist file.
52: Options:
53: -help Display this help.
1.2 matthew 54: -debug Output debugging code (not much is output yet)
55: -test Verify the given *.hist file will reconstruct the current db file
56: Sends error messages to STDERR.
1.4 ! matthew 57: -p_is_s Treat 'P' lines as 'S' lines.
1.1 matthew 58: Examples:
1.2 matthew 59: rebuild_db_from_hist.pl -t $file.hist # Perform a test rebuild
60: rebuild_db_from_hist.pl $file.hist
1.1 matthew 61: END
62: exit;
63: }
64:
65: #
66: # Loop through ARGV getting files.
67: while (my $fname = shift) {
68: my $db_filename = $fname;
69: $db_filename =~ s/\.hist$/\.db/;
70: if (-e $db_filename && ! $test) {
71: print STDERR "Aborting: The target file $db_filename exists.".$/;
72: next;
73: }
1.3 matthew 74: my ($error,$constructed_hash) = &process_file($fname,$db_filename,$debug);
1.1 matthew 75: if (! defined($error) || ! $test) {
76: $error = &write_hash($db_filename,$constructed_hash);
77: }
78: if ($test) {
79: my $error = &test_hash($db_filename,$constructed_hash);
80: if (defined($error)) {
81: print "Error processing ".$fname.$/;
82: print STDERR $error;
83: } else {
84: print "Everything looks good for ".$fname.$/;
85: }
86: }
87: if (defined($error)) {
88: print $error.$/;
89: }
90: }
91:
92: exit;
93:
94: ######################################################
95: ######################################################
96: sub process_file {
97: my ($fname,$db_filename,$debug) = @_;
98: #
99: open(HISTFILE,$fname);
100: my %db_to_store;
101: my $no_action_count = 0;
102: while (my $command = <HISTFILE>) {
103: chomp($command);
104: my $error = undef;
105: # Each line can begin with:
106: # P:put
107: # D:delete
108: my ($action,$time,$concatenated_data) = split(':',$command,3);
1.3 matthew 109: if ($fname eq 'roles.hist' && $concatenated_data =~ /^.*:.*:/) {
110: (undef,undef,$concatenated_data) = split(':',$concatenated_data,3);
111: }
1.4 ! matthew 112: next if (! defined($action));
! 113: if ($action eq 'P' && $p_is_s) { $action = 'S'; }
! 114: my ($rid,$allkeys,$version);
! 115: if ($action eq 'S') {
! 116: ($rid,$concatenated_data) = split(':',$concatenated_data,2);
! 117: $version = ++$db_to_store{"version:$rid"};
! 118: # print $version.$/;
! 119: }
! 120: next if (! defined($concatenated_data));
1.1 matthew 121: my @data = split('&',$concatenated_data);
122: foreach my $k_v_pair (@data) {
123: my ($key,$value) = split('=',$k_v_pair,2);
124: if (defined($action) && $action eq 'P') {
125: if (defined($value)) {
126: $db_to_store{$key}=$value;
127: } else {
128: $no_action_count++;
129: }
1.4 ! matthew 130: } elsif ($action eq 'S') {
! 131: # Versioning of data, so we update the old ata
! 132: $allkeys.=$key.':';
! 133: $db_to_store{"$version:$rid:$key"}=$value;
1.1 matthew 134: } elsif ($action eq 'D') {
135: delete($db_to_store{$key});
136: } else {
137: $error = "Unable to understand action '".$action."'";
138: }
139: }
1.4 ! matthew 140: if ($action eq 'S') {
! 141: $db_to_store{"$version:$rid:timestamp"}=$time;
! 142: $allkeys.='timestamp';
! 143: $db_to_store{"$version:keys:$rid"}=$allkeys;
! 144: }
1.1 matthew 145: if (defined($error)) {
146: return ('Error:'.$error.$/,undef);
147: }
148: }
149: if ($no_action_count) {
150: print $no_action_count.' lines did not require action.'.$/;
151: }
152: close(HISTFILE);
153: return (undef,\%db_to_store);
154: }
155:
156: sub write_hash {
157: my ($db_filename,$db_to_store) = @_;
158: #
159: # Write the gdbm file
160: my %db;
161: if (! tie(%db,'GDBM_File',$db_filename,&GDBM_WRCREAT(),0640)) {
162: warn "Unable to tie to $db_filename";
163: return "Unable to tie to $db_filename";
164: }
165: #
166: while (my ($k,$v) = each(%$db_to_store)) {
167: $db{$k}=$v;
168: }
169: #
170: untie(%db);
171: return undef;
172: }
173:
174: sub test_hash {
175: my ($db_filename,$my_db) = @_;
176: #
177: my %db;
178: if (! tie(%db,'GDBM_File',$db_filename,&GDBM_READER(),0640)) {
179: return "Unable to tie to $db_filename";;
180: }
181: my (%key_errors,%value_errors);
182: while (my ($k,$v) = each(%db)) {
183: if (exists($my_db->{$k})) {
184: if ($my_db->{$k} eq $v) {
185: delete($my_db->{$k});
186: } else {
187: $value_errors{$k}=$v;
188: }
189: } else {
190: $key_errors{$k}=$v;
191: }
192: }
193: untie(%db);
194: #
195: my $error;
196: my $extra_count = scalar(keys(%$my_db));
197: if ($extra_count) {
1.4 ! matthew 198: $error.=$extra_count.' extra key/value pairs found in hist: '.$/;
1.1 matthew 199: while (my ($k,$v) = each(%$my_db)) {
200: $error .= ' "'.$k.'" => "'.$v.'"'.$/;
201: }
202: }
203: my $key_count = scalar(keys(%key_errors));
204: if ($key_count) {
1.4 ! matthew 205: $error.=$key_count.' missing keys found in db but not in hist: '.$/;
1.1 matthew 206: while (my ($k,$v) = each(%key_errors)) {
207: $error .= ' "'.$k.'" => "'.$v.'"'.$/;
208: }
209: }
210: my $value_count = scalar(keys(%value_errors));
211: if ($value_count) {
1.4 ! matthew 212: $error.=$value_count.' mismatched values found: '.$/;
1.1 matthew 213: while (my ($k,$v) = each(%value_errors)) {
214: $error .= ' "'.$k.'" => "'.$v.'"'.$/;
215: }
216: }
217: #
218: return $error;
219: }
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