#!/usr/bin/perl -w # # The LearningOnline Network # # 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 $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # ################################################# use strict; use Getopt::Long; use GDBM_File; # # Options my ($help,$debug,$test,$p_is_s); GetOptions("help" => \$help, "debug" => \$debug, "test" => \$test, "p_is_s" => \$p_is_s); if (! defined($debug)) { $debug = 0; } if (! defined($test)) { $test = 0; } # # Help them out if they ask for it if ($help) { print <<'END'; rebuild_db_from_hist.pl - recreate a db file from a hist file. Options: -help Display this help. -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. -p_is_s Treat 'P' lines as 'S' lines. Examples: rebuild_db_from_hist.pl -t $file.hist # Perform a test rebuild rebuild_db_from_hist.pl $file.hist END exit; } # # Loop through ARGV getting files. while (my $fname = shift) { 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,$debug); if (! defined($error) || ! $test) { $error = &write_hash($db_filename,$constructed_hash); } if ($test) { my $error = &test_hash($db_filename,$constructed_hash); if (defined($error)) { print "Error processing ".$fname.$/; print STDERR $error; } else { print "Everything looks good for ".$fname.$/; } } if (defined($error)) { print $error.$/; } } exit; ###################################################### ###################################################### sub process_file { my ($fname,$db_filename,$debug) = @_; # open(HISTFILE,$fname); my %db_to_store; my $no_action_count = 0; while (my $command = ) { chomp($command); my $error = undef; # Each line can begin with: # P:put # D:delete 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); foreach my $k_v_pair (@data) { my ($key,$value) = split('=',$k_v_pair,2); if (defined($action) && $action eq 'P') { if (defined($value)) { $db_to_store{$key}=$value; } else { $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') { delete($db_to_store{$key}); } else { $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)) { return ('Error:'.$error.$/,undef); } } if ($no_action_count) { print $no_action_count.' lines did not require action.'.$/; } close(HISTFILE); return (undef,\%db_to_store); } sub write_hash { my ($db_filename,$db_to_store) = @_; # # Write the gdbm file my %db; if (! tie(%db,'GDBM_File',$db_filename,&GDBM_WRCREAT(),0640)) { warn "Unable to tie to $db_filename"; return "Unable to tie to $db_filename"; } # while (my ($k,$v) = each(%$db_to_store)) { $db{$k}=$v; } # untie(%db); return undef; } sub test_hash { my ($db_filename,$my_db) = @_; # my %db; if (! tie(%db,'GDBM_File',$db_filename,&GDBM_READER(),0640)) { return "Unable to tie to $db_filename";; } my (%key_errors,%value_errors); while (my ($k,$v) = each(%db)) { if (exists($my_db->{$k})) { if ($my_db->{$k} eq $v) { delete($my_db->{$k}); } else { $value_errors{$k}=$v; } } else { $key_errors{$k}=$v; } } untie(%db); # my $error; my $extra_count = scalar(keys(%$my_db)); if ($extra_count) { $error.=$extra_count.' extra key/value pairs found in hist: '.$/; while (my ($k,$v) = each(%$my_db)) { $error .= ' "'.$k.'" => "'.$v.'"'.$/; } } my $key_count = scalar(keys(%key_errors)); if ($key_count) { $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.' mismatched values found: '.$/; while (my ($k,$v) = each(%value_errors)) { $error .= ' "'.$k.'" => "'.$v.'"'.$/; } } # return $error; }