version 1.1, 2004/12/08 22:06:48
|
version 1.6, 2006/08/03 17:53:47
|
Line 30
|
Line 30
|
# |
# |
################################################# |
################################################# |
use strict; |
use strict; |
|
use lib '/home/httpd/lib/perl'; |
use Getopt::Long; |
use Getopt::Long; |
use GDBM_File; |
use GDBM_File; |
|
use LONCAPA; |
|
use Apache::lonnet; |
|
|
# |
# |
# Options |
# Options |
my ($help,$debug,$test); |
my ($help,$debug,$test,$test_db,$p_is_s); |
GetOptions("help" => \$help, |
GetOptions("help" => \$help, |
"debug" => \$debug, |
"debug" => \$debug, |
"test" => \$test); |
"test" => \$test, |
|
"create_test_db" => \$test_db, |
|
"p_is_s" => \$p_is_s); |
|
|
if (! defined($debug)) { $debug = 0; } |
if (! defined($debug)) { $debug = 0; } |
if (! defined($test)) { $test = 0; } |
if (! defined($test)) { $test = 0; } |
Line 50 if ($help) {
|
Line 55 if ($help) {
|
rebuild_db_from_hist.pl - recreate a db file from a hist file. |
rebuild_db_from_hist.pl - recreate a db file from a hist file. |
Options: |
Options: |
-help Display this help. |
-help Display this help. |
-debug Output debugging code |
-debug Output debugging code (not much is output yet) |
-sort Sort the entries by time |
-test Verify the given *.hist file will reconstruct the current db file |
-test Do not write the data but verify it was created properly |
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: |
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 |
END |
exit; |
exit; |
} |
} |
Line 62 END
|
Line 71 END
|
# |
# |
# Loop through ARGV getting files. |
# Loop through ARGV getting files. |
while (my $fname = shift) { |
while (my $fname = shift) { |
|
if ($fname !~ m/\.hist$/) { |
|
print("error: $fname is not a hist file"); |
|
next; |
|
} |
|
|
my $db_filename = $fname; |
my $db_filename = $fname; |
$db_filename =~ s/\.hist$/\.db/; |
$db_filename =~ s/\.hist$/\.db/; |
if (-e $db_filename && ! $test) { |
if (-e $db_filename && ! $test) { |
print STDERR "Aborting: The target file $db_filename exists.".$/; |
print STDERR "Aborting: The target file $db_filename exists.".$/; |
next; |
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) { |
if (! defined($error) || ! $test) { |
$error = &write_hash($db_filename,$constructed_hash); |
$error = &write_hash($db_filename,$constructed_hash); |
} |
} |
|
if ($test && $test_db) { |
|
$error = &write_hash($db_filename.'.test',$constructed_hash); |
|
} |
if ($test) { |
if ($test) { |
my $error = &test_hash($db_filename,$constructed_hash); |
my $error = &test_hash($db_filename,$constructed_hash); |
if (defined($error)) { |
if (defined($error)) { |
Line 101 sub process_file {
|
Line 121 sub process_file {
|
my $error = undef; |
my $error = undef; |
# Each line can begin with: |
# Each line can begin with: |
# P:put |
# P:put |
|
# S:store |
# D:delete |
# 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); |
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); |
my @data = split('&',$concatenated_data); |
foreach my $k_v_pair (@data) { |
foreach my $k_v_pair (@data) { |
my ($key,$value) = split('=',$k_v_pair,2); |
my ($key,$value) = split('=',$k_v_pair,2); |
Line 112 sub process_file {
|
Line 152 sub process_file {
|
} else { |
} else { |
$no_action_count++; |
$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') { |
} elsif ($action eq 'D') { |
delete($db_to_store{$key}); |
delete($db_to_store{$key}); |
} else { |
} else { |
$error = "Unable to understand action '".$action."'"; |
$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)) { |
if (defined($error)) { |
return ('Error:'.$error.$/,undef); |
return ('Error:'.$error.$/,undef); |
} |
} |
Line 171 sub test_hash {
|
Line 234 sub test_hash {
|
my $error; |
my $error; |
my $extra_count = scalar(keys(%$my_db)); |
my $extra_count = scalar(keys(%$my_db)); |
if ($extra_count) { |
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)) { |
while (my ($k,$v) = each(%$my_db)) { |
$error .= ' "'.$k.'" => "'.$v.'"'.$/; |
$error .= ' "'.$k.'" => "'.$v.'"'.$/; |
} |
} |
} |
} |
my $key_count = scalar(keys(%key_errors)); |
my $key_count = scalar(keys(%key_errors)); |
if ($key_count) { |
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)) { |
while (my ($k,$v) = each(%key_errors)) { |
$error .= ' "'.$k.'" => "'.$v.'"'.$/; |
$error .= ' "'.$k.'" => "'.$v.'"'.$/; |
} |
} |
} |
} |
my $value_count = scalar(keys(%value_errors)); |
my $value_count = scalar(keys(%value_errors)); |
if ($value_count) { |
if ($value_count) { |
$error.=$value_count.' missing values found: '.$/; |
$error.=$value_count.' mismatched values found: '.$/; |
while (my ($k,$v) = each(%value_errors)) { |
while (my ($k,$v) = each(%value_errors)) { |
$error .= ' "'.$k.'" => "'.$v.'"'.$/; |
$error .= ' "'.$k.'" => "'.$v.'"'.$/; |
} |
} |
Line 193 sub test_hash {
|
Line 256 sub test_hash {
|
# |
# |
return $error; |
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; |
|
} |