[LON-CAPA-cvs] cvs: loncom /debugging_tools dump_db.pl make_user_ca.pl make_user_cc.pl

[www]

www		Mon Jun 19 05:36:25 2006 EDT

  Modified files:              
    /loncom/debugging_tools	dump_db.pl make_user_ca.pl make_user_cc.pl 
  Log:
  * the make_user programs were erasing and then corrupting the .hist-files
  * call new locking ties
  
  
Index: loncom/debugging_tools/dump_db.pl
diff -u loncom/debugging_tools/dump_db.pl:1.5 loncom/debugging_tools/dump_db.pl:1.6
--- loncom/debugging_tools/dump_db.pl:1.5	Fri Mar 18 16:36:49 2005
+++ loncom/debugging_tools/dump_db.pl	Mon Jun 19 05:36:22 2006
@@ -4,7 +4,7 @@
 #
 # dump_db.pl - dump a GDBM database to standard output, unescaping if asked to.
 #
-# $Id: dump_db.pl,v 1.5 2005/03/18 21:36:49 albertel Exp $
+# $Id: dump_db.pl,v 1.6 2006/06/19 09:36:22 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -34,6 +34,8 @@
 use GDBM_File;
 use Data::Dumper;
 use Storable qw(thaw);
+use lib '/home/httpd/lib/perl/';
+use LONCAPA;
 
 #
 # Options
@@ -67,12 +69,13 @@
 #
 # Loop through ARGV getting files.
 while (my $fname = shift) {
-    my %db;
-    if (! tie(%db,'GDBM_File',$fname,&GDBM_READER(),0640)) {
+    my $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
+
+    if (!$dbref) {
         warn "Unable to tie to $fname";
         next;
     }
-    while (my ($key,$value) = each(%db)) {
+    while (my ($key,$value) = each(%$dbref)) {
         if ($value =~ s/^__FROZEN__//) {
             $value = thaw(&unescape($value));
         }
@@ -85,13 +88,7 @@
         }
         print "$key = ".(ref($value)?Dumper($value):$value)."\n";
     }
-    untie %db;
+    &LONCAPA::locking_hash_untie($dbref);
 }
 exit;
 
-######################################
-sub unescape {
-    my $str=shift;
-    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
-    return $str;
-}
Index: loncom/debugging_tools/make_user_ca.pl
diff -u loncom/debugging_tools/make_user_ca.pl:1.1 loncom/debugging_tools/make_user_ca.pl:1.2
--- loncom/debugging_tools/make_user_ca.pl:1.1	Sun Sep 12 17:27:05 2004
+++ loncom/debugging_tools/make_user_ca.pl	Mon Jun 19 05:36:22 2006
@@ -2,7 +2,8 @@
 #
 use strict;
 use GDBM_File;
-my %roles;
+use lib '/home/httpd/lib/perl/';
+use LONCAPA;
 
 my $user      = shift;
 my $userdom   = shift;
@@ -28,16 +29,11 @@
 
 print "dbfile = $dbfile\n";
 
-tie (%roles,'GDBM_File',$dbfile,
-	&GDBM_WRCREAT(),0640);
-$roles{'/'.$targetdom.'/'.$target.'_ca'}='ca_'.$endtime.'_'.time;
-open OUT, ">/home/httpd/lonUsers/$userdom/$a/$b/$c/$user/roles.hist";
-foreach (keys(%roles)) {
-    print OUT $_.' : '.$roles{$_}."\n";
-}
-close OUT;
+my $rolesref=&LONCAPA::locking_hash_tie($dbfile,&GDBM_WRCREAT());
+
+$$rolesref{'/'.$targetdom.'/'.$target.'_ca'}='ca_'.$endtime.'_'.time;
 
-untie %roles;
+&LONCAPA::locking_hash_untie($rolesref);
 `chown www:www /home/httpd/lonUsers/$userdom/$a/$b/$c/$user/roles.hist`;
 `chown www:www /home/httpd/lonUsers/$userdom/$a/$b/$c/$user/roles.db`;
 
Index: loncom/debugging_tools/make_user_cc.pl
diff -u loncom/debugging_tools/make_user_cc.pl:1.1 loncom/debugging_tools/make_user_cc.pl:1.2
--- loncom/debugging_tools/make_user_cc.pl:1.1	Sun Sep 12 17:27:05 2004
+++ loncom/debugging_tools/make_user_cc.pl	Mon Jun 19 05:36:22 2006
@@ -2,7 +2,8 @@
 #
 use strict;
 use GDBM_File;
-my %roles;
+use lib '/home/httpd/lib/perl/';
+use LONCAPA;
 
 my $user      = shift;
 my $userdom   = shift;
@@ -27,16 +28,9 @@
 my $dbfile   = "/home/httpd/lonUsers/$userdom/$a/$b/$c/$user/roles.db";
 my $histfile = "/home/httpd/lonUsers/$userdom/$a/$b/$c/$user/roles.hist";
 
-tie (%roles,'GDBM_File',$dbfile,&GDBM_WRCREAT(),0640);
-$roles{'/'.$coursedom.'/'.$course.'_cc'}='cc';
-
-open OUT, ">".$histfile;
-foreach (keys(%roles)) {
-    print OUT $_.' : '.$roles{$_}."\n";
-}
-close OUT;
-
-untie %roles;
+my $rolesref=&LONCAPA::locking_hash_tie($dbfile,&GDBM_WRCREAT());
+$$rolesref{'/'.$coursedom.'/'.$course.'_cc'}='cc';
+&LONCAPA::locking_hash_untie($rolesref);
 
 system ("chown www:www $histfile");
 system ("chown www:www $dbfile");