version 1.39, 2003/08/21 01:48:22
|
version 1.44, 2003/12/23 15:47:26
|
Line 124 sub escape {
|
Line 124 sub escape {
|
# ------------------------------------------- Code to evaluate dynamic metadata |
# ------------------------------------------- Code to evaluate dynamic metadata |
|
|
sub dynamicmeta { |
sub dynamicmeta { |
|
|
my $url=&declutter(shift); |
my $url=&declutter(shift); |
$url=~s/\.meta$//; |
$url=~s/\.meta$//; |
my %returnhash=(); |
my %returnhash=(); |
my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//); |
my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//); |
my $prodir=&propath($adomain,$aauthor); |
my $prodir=&propath($adomain,$aauthor); |
if ((tie(%evaldata,'GDBM_File', |
# Get metadata except counts |
$prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) && |
if (tie(%evaldata,'GDBM_File', |
(tie(%newevaldata,'GDBM_File', |
$prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) { |
$prodir.'/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) { |
my %sum=(); |
my %sum=(); |
my %cnt=(); |
my %cnt=(); |
my %concat=(); |
my %listitems=('count' => 'add', |
my %listitems=( |
'course' => 'add', |
'course' => 'add', |
'avetries' => 'avg', |
'goto' => 'add', |
'stdno' => 'add', |
'comefrom' => 'add', |
'difficulty' => 'avg', |
'avetries' => 'avg', |
'clear' => 'avg', |
'stdno' => 'add', |
'technical' => 'avg', |
'difficulty' => 'avg', |
'helpful' => 'avg', |
'clear' => 'avg', |
'correct' => 'avg', |
'technical' => 'avg', |
'depth' => 'avg', |
'helpful' => 'avg', |
'comments' => 'app', |
'correct' => 'avg', |
'usage' => 'cnt' |
'depth' => 'avg', |
); |
'comments' => 'app', |
my $regexp=$url; |
'usage' => 'cnt' |
$regexp=~s/(\W)/\\$1/g; |
); |
$regexp='___'.$regexp.'___([a-z]+)$'; |
|
foreach (keys %evaldata) { |
my $regexp=$url; |
my $key=&unescape($_); |
$regexp=~s/(\W)/\\$1/g; |
if ($key=~/$regexp/) { |
$regexp='___'.$regexp.'___([a-z]+)$'; |
my $ctype=$1; |
while (my ($esckey,$value)=each %evaldata) { |
if (defined($cnt{$ctype})) { |
$key=&unescape($esckey); |
$cnt{$ctype}++; |
if ($key=~/$regexp/) { |
} else { |
my ($item,$purl,$cat)=split(/___/,$_); |
$cnt{$ctype}=1; |
if (defined($cnt{$cat})) { $cnt{$cat}++; } else { $cnt{$cat}=1; } |
} |
unless ($listitems{$cat} eq 'app') { |
unless ($listitems{$ctype} eq 'app') { |
if (defined($sum{$cat})) { |
if (defined($sum{$ctype})) { |
$sum{$cat}+=$evaldata{$_}; |
$sum{$ctype}+=$evaldata{$_}; |
$concat{$cat}.=','.$item; |
} else { |
} else { |
$sum{$ctype}=$evaldata{$_}; |
$sum{$cat}=$evaldata{$_}; |
} |
$concat{$cat}=$item; |
} else { |
} |
if (defined($sum{$ctype})) { |
} else { |
if ($evaldata{$_}) { |
if (defined($sum{$cat})) { |
$sum{$ctype}.='<hr>'.$evaldata{$_}; |
if ($evaldata{$_}) { |
} |
$sum{$cat}.='<hr>'.$evaldata{$_}; |
} else { |
} |
$sum{$ctype}=''.$evaldata{$_}; |
} else { |
} |
$sum{$cat}=''.$evaldata{$_}; |
|
} |
|
} |
} |
} |
if ($ctype ne 'count') { |
} |
$newevaldata{$_}=$evaldata{$_}; |
untie(%evaldata); |
} |
} |
} |
# construct the return hash for non-count data |
} |
my %returnhash=(); |
foreach (keys %cnt) { |
while ($_=each(%cnt)) { |
if ($listitems{$_} eq 'avg') { |
if ($listitems{$_} eq 'avg') { |
$returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0; |
$returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0; |
} elsif ($listitems{$_} eq 'cnt') { |
} elsif ($listitems{$_} eq 'cnt') { |
$returnhash{$_}=$cnt{$_}; |
$returnhash{$_}=$cnt{$_}; |
} else { |
} else { |
$returnhash{$_}=$sum{$_}; |
$returnhash{$_}=$sum{$_}; |
} |
} |
} |
$returnhash{$_.'_list'}=$concat{$_}; |
if ($returnhash{'count'}) { |
} |
my $newkey=$$.'_'.time.'_searchcat___'.&escape($url).'___count'; |
# get count |
$newevaldata{$newkey}=$returnhash{'count'}; |
if (tie(%evaldata,'GDBM_File', |
} |
$prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) { |
untie(%evaldata); |
if (! exists($evaldata{$uri})) { |
untie(%newevaldata); |
$returnhash{'count'}='Not Available'; |
} |
} else { |
return %returnhash; |
$returnhash{'count'}=$evaldata{$uri}; |
|
} |
|
untie %evaldata; |
|
} |
|
return %returnhash; |
} |
} |
|
|
# ----------------- Code to enable 'find' subroutine listing of the .meta files |
# ----------------- Code to enable 'find' subroutine listing of the .meta files |
Line 294 my $insert_sth = $dbh->prepare
|
Line 299 my $insert_sth = $dbh->prepare
|
|
|
foreach my $user (@homeusers) { |
foreach my $user (@homeusers) { |
print LOG "\n=== User: ".$user."\n\n"; |
print LOG "\n=== User: ".$user."\n\n"; |
# Remove left-over db-files from potentially crashed searchcat run |
|
my $prodir=&propath($perlvar{'lonDefDomain'},$user); |
my $prodir=&propath($perlvar{'lonDefDomain'},$user); |
unlink($prodir.'/nohist_new_resevaldata.db'); |
|
# Use find.pl |
# Use find.pl |
undef @metalist; |
undef @metalist; |
@metalist=(); |
@metalist=(); |
Line 309 foreach my $user (@homeusers) {
|
Line 313 foreach my $user (@homeusers) {
|
my $ref=&metadata($m); |
my $ref=&metadata($m); |
my $m2='/res/'.&declutter($m); |
my $m2='/res/'.&declutter($m); |
$m2=~s/\.meta$//; |
$m2=~s/\.meta$//; |
# &dynamicmeta($m2); |
&dynamicmeta($m2); |
|
if ($ref->{'obsolete'}) { print LOG "obsolete\n"; next; } |
|
if ($ref->{'copyright'} eq 'private') { print LOG "private\n"; next; } |
&count($m2); |
&count($m2); |
$delete_sth->execute($m2); |
$delete_sth->execute($m2); |
$insert_sth->execute($ref->{'title'}, |
$insert_sth->execute($ref->{'title'}, |
Line 336 foreach my $user (@homeusers) {
|
Line 342 foreach my $user (@homeusers) {
|
# Need to, perhaps, remove stale SQL database records. |
# Need to, perhaps, remove stale SQL database records. |
# ... not yet implemented |
# ... not yet implemented |
|
|
# ------------------------------------------- Copy over the new db-files |
|
# |
|
# Check the size of nohist_new_resevaldata.db compared to |
|
# nohist_resevaldata.db |
|
# my @stat_result = stat($prodir.'/nohist_new_resevaldata.db'); |
|
# my $new_size = $stat_result[7]; |
|
# @stat_result = stat($prodir.'/nohist_resevaldata.db'); |
|
# my $old_size = $stat_result[7]; |
|
# if ($old_size) { |
|
# if ($new_size/$old_size > 0.15 ) { |
|
# system('mv '.$prodir.'/nohist_new_resevaldata.db '. |
|
# $prodir.'/nohist_resevaldata.db'); |
|
# } else { |
|
# print LOG "Size of '$user' old nohist_reseval: $old_size ". |
|
# "Size of new: $new_size. Not overwriting.\n"; |
|
# my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
|
# my $subj="LON: $perlvar{'lonHostID'} searchcat.pl $user reseval ". |
|
# "modification error."; |
|
# system("echo ". |
|
# "'See /home/httpd/perl/logs/searchcat.txt for information.' ". |
|
# "| mailto $emailto -s '$subj' > /dev/null"); |
|
# } |
|
# } |
|
} |
} |
# --------------------------------------------------- Close database connection |
# --------------------------------------------------- Close database connection |
$dbh->disconnect; |
$dbh->disconnect; |