Return to rebuild_db_from_hist.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

Annotation of loncom/debugging_tools/rebuild_db_from_hist.pl, revision 1.3

1.1       matthew     1: #!/usr/bin/perl -w
                      2: #
                      3: # The LearningOnline Network
                      4: #
                      5: # rebuild_db_from_hist.pl Rebuild a *.db file from a *.hist file
                      6: #
1.3     ! matthew     7: # $Id: rebuild_db_from_hist.pl,v 1.2 2004/12/08 22:34:30 matthew Exp $
1.1       matthew     8: #
                      9: # Copyright Michigan State University Board of Trustees
                     10: #
                     11: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                     12: #
                     13: # LON-CAPA is free software; you can redistribute it and/or modify
                     14: # it under the terms of the GNU General Public License as published by
                     15: # the Free Software Foundation; either version 2 of the License, or
                     16: # (at your option) any later version.
                     17: #
                     18: # LON-CAPA is distributed in the hope that it will be useful,
                     19: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     20: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     21: # GNU General Public License for more details.
                     22: #
                     23: # You should have received a copy of the GNU General Public License
                     24: # along with LON-CAPA; if not, write to the Free Software
                     25: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     26: #
                     27: # /home/httpd/html/adm/gpl.txt
                     28: #
                     29: # http://www.lon-capa.org/
                     30: #
                     31: #################################################
                     32: use strict;
                     33: use Getopt::Long;
                     34: use GDBM_File;
                     35: 
                     36: #
                     37: # Options
                     38: my ($help,$debug,$test);
                     39: GetOptions("help"    => \$help,
                     40:            "debug"   => \$debug,
                     41:            "test"    => \$test);
                     42: 
                     43: if (! defined($debug))   { $debug   = 0; }
                     44: if (! defined($test))    { $test    = 0; }
                     45: 
                     46: #
                     47: # Help them out if they ask for it
                     48: if ($help) {
                     49:     print <<'END';
                     50: rebuild_db_from_hist.pl - recreate a db file from a hist file.
                     51: Options:
                     52:    -help     Display this help.
1.2       matthew    53:    -debug    Output debugging code (not much is output yet)
                     54:    -test     Verify the given *.hist file will reconstruct the current db file
                     55:              Sends error messages to STDERR.
1.1       matthew    56: Examples: 
1.2       matthew    57:     rebuild_db_from_hist.pl -t $file.hist  # Perform a test rebuild
                     58:     rebuild_db_from_hist.pl $file.hist       
1.1       matthew    59: END
                     60:     exit;
                     61: }
                     62: 
                     63: #
                     64: # Loop through ARGV getting files.
                     65: while (my $fname = shift) {
                     66:     my $db_filename = $fname;
                     67:     $db_filename =~ s/\.hist$/\.db/;
                     68:     if (-e $db_filename && ! $test) {
                     69:         print STDERR "Aborting: The target file $db_filename exists.".$/;
                     70:         next;
                     71:     }
1.3     ! matthew    72:     my ($error,$constructed_hash) = &process_file($fname,$db_filename,$debug);
1.1       matthew    73:     if (! defined($error) || ! $test) {
                     74:         $error = &write_hash($db_filename,$constructed_hash);
                     75:     }
                     76:     if ($test) {
                     77:         my $error = &test_hash($db_filename,$constructed_hash);
                     78:         if (defined($error)) {
                     79:             print "Error processing ".$fname.$/;
                     80:             print STDERR $error;
                     81:         } else {
                     82:             print "Everything looks good for ".$fname.$/;
                     83:         }
                     84:     }
                     85:     if (defined($error)) {
                     86:         print $error.$/;
                     87:     }
                     88: }
                     89: 
                     90: exit;
                     91: 
                     92: ######################################################
                     93: ######################################################
                     94: sub process_file {
                     95:     my ($fname,$db_filename,$debug) = @_;
                     96:     #
                     97:     open(HISTFILE,$fname);
                     98:     my %db_to_store;
                     99:     my $no_action_count = 0;
                    100:     while (my $command = <HISTFILE>) {
                    101:         chomp($command);
                    102:         my $error = undef;
                    103:         # Each line can begin with:
                    104:         #  P:put
                    105:         #  D:delete
                    106:         my ($action,$time,$concatenated_data) = split(':',$command,3);
1.3     ! matthew   107:         if ($fname eq 'roles.hist' && $concatenated_data =~ /^.*:.*:/) {
        !           108:             (undef,undef,$concatenated_data) = split(':',$concatenated_data,3);
        !           109:         }
1.1       matthew   110:         my @data = split('&',$concatenated_data);
                    111:         foreach my $k_v_pair (@data) {
                    112:             my ($key,$value) = split('=',$k_v_pair,2);
                    113:             if (defined($action) && $action eq 'P') {
                    114:                 if (defined($value)) {
                    115:                     $db_to_store{$key}=$value;
                    116:                 } else {
                    117:                     $no_action_count++;
                    118:                 }
                    119:             } elsif ($action eq 'D') {
                    120:                 delete($db_to_store{$key});
                    121:             } else {
                    122:                 $error = "Unable to understand action '".$action."'";
                    123:             }
                    124:         }
                    125:         if (defined($error)) {
                    126:             return ('Error:'.$error.$/,undef);
                    127:         }
                    128:     }
                    129:     if ($no_action_count) {
                    130:         print $no_action_count.' lines did not require action.'.$/;
                    131:     }
                    132:     close(HISTFILE);
                    133:     return (undef,\%db_to_store);
                    134: }
                    135: 
                    136: sub write_hash {
                    137:     my ($db_filename,$db_to_store) = @_;
                    138:     #
                    139:     # Write the gdbm file
                    140:     my %db;
                    141:     if (! tie(%db,'GDBM_File',$db_filename,&GDBM_WRCREAT(),0640)) {
                    142:         warn "Unable to tie to $db_filename";
                    143:         return "Unable to tie to $db_filename";
                    144:     }
                    145:     #
                    146:     while (my ($k,$v) = each(%$db_to_store)) {
                    147:         $db{$k}=$v;
                    148:     }
                    149:     #
                    150:     untie(%db);
                    151:     return undef;
                    152: }
                    153: 
                    154: sub test_hash {
                    155:     my ($db_filename,$my_db) = @_;
                    156:     #
                    157:     my %db;
                    158:     if (! tie(%db,'GDBM_File',$db_filename,&GDBM_READER(),0640)) {
                    159:         return "Unable to tie to $db_filename";;
                    160:     }
                    161:     my (%key_errors,%value_errors);
                    162:     while (my ($k,$v) = each(%db)) {
                    163:         if (exists($my_db->{$k})) {
                    164:             if ($my_db->{$k} eq $v) {
                    165:                 delete($my_db->{$k});
                    166:             } else {
                    167:                 $value_errors{$k}=$v;
                    168:             }
                    169:         } else {
                    170:             $key_errors{$k}=$v;
                    171:         }
                    172:     }
                    173:     untie(%db);
                    174:     #
                    175:     my $error;
                    176:     my $extra_count = scalar(keys(%$my_db));
                    177:     if ($extra_count) {
                    178:         $error.=$extra_count.' extra key/value pairs found: '.$/;
                    179:         while (my ($k,$v) = each(%$my_db)) {
                    180:             $error .= '  "'.$k.'" => "'.$v.'"'.$/;
                    181:         }
                    182:     }
                    183:     my $key_count = scalar(keys(%key_errors));
                    184:     if ($key_count) {
                    185:         $error.=$key_count.' missing keys found: '.$/;
                    186:         while (my ($k,$v) = each(%key_errors)) {
                    187:             $error .= '  "'.$k.'" => "'.$v.'"'.$/;
                    188:         }
                    189:     }
                    190:     my $value_count = scalar(keys(%value_errors));
                    191:     if ($value_count) {
                    192:         $error.=$value_count.' missing values found: '.$/;
                    193:         while (my ($k,$v) = each(%value_errors)) {
                    194:             $error .= '  "'.$k.'" => "'.$v.'"'.$/;
                    195:         }
                    196:     }
                    197:     #
                    198:     return $error;
                    199: }