File:
[LON-CAPA] /
loncom /
debugging_tools /
rebuild_db_from_hist.pl
Revision
1.6:
download - view:
text,
annotated -
select for diffs
Thu Aug 3 17:53:47 2006 UTC (18 years ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_99_3,
version_2_11_X,
version_2_11_5_msu,
version_2_11_5,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
version_2_11_0_RC3,
version_2_11_0_RC2,
version_2_11_0_RC1,
version_2_11_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
loncapaMITrelate_1,
language_hyphenation_merge,
language_hyphenation,
bz6209-base,
bz6209,
bz5969,
bz2851,
PRINT_INCOMPLETE_base,
PRINT_INCOMPLETE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ5971-printing-apage,
BZ5434-fox,
BZ4492-merge,
BZ4492-feature_horizontal_radioresponse,
BZ4492-feature_Support_horizontal_radioresponse,
BZ4492-Support_horizontal_radioresponse
- teaching it about the 'M' command from lond's putstore
- making the test db creation an option
#!/usr/bin/perl -w
#
# The LearningOnline Network
#
# rebuild_db_from_hist.pl Rebuild a *.db file from a *.hist file
#
# $Id: rebuild_db_from_hist.pl,v 1.6 2006/08/03 17:53:47 albertel Exp $
#
# 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 lib '/home/httpd/lib/perl';
use Getopt::Long;
use GDBM_File;
use LONCAPA;
use Apache::lonnet;
#
# Options
my ($help,$debug,$test,$test_db,$p_is_s);
GetOptions("help" => \$help,
"debug" => \$debug,
"test" => \$test,
"create_test_db" => \$test_db,
"p_is_s" => \$p_is_s);
if (! defined($debug)) { $debug = 0; }
if (! defined($test)) { $test = 0; }
#
# Help them out if they ask for it
if ($help) {
print <<'END';
rebuild_db_from_hist.pl - recreate a db file from a hist file.
Options:
-help Display this help.
-debug Output debugging code (not much is output yet)
-test Verify the given *.hist file will reconstruct the current db file
Sends error messages to STDERR.
-create_test_db
when testing also create a *.db.test db of the testing info
-p_is_s Treat 'P' lines as 'S' lines.
Examples:
rebuild_db_from_hist.pl -t $file.hist # Perform a test rebuild
rebuild_db_from_hist.pl $file.hist
END
exit;
}
#
# Loop through ARGV getting files.
while (my $fname = shift) {
if ($fname !~ m/\.hist$/) {
print("error: $fname is not a hist file");
next;
}
my $db_filename = $fname;
$db_filename =~ s/\.hist$/\.db/;
if (-e $db_filename && ! $test) {
print STDERR "Aborting: The target file $db_filename exists.".$/;
next;
}
my ($error,$constructed_hash) = &process_file($fname,$db_filename,$debug);
if (! defined($error) ) {
$error = &update_hash($db_filename,$constructed_hash);
}
if (! defined($error) || ! $test) {
$error = &write_hash($db_filename,$constructed_hash);
}
if ($test && $test_db) {
$error = &write_hash($db_filename.'.test',$constructed_hash);
}
if ($test) {
my $error = &test_hash($db_filename,$constructed_hash);
if (defined($error)) {
print "Error processing ".$fname.$/;
print STDERR $error;
} else {
print "Everything looks good for ".$fname.$/;
}
}
if (defined($error)) {
print $error.$/;
}
}
exit;
######################################################
######################################################
sub process_file {
my ($fname,$db_filename,$debug) = @_;
#
open(HISTFILE,$fname);
my %db_to_store;
my $no_action_count = 0;
while (my $command = <HISTFILE>) {
chomp($command);
my $error = undef;
# Each line can begin with:
# P:put
# S:store
# D:delete
# N:new put (only adds tha values if they are all new values)
# M:modify the values for a previous S
my ($action,$time,$concatenated_data) = split(':',$command,3);
if ($fname eq 'roles.hist' && $concatenated_data =~ /^.*:.*:/) {
(undef,undef,$concatenated_data) = split(':',$concatenated_data,3);
}
next if (! defined($action));
if ($action eq 'P' && $p_is_s) { $action = 'S'; }
my ($rid,@allkeys,$version);
if ($action eq 'S') {
($rid,$concatenated_data) = split(':',$concatenated_data,2);
$version = ++$db_to_store{"version:$rid"};
#print $version.$/;
}
if ($action eq 'M') {
($rid,$version,$concatenated_data) =
split(':',$concatenated_data,3);
}
next if (! defined($concatenated_data));
my $add_new_data = 1;
my @data = split('&',$concatenated_data);
foreach my $k_v_pair (@data) {
my ($key,$value) = split('=',$k_v_pair,2);
if (defined($action) && $action eq 'P') {
if (defined($value)) {
$db_to_store{$key}=$value;
} else {
$no_action_count++;
}
} elsif ($action eq 'S' || $action eq 'M') {
# Versioning of data, so we update the old ata
push(@allkeys,$key);
$db_to_store{"$version:$rid:$key"}=$value;
} elsif ($action eq 'N') {
if (exists($db_to_store{$key})) {
$add_new_data = 0;
print "exists $key\n";
}
} elsif ($action eq 'D') {
delete($db_to_store{$key});
} else {
$error = "Unable to understand action '".$action."'";
}
}
if ($action eq 'N' && $add_new_data) {
foreach my $k_v_pair (@data) {
my ($key,$value) = split('=',$k_v_pair,2);
$db_to_store{$key}=$value;
}
}
if ($action eq 'S') {
$db_to_store{"$version:$rid:timestamp"}=$time;
push(@allkeys,'timestamp');
}
if ($action eq 'S' || $action eq 'M') {
$db_to_store{"$version:keys:$rid"}=join(':',@allkeys);
}
if (defined($error)) {
return ('Error:'.$error.$/,undef);
}
}
if ($no_action_count) {
print $no_action_count.' lines did not require action.'.$/;
}
close(HISTFILE);
return (undef,\%db_to_store);
}
sub write_hash {
my ($db_filename,$db_to_store) = @_;
#
# Write the gdbm file
my %db;
if (! tie(%db,'GDBM_File',$db_filename,&GDBM_WRCREAT(),0640)) {
warn "Unable to tie to $db_filename";
return "Unable to tie to $db_filename";
}
#
while (my ($k,$v) = each(%$db_to_store)) {
$db{$k}=$v;
}
#
untie(%db);
return undef;
}
sub test_hash {
my ($db_filename,$my_db) = @_;
#
my %db;
if (! tie(%db,'GDBM_File',$db_filename,&GDBM_READER(),0640)) {
return "Unable to tie to $db_filename";;
}
my (%key_errors,%value_errors);
while (my ($k,$v) = each(%db)) {
if (exists($my_db->{$k})) {
if ($my_db->{$k} eq $v) {
delete($my_db->{$k});
} else {
$value_errors{$k}=$v;
}
} else {
$key_errors{$k}=$v;
}
}
untie(%db);
#
my $error;
my $extra_count = scalar(keys(%$my_db));
if ($extra_count) {
$error.=$extra_count.' extra key/value pairs found in hist: '.$/;
while (my ($k,$v) = each(%$my_db)) {
$error .= ' "'.$k.'" => "'.$v.'"'.$/;
}
}
my $key_count = scalar(keys(%key_errors));
if ($key_count) {
$error.=$key_count.' missing keys found in db but not in hist: '.$/;
while (my ($k,$v) = each(%key_errors)) {
$error .= ' "'.$k.'" => "'.$v.'"'.$/;
}
}
my $value_count = scalar(keys(%value_errors));
if ($value_count) {
$error.=$value_count.' mismatched values found: '.$/;
while (my ($k,$v) = each(%value_errors)) {
$error .= ' "'.$k.'" => "'.$v.'"'.$/;
}
}
#
return $error;
}
sub update_hash {
my ($db_filename,$my_db) = @_;
if ($db_filename=~
m/(gradingqueue|reviewqueue|slots|slot_reservations).db$/) {
&update_grading_queue($db_filename,$my_db);
}
}
sub update_grading_queue {
my ($db_filename,$my_db) = @_;
my ($name) =
($db_filename=~m/(gradingqueue|reviewqueue|slots|slot_reservations).db$/);
my $type='queue';
if ($name eq 'slots') {
$type = 'slots';
} elsif ($name eq 'slot_reservations') {
$type = 'reservation';
}
if ($type eq 'queue') {
foreach my $key (keys(%{$my_db})) {
my $real_key = &unescape($key);
my (@elements) = split("\0",$real_key);
if (exists($elements[2])) {
$elements[2] = &update_value($elements[2]);
}
$real_key = join("\0",@elements);
my $new_key = &escape($real_key);
if ($new_key ne $key) {
$my_db->{$new_key} = $my_db->{$key};
delete($my_db->{$key});
}
if ($new_key =~ /locked$/) {
my $value = $my_db->{$new_key};
my $new_value = &unescape($value);
$new_value = &update_value($new_value);
$my_db->{$new_key} = &escape($new_value);
}
}
} elsif ($type eq 'slots') {
foreach my $key (keys(%{$my_db})) {
my $value = $my_db->{$key};
$value = &Apache::lonnet::thaw_unescape($value);
if (exists($value->{'proctor'})) {
$value->{'proctor'} = &update_value($value->{'proctor'});
}
if (exists($value->{'allowedusers'})) {
$value->{'allowedusers'} =
&update_value($value->{'allowedusers'});
}
$my_db->{$key} = &Apache::lonnet::freeze_escape($value);
}
} elsif ($type eq 'reservation') {
foreach my $key (keys(%{$my_db})) {
my $value = $my_db->{$key};
$value = &Apache::lonnet::thaw_unescape($value);
if (exists($value->{'name'})) {
$value->{'name'} = &update_value($value->{'name'});
}
$my_db->{$key} = &Apache::lonnet::freeze_escape($value);
}
}
}
sub update_value {
my ($value) = @_;
if ($value =~ /@/ && $value !~ /:/) {
$value =~ tr/@/:/;
}
return $value;
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>