version 1.1, 2004/12/08 22:06:48
|
version 1.4, 2004/12/09 22:25:47
|
Line 35 use GDBM_File;
|
Line 35 use GDBM_File;
|
|
|
# |
# |
# 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 50 if ($help) {
|
Line 51 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. |
|
-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 68 while (my $fname = shift) {
|
Line 71 while (my $fname = shift) {
|
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) || ! $test) { |
if (! defined($error) || ! $test) { |
$error = &write_hash($db_filename,$constructed_hash); |
$error = &write_hash($db_filename,$constructed_hash); |
} |
} |
Line 103 sub process_file {
|
Line 106 sub process_file {
|
# P:put |
# P:put |
# D:delete |
# D:delete |
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 @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 127 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 '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 '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 171 sub test_hash {
|
Line 195 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.'"'.$/; |
} |
} |