[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.4 and 1.5

version 1.4, 2004/12/09 22:25:47 version 1.5, 2006/08/03 17:27:48
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
Line 65  END Line 68  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 "Aborting: The target file $db_filename exists.".$/;
         next;          next;
     }      }
     my ($error,$constructed_hash) = &process_file($fname,$db_filename,$debug);      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) {      if ($test) {
           $error = &write_hash($db_filename.'.test',$constructed_hash);
       }
       if ($test) {
         my $error = &test_hash($db_filename,$constructed_hash);          my $error = &test_hash($db_filename,$constructed_hash);
         if (defined($error)) {          if (defined($error)) {
             print "Error processing ".$fname.$/;              print "Error processing ".$fname.$/;
             print STDERR $error;              print $error;
         } else {          } else {
             print "Everything looks good for ".$fname.$/;              print "Everything looks good for ".$fname.$/;
         }          }
Line 104  sub process_file { Line 118  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)
         my ($action,$time,$concatenated_data) = split(':',$command,3);          my ($action,$time,$concatenated_data) = split(':',$command,3);
         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);
Line 115  sub process_file { Line 131  sub process_file {
         if ($action eq 'S') {          if ($action eq 'S') {
             ($rid,$concatenated_data) = split(':',$concatenated_data,2);              ($rid,$concatenated_data) = split(':',$concatenated_data,2);
             $version = ++$db_to_store{"version:$rid"};              $version = ++$db_to_store{"version:$rid"};
             # print $version.$/;               #print $version.$/;
         }          }
         next if (! defined($concatenated_data));          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 131  sub process_file { Line 148  sub process_file {
                 # Versioning of data, so we update the old ata                  # Versioning of data, so we update the old ata
                 $allkeys.=$key.':';                  $allkeys.=$key.':';
                 $db_to_store{"$version:$rid:$key"}=$value;                  $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});
             } 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') {          if ($action eq 'S') {
     $db_to_store{"$version:$rid:timestamp"}=$time;      $db_to_store{"$version:$rid:timestamp"}=$time;
     $allkeys.='timestamp';      $allkeys.='timestamp';
Line 197  sub test_hash { Line 225  sub test_hash {
     if ($extra_count) {      if ($extra_count) {
         $error.=$extra_count.' extra key/value pairs found in hist: '.$/;          $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));
Line 217  sub test_hash { Line 245  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.4  
changed lines
  Added in v.1.5

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