[LON-CAPA-cvs] cvs: loncom /debugging_tools rebuild_db_from_hist.pl
albertel
lon-capa-cvs@mail.lon-capa.org
Thu, 03 Aug 2006 17:27:48 -0000
albertel Thu Aug 3 13:27:48 2006 EDT
Modified files:
/loncom/debugging_tools rebuild_db_from_hist.pl
Log:
- added understanding of 'n' hist file commands
- can successfully rebuild even pre 2.2 gradingqueue/slots files
Index: loncom/debugging_tools/rebuild_db_from_hist.pl
diff -u loncom/debugging_tools/rebuild_db_from_hist.pl:1.4 loncom/debugging_tools/rebuild_db_from_hist.pl:1.5
--- loncom/debugging_tools/rebuild_db_from_hist.pl:1.4 Thu Dec 9 17:25:47 2004
+++ loncom/debugging_tools/rebuild_db_from_hist.pl Thu Aug 3 13:27:48 2006
@@ -4,7 +4,7 @@
#
# rebuild_db_from_hist.pl Rebuild a *.db file from a *.hist file
#
-# $Id: rebuild_db_from_hist.pl,v 1.4 2004/12/09 22:25:47 matthew Exp $
+# $Id: rebuild_db_from_hist.pl,v 1.5 2006/08/03 17:27:48 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -30,8 +30,11 @@
#
#################################################
use strict;
+use lib '/home/httpd/lib/perl';
use Getopt::Long;
use GDBM_File;
+use LONCAPA;
+use Apache::lonnet;
#
# Options
@@ -65,21 +68,32 @@
#
# 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.".$/;
+ print "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) {
+ $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;
+ print $error;
} else {
print "Everything looks good for ".$fname.$/;
}
@@ -104,7 +118,9 @@
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)
my ($action,$time,$concatenated_data) = split(':',$command,3);
if ($fname eq 'roles.hist' && $concatenated_data =~ /^.*:.*:/) {
(undef,undef,$concatenated_data) = split(':',$concatenated_data,3);
@@ -115,9 +131,10 @@
if ($action eq 'S') {
($rid,$concatenated_data) = split(':',$concatenated_data,2);
$version = ++$db_to_store{"version:$rid"};
- # print $version.$/;
+ #print $version.$/;
}
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);
@@ -131,12 +148,23 @@
# Versioning of data, so we update the old ata
$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;
$allkeys.='timestamp';
@@ -197,7 +225,7 @@
if ($extra_count) {
$error.=$extra_count.' extra key/value pairs found in hist: '.$/;
while (my ($k,$v) = each(%$my_db)) {
- $error .= ' "'.$k.'" => "'.$v.'"'.$/;
+ $error .= ' "'.$k.'" => "'.$v.'"'.$/;
}
}
my $key_count = scalar(keys(%key_errors));
@@ -217,3 +245,74 @@
#
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;
+}