[LON-CAPA-cvs] cvs: loncom /debugging_tools seed_accesscount.pl

[albertel]

albertel		Tue Jun 27 11:21:48 2006 EDT

  Modified files:              
    /loncom/debugging_tools	seed_accesscount.pl 
  Log:
  - morph to use LONCAPA.pm
  
  
Index: loncom/debugging_tools/seed_accesscount.pl
diff -u loncom/debugging_tools/seed_accesscount.pl:1.4 loncom/debugging_tools/seed_accesscount.pl:1.5
--- loncom/debugging_tools/seed_accesscount.pl:1.4	Tue Jan 13 13:13:34 2004
+++ loncom/debugging_tools/seed_accesscount.pl	Tue Jun 27 11:21:46 2006
@@ -2,7 +2,7 @@
 #
 # The LearningOnline Network
 #
-# $Id: seed_accesscount.pl,v 1.4 2004/01/13 18:13:34 matthew Exp $
+# $Id: seed_accesscount.pl,v 1.5 2006/06/27 15:21:46 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -30,6 +30,8 @@
 use strict;
 use Getopt::Long;
 use GDBM_File;
+use lib '/home/httpd/lib/perl/';
+use LONCAPA;
 
 #
 # Options
@@ -52,15 +54,16 @@
 while (my $resDBname = shift()) {
     my ($path) = ($resDBname =~ /^(.*)nohist_resevaldata.db$/);
     print STDERR $path.$/;
-    my %resevalDB;
-    if (! tie(%resevalDB,'GDBM_File',$resDBname,&GDBM_READER,0640)) {
+    my $resevalDB = &LONCAPA::locking_hash_tie($resDBname,&GDBM_READER());
+    if (! $resevalDB) {
         warn "Unable to tie to $resDBname";
         next;
     }
+    &LONCAPA::push_locking_hash_tie();
     #
     my $accessDBname = $path.'nohist_accesscount.db';
-    my %accessDB;
-    if (! tie(%accessDB,'GDBM_File',$accessDBname,&GDBM_WRCREAT,0640)) {
+    my $accessDB = &LONCAPA::locking_hash_tie($accessDBname,&GDBM_WRCREAT());
+    if (! $accessDB) {
         warn "Unable to tie to $accessDBname";
         next;
     }
@@ -69,7 +72,7 @@
     my ($basekey,$value);
     #
     $! = 0;
-    while (eval('($basekey,$value) = each(%resevalDB);')) {
+    while (eval('($basekey,$value) = each(%{$resevalDB});')) {
         if ($!) {
             print STDERR $1.$/;
             $!=0;
@@ -79,43 +82,32 @@
         next if (! ((undef,$src) = ($key =~ /^(.*)___(.*)___count/)));
         my $value = &unescape($value);
         $src = &escape($src);
-        if (exists($accessDB{$src})) {
-            $accessDB{$src}+=$value;
+        if (exists($accessDB->{$src})) {
+            $accessDB->{$src}+=$value;
         } else {
-            $accessDB{$src}=$value;
+            $accessDB->{$src}=$value;
         }
         push (@Keys,$basekey);
     }
     #
-    untie %accessDB;    
-    untie %resevalDB;
+    &LONCAPA::locking_hash_untie($accessDB);
+    &LONCAPA::pop_locking_hash_tie();
+    &LONCAPA::locking_hash_untie($resevalDB);
     system("chown www:www $accessDBname");
     # remove the keys we saved.
     next if (! scalar(@Keys)); # skip it if we did not get anything...
-    my $dbptr;
-    if (! ($dbptr = tie(%resevalDB,'GDBM_File',$resDBname,&GDBM_WRITER,0640))){
+    my $dbptr = &LONCAPA::locking_hash_tie($resDBname,&GDBM_READER());
+    if (! $dbptr ) {
         die "Unable to re-tie to $resDBname.  No deletes occured.";
     }
     foreach my $basekey (@Keys) {
-        delete($resevalDB{$basekey});
+        delete($resevalDB->{$basekey});
     }
     # Squish the file down
-    $dbptr->reorganize();
-    $dbptr = undef;
-    untie(%resevalDB);
+    &LONCAPA::locking_hash_untie($resevalDB);
     system("chown www:www $resDBname");
 }
 exit;
 
 ######################################
-sub escape {
-    my $str=shift;
-    $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
-    return $str;
-}
 
-sub unescape {
-    my $str=shift;
-    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
-    return $str;
-}