[BACK]Return to rebuild_db_from_hist.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / debugging_tools

Diff for /loncom/debugging_tools/rebuild_db_from_hist.pl between versions 1.3 and 1.4

version 1.3, 2004/12/09 20:01: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 53  Options: Line 54  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 107  sub process_file { Line 109  sub process_file {
         if ($fname eq 'roles.hist' && $concatenated_data =~ /^.*:.*:/) {          if ($fname eq 'roles.hist' && $concatenated_data =~ /^.*:.*:/) {
             (undef,undef,$concatenated_data) = split(':',$concatenated_data,3);              (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 116  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 175  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.'"'.$/;
         }          }
Removed from v.1.3  
changed lines
  Added in v.1.4

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>