--- loncom/debugging_tools/seed_accesscount.pl 2004/01/13 18:13:34 1.4 +++ loncom/debugging_tools/seed_accesscount.pl 2006/06/27 15:21:46 1.5 @@ -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 @@ $|=1; 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 @@ while (my $resDBname = shift()) { 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 @@ while (my $resDBname = shift()) { 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; -}