version 1.4, 2004/01/13 18:13:34
|
version 1.5, 2006/06/27 15:21:46
|
Line 30
|
Line 30
|
use strict; |
use strict; |
use Getopt::Long; |
use Getopt::Long; |
use GDBM_File; |
use GDBM_File; |
|
use lib '/home/httpd/lib/perl/'; |
|
use LONCAPA; |
|
|
# |
# |
# Options |
# Options |
Line 52 $|=1;
|
Line 54 $|=1;
|
while (my $resDBname = shift()) { |
while (my $resDBname = shift()) { |
my ($path) = ($resDBname =~ /^(.*)nohist_resevaldata.db$/); |
my ($path) = ($resDBname =~ /^(.*)nohist_resevaldata.db$/); |
print STDERR $path.$/; |
print STDERR $path.$/; |
my %resevalDB; |
my $resevalDB = &LONCAPA::locking_hash_tie($resDBname,&GDBM_READER()); |
if (! tie(%resevalDB,'GDBM_File',$resDBname,&GDBM_READER,0640)) { |
if (! $resevalDB) { |
warn "Unable to tie to $resDBname"; |
warn "Unable to tie to $resDBname"; |
next; |
next; |
} |
} |
|
&LONCAPA::push_locking_hash_tie(); |
# |
# |
my $accessDBname = $path.'nohist_accesscount.db'; |
my $accessDBname = $path.'nohist_accesscount.db'; |
my %accessDB; |
my $accessDB = &LONCAPA::locking_hash_tie($accessDBname,&GDBM_WRCREAT()); |
if (! tie(%accessDB,'GDBM_File',$accessDBname,&GDBM_WRCREAT,0640)) { |
if (! $accessDB) { |
warn "Unable to tie to $accessDBname"; |
warn "Unable to tie to $accessDBname"; |
next; |
next; |
} |
} |
Line 69 while (my $resDBname = shift()) {
|
Line 72 while (my $resDBname = shift()) {
|
my ($basekey,$value); |
my ($basekey,$value); |
# |
# |
$! = 0; |
$! = 0; |
while (eval('($basekey,$value) = each(%resevalDB);')) { |
while (eval('($basekey,$value) = each(%{$resevalDB});')) { |
if ($!) { |
if ($!) { |
print STDERR $1.$/; |
print STDERR $1.$/; |
$!=0; |
$!=0; |
Line 79 while (my $resDBname = shift()) {
|
Line 82 while (my $resDBname = shift()) {
|
next if (! ((undef,$src) = ($key =~ /^(.*)___(.*)___count/))); |
next if (! ((undef,$src) = ($key =~ /^(.*)___(.*)___count/))); |
my $value = &unescape($value); |
my $value = &unescape($value); |
$src = &escape($src); |
$src = &escape($src); |
if (exists($accessDB{$src})) { |
if (exists($accessDB->{$src})) { |
$accessDB{$src}+=$value; |
$accessDB->{$src}+=$value; |
} else { |
} else { |
$accessDB{$src}=$value; |
$accessDB->{$src}=$value; |
} |
} |
push (@Keys,$basekey); |
push (@Keys,$basekey); |
} |
} |
# |
# |
untie %accessDB; |
&LONCAPA::locking_hash_untie($accessDB); |
untie %resevalDB; |
&LONCAPA::pop_locking_hash_tie(); |
|
&LONCAPA::locking_hash_untie($resevalDB); |
system("chown www:www $accessDBname"); |
system("chown www:www $accessDBname"); |
# remove the keys we saved. |
# remove the keys we saved. |
next if (! scalar(@Keys)); # skip it if we did not get anything... |
next if (! scalar(@Keys)); # skip it if we did not get anything... |
my $dbptr; |
my $dbptr = &LONCAPA::locking_hash_tie($resDBname,&GDBM_READER()); |
if (! ($dbptr = tie(%resevalDB,'GDBM_File',$resDBname,&GDBM_WRITER,0640))){ |
if (! $dbptr ) { |
die "Unable to re-tie to $resDBname. No deletes occured."; |
die "Unable to re-tie to $resDBname. No deletes occured."; |
} |
} |
foreach my $basekey (@Keys) { |
foreach my $basekey (@Keys) { |
delete($resevalDB{$basekey}); |
delete($resevalDB->{$basekey}); |
} |
} |
# Squish the file down |
# Squish the file down |
$dbptr->reorganize(); |
&LONCAPA::locking_hash_untie($resevalDB); |
$dbptr = undef; |
|
untie(%resevalDB); |
|
system("chown www:www $resDBname"); |
system("chown www:www $resDBname"); |
} |
} |
exit; |
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; |
|
} |
|