version 1.2, 2004/12/08 22:34:30
|
version 1.5, 2006/08/03 17:27:48
|
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,$p_is_s); |
GetOptions("help" => \$help, |
GetOptions("help" => \$help, |
"debug" => \$debug, |
"debug" => \$debug, |
"test" => \$test); |
"test" => \$test, |
|
"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 53 Options:
|
Line 57 Options:
|
-debug Output debugging code (not much is output yet) |
-debug Output debugging code (not much is output yet) |
-test Verify the given *.hist file will reconstruct the current db file |
-test Verify the given *.hist file will reconstruct the current db file |
Sends error messages to STDERR. |
Sends error messages to STDERR. |
|
-p_is_s Treat 'P' lines as 'S' lines. |
Examples: |
Examples: |
rebuild_db_from_hist.pl -t $file.hist # Perform a test rebuild |
rebuild_db_from_hist.pl -t $file.hist # Perform a test rebuild |
rebuild_db_from_hist.pl $file.hist |
rebuild_db_from_hist.pl $file.hist |
Line 63 END
|
Line 68 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 "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) { |
if ($test) { |
|
$error = &write_hash($db_filename.'.test',$constructed_hash); |
|
} |
|
if ($test) { |
my $error = &test_hash($db_filename,$constructed_hash); |
my $error = &test_hash($db_filename,$constructed_hash); |
if (defined($error)) { |
if (defined($error)) { |
print "Error processing ".$fname.$/; |
print "Error processing ".$fname.$/; |
print STDERR $error; |
print $error; |
} else { |
} else { |
print "Everything looks good for ".$fname.$/; |
print "Everything looks good for ".$fname.$/; |
} |
} |
Line 102 sub process_file {
|
Line 118 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) |
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.$/; |
|
} |
|
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 113 sub process_file {
|
Line 144 sub process_file {
|
} else { |
} else { |
$no_action_count++; |
$no_action_count++; |
} |
} |
|
} elsif ($action eq 'S') { |
|
# 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') { |
} 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; |
|
$allkeys.='timestamp'; |
|
$db_to_store{"$version:keys:$rid"}=$allkeys; |
|
} |
if (defined($error)) { |
if (defined($error)) { |
return ('Error:'.$error.$/,undef); |
return ('Error:'.$error.$/,undef); |
} |
} |
Line 172 sub test_hash {
|
Line 223 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 194 sub test_hash {
|
Line 245 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; |
|
} |