version 1.33, 2003/06/19 19:34:27
|
version 1.39, 2003/08/21 01:48:22
|
Line 76 use POSIX qw(strftime mktime);
|
Line 76 use POSIX qw(strftime mktime);
|
|
|
my @metalist; |
my @metalist; |
|
|
|
$simplestatus=''; |
|
my %countext=(); |
|
|
|
sub writesimple { |
|
open(SMP,'>/home/httpd/html/lon-status/mysql.txt'); |
|
print SMP $simplestatus."\n"; |
|
close(SMP); |
|
} |
|
|
|
sub writecount { |
|
open(RSMP,'>/home/httpd/html/lon-status/rescount.txt'); |
|
foreach (keys %countext) { |
|
print RSMP $_.'='.$countext{$_}.'&'; |
|
} |
|
print RSMP 'time='.time."\n"; |
|
close(RSMP); |
|
} |
|
|
|
sub count { |
|
my $file=shift; |
|
$file=~/\.(\w+)$/; |
|
my $ext=lc($1); |
|
if (defined($countext{$ext})) { |
|
$countext{$ext}++; |
|
} else { |
|
$countext{$ext}=1; |
|
} |
|
} |
# ----------------------------------------------------- Un-Escape Special Chars |
# ----------------------------------------------------- Un-Escape Special Chars |
|
|
sub unescape { |
sub unescape { |
Line 104 sub dynamicmeta {
|
Line 131 sub dynamicmeta {
|
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', |
if ((tie(%evaldata,'GDBM_File', |
$prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) && |
$prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) && |
(tie(%newevaldata,'GDBM_File', |
(tie(%newevaldata,'GDBM_File', |
$prodir.'/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) { |
$prodir.'/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) { |
my %sum=(); |
my %sum=(); |
my %cnt=(); |
my %cnt=(); |
my %listitems=('count' => 'add', |
my %listitems=('count' => 'add', |
'course' => 'add', |
'course' => 'add', |
'avetries' => 'avg', |
'avetries' => 'avg', |
'stdno' => 'add', |
'stdno' => 'add', |
'difficulty' => 'avg', |
'difficulty' => 'avg', |
'clear' => 'avg', |
'clear' => 'avg', |
'technical' => 'avg', |
'technical' => 'avg', |
'helpful' => 'avg', |
'helpful' => 'avg', |
'correct' => 'avg', |
'correct' => 'avg', |
'depth' => 'avg', |
'depth' => 'avg', |
'comments' => 'app', |
'comments' => 'app', |
'usage' => 'cnt' |
'usage' => 'cnt' |
); |
); |
my $regexp=$url; |
my $regexp=$url; |
$regexp=~s/(\W)/\\$1/g; |
$regexp=~s/(\W)/\\$1/g; |
$regexp='___'.$regexp.'___([a-z]+)$'; |
$regexp='___'.$regexp.'___([a-z]+)$'; |
foreach (keys %evaldata) { |
foreach (keys %evaldata) { |
my $key=&unescape($_); |
my $key=&unescape($_); |
if ($key=~/$regexp/) { |
if ($key=~/$regexp/) { |
my $ctype=$1; |
my $ctype=$1; |
if (defined($cnt{$ctype})) { |
if (defined($cnt{$ctype})) { |
$cnt{$ctype}++; |
$cnt{$ctype}++; |
} else { |
} else { |
$cnt{$ctype}=1; |
$cnt{$ctype}=1; |
} |
|
unless ($listitems{$ctype} eq 'app') { |
|
if (defined($sum{$ctype})) { |
|
$sum{$ctype}+=$evaldata{$_}; |
|
} else { |
|
$sum{$ctype}=$evaldata{$_}; |
|
} |
|
} else { |
|
if (defined($sum{$ctype})) { |
|
if ($evaldata{$_}) { |
|
$sum{$ctype}.='<hr>'.$evaldata{$_}; |
|
} |
|
} else { |
|
$sum{$ctype}=''.$evaldata{$_}; |
|
} |
|
} |
|
if ($ctype ne 'count') { |
|
$newevaldata{$_}=$evaldata{$_}; |
|
} |
|
} |
} |
} |
unless ($listitems{$ctype} eq 'app') { |
foreach (keys %cnt) { |
if (defined($sum{$ctype})) { |
if ($listitems{$_} eq 'avg') { |
$sum{$ctype}+=$evaldata{$_}; |
$returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0; |
} else { |
} elsif ($listitems{$_} eq 'cnt') { |
$sum{$ctype}=$evaldata{$_}; |
$returnhash{$_}=$cnt{$_}; |
} |
} else { |
} else { |
$returnhash{$_}=$sum{$_}; |
if (defined($sum{$ctype})) { |
} |
if ($evaldata{$_}) { |
} |
$sum{$ctype}.='<hr>'.$evaldata{$_}; |
if ($returnhash{'count'}) { |
} |
my $newkey=$$.'_'.time.'_searchcat___'.&escape($url).'___count'; |
} else { |
$newevaldata{$newkey}=$returnhash{'count'}; |
$sum{$ctype}=''.$evaldata{$_}; |
} |
} |
untie(%evaldata); |
} |
untie(%newevaldata); |
if ($ctype ne 'count') { |
} |
$newevaldata{$_}=$evaldata{$_}; |
return %returnhash; |
} |
|
} |
|
} |
|
foreach (keys %cnt) { |
|
if ($listitems{$_} eq 'avg') { |
|
$returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0; |
|
} elsif ($listitems{$_} eq 'cnt') { |
|
$returnhash{$_}=$cnt{$_}; |
|
} else { |
|
$returnhash{$_}=$sum{$_}; |
|
} |
|
} |
|
if ($returnhash{'count'}) { |
|
my $newkey=$$.'_'.time.'_searchcat___'.&escape($url).'___count'; |
|
$newevaldata{$newkey}=$returnhash{'count'}; |
|
} |
|
untie(%evaldata); |
|
untie(%newevaldata); |
|
} |
|
return %returnhash; |
} |
} |
|
|
# ----------------- Code to enable 'find' subroutine listing of the .meta files |
# ----------------- Code to enable 'find' subroutine listing of the .meta files |
require "find.pl"; |
require "find.pl"; |
sub wanted { |
sub wanted { |
Line 207 if ($wwwid!=$<) {
|
Line 234 if ($wwwid!=$<) {
|
|
|
open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log'); |
open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log'); |
print LOG '==== Searchcat Run '.localtime()."====\n\n"; |
print LOG '==== Searchcat Run '.localtime()."====\n\n"; |
|
$simplestatus='time='.time.'&'; |
my $dbh; |
my $dbh; |
# ------------------------------------- Make sure that database can be accessed |
# ------------------------------------- Make sure that database can be accessed |
{ |
{ |
Line 214 my $dbh;
|
Line 242 my $dbh;
|
$dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) |
$dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) |
) { |
) { |
print LOG "Cannot connect to database!\n"; |
print LOG "Cannot connect to database!\n"; |
|
$simplestatus.='mysql=defunct'; |
|
&writesimple(); |
exit; |
exit; |
} |
} |
|
|
my $make_metadata_table = "CREATE TABLE IF NOT EXISTS metadata (". |
my $make_metadata_table = "CREATE TABLE IF NOT EXISTS metadata (". |
"title TEXT, author TEXT, subject TEXT, url TEXT, keywords TEXT, ". |
"title TEXT, author TEXT, subject TEXT, url TEXT, keywords TEXT, ". |
"version TEXT, notes TEXT, abstract TEXT, mime TEXT, language TEXT, ". |
"version TEXT, notes TEXT, abstract TEXT, mime TEXT, language TEXT, ". |
Line 237 my @homeusers = grep {
|
Line 268 my @homeusers = grep {
|
&ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_") |
&ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_") |
} grep {!/^\.\.?$/} readdir(RESOURCES); |
} grep {!/^\.\.?$/} readdir(RESOURCES); |
closedir RESOURCES; |
closedir RESOURCES; |
|
|
|
# |
|
# Create the statement handlers we need |
|
my $delete_sth = $dbh->prepare |
|
("DELETE FROM metadata WHERE url LIKE BINARY ?"); |
|
|
|
my $insert_sth = $dbh->prepare |
|
("INSERT INTO metadata VALUES (". |
|
"?,". # title |
|
"?,". # author |
|
"?,". # subject |
|
"?,". # m2??? |
|
"?,". # version |
|
"?,". # current |
|
"?,". # notes |
|
"?,". # abstract |
|
"?,". # mime |
|
"?,". # language |
|
"?,". # creationdate |
|
"?,". # revisiondate |
|
"?,". # owner |
|
"?)" # copyright |
|
); |
|
|
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 |
# Remove left-over db-files from potentially crashed searchcat run |
Line 254 foreach my $user (@homeusers) {
|
Line 309 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); |
my $q2="select * from metadata where url like binary '$m2'"; |
&count($m2); |
my $sth = $dbh->prepare($q2); |
$delete_sth->execute($m2); |
$sth->execute(); |
$insert_sth->execute($ref->{'title'}, |
my $r1=$sth->fetchall_arrayref; |
$ref->{'author'}, |
if (@$r1) { |
$ref->{'subject'}, |
$sth=$dbh->prepare("delete from metadata where url like binary '$m2'"); |
$m2, |
$sth->execute(); |
$ref->{'keywords'}, |
} |
'current', |
$sth=$dbh->prepare('insert into metadata values ('. |
$ref->{'notes'}, |
'"'.delete($ref->{'title'}).'"'.','. |
$ref->{'abstract'}, |
'"'.delete($ref->{'author'}).'"'.','. |
$ref->{'mime'}, |
'"'.delete($ref->{'subject'}).'"'.','. |
$ref->{'language'}, |
'"'.$m2.'"'.','. |
sqltime($ref->{'creationdate'}), |
'"'.delete($ref->{'keywords'}).'"'.','. |
sqltime($ref->{'lastrevisiondate'}), |
'"'.'current'.'"'.','. |
$ref->{'owner'}, |
'"'.delete($ref->{'notes'}).'"'.','. |
$ref->{'copyright'}); |
'"'.delete($ref->{'abstract'}).'"'.','. |
# if ($dbh->err()) { |
'"'.delete($ref->{'mime'}).'"'.','. |
# print STDERR "Error:".$dbh->errstr()."\n"; |
'"'.delete($ref->{'language'}).'"'.','. |
# } |
'"'.sqltime(delete($ref->{'creationdate'})).'"'.','. |
$ref = undef; |
'"'.sqltime(delete($ref->{'lastrevisiondate'})).'"'.','. |
|
'"'.delete($ref->{'owner'}).'"'.','. |
|
'"'.delete($ref->{'copyright'}).'"'.')'); |
|
$sth->execute(); |
|
} |
} |
|
|
# --------------------------------------------------- Clean up database |
# --------------------------------------------------- Clean up database |
Line 286 foreach my $user (@homeusers) {
|
Line 337 foreach my $user (@homeusers) {
|
# ... not yet implemented |
# ... not yet implemented |
|
|
# ------------------------------------------- Copy over the new db-files |
# ------------------------------------------- Copy over the new db-files |
system('mv '.$prodir.'/nohist_new_resevaldata.db '. |
# |
$prodir.'/nohist_resevaldata.db'); |
# 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; |
print LOG "\n==== Searchcat completed ".localtime()." ====\n"; |
print LOG "\n==== Searchcat completed ".localtime()." ====\n"; |
close(LOG); |
close(LOG); |
|
&writesimple(); |
|
&writecount(); |
exit 0; |
exit 0; |
|
|
|
|