[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.1 and 1.7

version 1.1, 2004/12/08 22:06:48 version 1.7, 2016/01/31 21:26:01
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,$test_db,$p_is_s);
 GetOptions("help"    => \$help,  GetOptions("help"           => \$help,
            "debug"   => \$debug,             "debug"          => \$debug,
            "test"    => \$test);             "test"           => \$test,
              "create_test_db" => \$test_db,
              "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 55  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.
      -create_test_db
                when testing also create a *.db.test db of the testing info
      -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 62  END Line 71  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 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) ) {
    $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 && $test_db) {
           $error = &write_hash($db_filename.'.test',$constructed_hash);
       }
     if ($test) {      if ($test) {
         my $error = &test_hash($db_filename,$constructed_hash);          my $error = &test_hash($db_filename,$constructed_hash);
         if (defined($error)) {          if (defined($error)) {
Line 101  sub process_file { Line 121  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)
    #  M:modify the values for a previous S
           #  U:update the values (action could be add or del).
         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,$updatetype);
           if ($action eq 'S') {
               ($rid,$concatenated_data) = split(':',$concatenated_data,2);
               $version = ++$db_to_store{"version:$rid"};
                #print $version.$/;
           }
    if ($action eq 'M') {
               ($rid,$version,$concatenated_data) = 
    split(':',$concatenated_data,3);
    }
           if ($action eq 'U') {
               ($updatetype,$concatenated_data) =
                   split(':',$concatenated_data,2); 
           }
           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 112  sub process_file { Line 157  sub process_file {
                 } else {                  } else {
                     $no_action_count++;                      $no_action_count++;
                 }                  }
               } elsif ($action eq 'S' || $action eq 'M') {
                   # Versioning of data, so we update the old ata
                   push(@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});
               } elsif ($action eq 'U') {
                   if ($updatetype eq 'del') {
                       if (exists($db_to_store{$key})) {
                           my %current;
                           map { $current{$_} = 1; } split(/,/,&unescape($db_to_store{$key}));
                           map { delete($current{$_}); } split(/,/,&unescape($value));
                           if (keys(%current)) {
                               $db_to_store{$key}=&escape(join(',',sort(keys(%current))));
                           } else {
                               delete($db_to_store{$key});
                           }
                       }
                   } elsif ($updatetype eq 'add') {
                       if (exists($db_to_store{$key})) {
                           my @newvals = split(/,/,&unescape($value));
                           my @currvals = split(/,/,&unescape($db_to_store{$key}));
                           my @merged = sort(keys(%{{map { $_ => 1 } (@newvals,@currvals)}}));
                           $db_to_store{$key}=&escape(join(',',@merged));
                       } else {
                           $db_to_store{$key}=$value;
                       }
                   }
             } 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;
       push(@allkeys,'timestamp');
    }
           if ($action eq 'S' || $action eq 'M') {
       $db_to_store{"$version:keys:$rid"}=join(':',@allkeys);
           }
         if (defined($error)) {          if (defined($error)) {
             return ('Error:'.$error.$/,undef);              return ('Error:'.$error.$/,undef);
         }          }
Line 171  sub test_hash { Line 261  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 193  sub test_hash { Line 283  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;
   }
Removed from v.1.1  
changed lines
  Added in v.1.7

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