--- loncom/debugging_tools/seed_accesscount.pl 2003/11/14 19:52:10 1.1 +++ loncom/debugging_tools/seed_accesscount.pl 2003/12/04 13:40:29 1.3 @@ -2,7 +2,7 @@ # # The LearningOnline Network # -# $Id: seed_accesscount.pl,v 1.1 2003/11/14 19:52:10 matthew Exp $ +# $Id: seed_accesscount.pl,v 1.3 2003/12/04 13:40:29 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -78,6 +78,7 @@ while (my $resDBname = shift()) { my $src; next if (! ((undef,$src) = ($key =~ /^(.*)___(.*)___count/))); my $value = &unescape($value); + $src = &escape($src); if (exists($accessDB{$src})) { $accessDB{$src}+=$value; } else { @@ -90,17 +91,27 @@ while (my $resDBname = shift()) { untie %resevalDB; # remove the keys we saved. next if (! scalar(@Keys)); # skip it if we did not get anything... - if (! tie(%resevalDB,'GDBM_File',$resDBname,&GDBM_WRITER,0640)) { + my $dbptr; + if (! ($dbptr = tie(%resevalDB,'GDBM_File',$resDBname,&GDBM_WRITER,0640))){ die "Unable to re-tie to $resDBname. No deletes occured."; } foreach my $basekey (@Keys) { delete($resevalDB{$basekey}); } - untie %resevalDB; + # Squish the file down + $dbptr->reorganize(); + $dbptr = undef; + untie(%resevalDB); } 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;