--- loncom/debugging_tools/rebuild_db_from_hist.pl	2004/12/08 22:06:48	1.1
+++ loncom/debugging_tools/rebuild_db_from_hist.pl	2006/08/03 17:53:47	1.6
@@ -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.1 2004/12/08 22:06:48 matthew Exp $
+# $Id: rebuild_db_from_hist.pl,v 1.6 2006/08/03 17:53:47 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -30,15 +30,20 @@
 #
 #################################################
 use strict;
+use lib '/home/httpd/lib/perl';
 use Getopt::Long;
 use GDBM_File;
+use LONCAPA;
+use Apache::lonnet;
 
 #
 # Options
-my ($help,$debug,$test);
-GetOptions("help"    => \$help,
-           "debug"   => \$debug,
-           "test"    => \$test);
+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; }
@@ -50,11 +55,15 @@ if ($help) {
 rebuild_db_from_hist.pl - recreate a db file from a hist file.
 Options:
    -help     Display this help.
-   -debug    Output debugging code
-   -sort     Sort the entries by time
-   -test     Do not write the data but verify it was created properly
+   -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 $file.hist 
+    rebuild_db_from_hist.pl -t $file.hist  # Perform a test rebuild
+    rebuild_db_from_hist.pl $file.hist       
 END
     exit;
 }
@@ -62,16 +71,27 @@ END
 #
 # 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);
+    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)) {
@@ -101,8 +121,28 @@ sub process_file {
         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);
@@ -112,12 +152,35 @@ sub process_file {
                 } 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);
         }
@@ -171,21 +234,21 @@ sub test_hash {
     my $error;
     my $extra_count = scalar(keys(%$my_db));
     if ($extra_count) {
-        $error.=$extra_count.' extra key/value pairs found: '.$/;
+        $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));
     if ($key_count) {
-        $error.=$key_count.' missing keys found: '.$/;
+        $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.' missing values found: '.$/;
+        $error.=$value_count.' mismatched values found: '.$/;
         while (my ($k,$v) = each(%value_errors)) {
             $error .= '  "'.$k.'" => "'.$v.'"'.$/;
         }
@@ -193,3 +256,74 @@ sub test_hash {
     #
     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;
+}