version 1.34, 2003/06/19 20:24:57
|
version 1.48, 2003/12/25 13:11:56
|
Line 56 This script also does general database m
|
Line 56 This script also does general database m
|
the C<loncapa:metadata> table if it is deprecated. |
the C<loncapa:metadata> table if it is deprecated. |
|
|
This script evaluates dynamic metadata from the authors' |
This script evaluates dynamic metadata from the authors' |
F<nohist_resevaldata.db> database file in order to store it in MySQL, as |
F<nohist_resevaldata.db> database file in order to store it in MySQL. |
well as to compress the filesize (add up all "count"-type metadata). |
|
|
|
This script is playing an increasingly important role for a loncapa |
This script is playing an increasingly important role for a loncapa |
library server. The proper operation of this script is critical for a smooth |
library server. The proper operation of this script is critical for a smooth |
Line 65 and correct user experience.
|
Line 64 and correct user experience.
|
|
|
=cut |
=cut |
|
|
|
use strict; |
|
|
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
|
|
Line 74 use DBI;
|
Line 75 use DBI;
|
use GDBM_File; |
use GDBM_File; |
use POSIX qw(strftime mktime); |
use POSIX qw(strftime mktime); |
|
|
|
require "find.pl"; |
|
|
my @metalist; |
my @metalist; |
|
|
|
my $simplestatus=''; |
|
my %countext=(); |
|
|
|
# ----------------------------------------------------- write out simple status |
|
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); |
|
} |
|
|
|
# -------------------------------------- counts files with different extensions |
|
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 93 sub escape {
|
Line 125 sub escape {
|
return $str; |
return $str; |
} |
} |
|
|
|
|
# ------------------------------------------- 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=( |
|
'count' => 0, |
|
'course' => 0, |
|
'course_list' => '', |
|
'avetries' => 0, |
|
'avetries_list' => '', |
|
'stdno' => 0, |
|
'stdno_list' => '', |
|
'usage' => 0, |
|
'usage_list' => '', |
|
'goto' => 0, |
|
'goto_list' => '', |
|
'comefrom' => 0, |
|
'comefrom_list' => '', |
|
'difficulty' => 0, |
|
'difficulty_list' => '' |
|
); |
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', |
|
$prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) && |
# Get metadata except counts |
(tie(%newevaldata,'GDBM_File', |
if (tie(my %evaldata,'GDBM_File', |
$prodir.'/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) { |
$prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) { |
my %sum=(); |
my %sum=(); |
my %cnt=(); |
my %cnt=(); |
my %listitems=('count' => 'add', |
my %concat=(); |
'course' => 'add', |
my %listitems=( |
'avetries' => 'avg', |
'course' => 'add', |
'stdno' => 'add', |
'goto' => 'add', |
'difficulty' => 'avg', |
'comefrom' => 'add', |
'clear' => 'avg', |
'avetries' => 'avg', |
'technical' => 'avg', |
'stdno' => 'add', |
'helpful' => 'avg', |
'difficulty' => 'avg', |
'correct' => 'avg', |
'clear' => 'avg', |
'depth' => 'avg', |
'technical' => 'avg', |
'comments' => 'app', |
'helpful' => 'avg', |
'usage' => 'cnt' |
'correct' => 'avg', |
); |
'depth' => 'avg', |
my $regexp=$url; |
'comments' => 'app', |
$regexp=~s/(\W)/\\$1/g; |
'usage' => 'cnt' |
$regexp='___'.$regexp.'___([a-z]+)$'; |
); |
study($regexp); |
|
while (my ($key,$value) = each(%evaldata)) { |
my $regexp=$url; |
$key=&unescape($key); |
$regexp=~s/(\W)/\\$1/g; |
next if ($key !~ /$regexp/); |
$regexp='___'.$regexp.'___([a-z]+)$'; |
my $ctype=$1; |
while (my ($esckey,$value)=each %evaldata) { |
if (defined($cnt{$ctype})) { |
my $key=&unescape($esckey); |
$cnt{$ctype}++; |
if ($key=~/$regexp/) { |
} else { |
my ($item,$purl,$cat)=split(/___/,$key); |
$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{$esckey}; |
$sum{$ctype}+=$value; |
$concat{$cat}.=','.$item; |
} else { |
} else { |
$sum{$ctype}=$value; |
$sum{$cat}=$evaldata{$esckey}; |
} |
$concat{$cat}=$item; |
} else { |
} |
if (defined($sum{$ctype})) { |
} else { |
if ($value) { |
if (defined($sum{$cat})) { |
$sum{$ctype}.='<hr>'.$value; |
if ($evaldata{$esckey}=~/\w/) { |
} |
$sum{$cat}.='<hr>'.$evaldata{$esckey}; |
} else { |
} |
$sum{$ctype}=''.$value; |
} else { |
} |
$sum{$cat}=''.$evaldata{$esckey}; |
} |
} |
if ($ctype ne 'count') { |
} |
$newevaldata{$_}=$value; |
} |
} |
} |
} |
untie(%evaldata); |
while (my($key,$value) = each(%cnt)) { |
# transfer gathered data to returnhash, calculate averages where applicable |
if ($listitems{$key} eq 'avg') { |
while (my $cat=each(%cnt)) { |
$returnhash{$key}=int(($sum{$key}/$value)*100.0+0.5)/100.0; |
if ($cnt{$cat} eq 'nan') { next; } |
} elsif ($listitems{$key} eq 'cnt') { |
if ($sum{$cat} eq 'nan') { next; } |
$returnhash{$key}=$value; |
if ($listitems{$cat} eq 'avg') { |
} else { |
if ($cnt{$cat}) { |
$returnhash{$key}=$sum{$key}; |
$returnhash{$cat}=int(($sum{$cat}/$cnt{$cat})*100.0+0.5)/100.0; |
} |
} else { |
} |
$returnhash{$cat}='NULL'; |
if ($returnhash{'count'}) { |
} |
my $newkey=$$.'_'.time.'_searchcat___'.&escape($url).'___count'; |
} elsif ($listitems{$cat} eq 'cnt') { |
$newevaldata{$newkey}=$returnhash{'count'}; |
$returnhash{$cat}=$cnt{$cat}; |
} |
} else { |
untie(%evaldata); |
$returnhash{$cat}=$sum{$cat}; |
untie(%newevaldata); |
} |
|
$returnhash{$cat.'_list'}=$concat{$cat}; |
|
} |
|
} |
|
# get count |
|
if (tie(my %evaldata,'GDBM_File', |
|
$prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) { |
|
my $escurl=&escape($url); |
|
if (! exists($evaldata{$escurl})) { |
|
$returnhash{'count'}=0; |
|
} else { |
|
$returnhash{'count'}=$evaldata{$escurl}; |
|
} |
|
untie %evaldata; |
} |
} |
return %returnhash; |
return %returnhash; |
} |
} |
|
|
# ----------------- Code to enable 'find' subroutine listing of the .meta files |
|
require "find.pl"; |
|
sub wanted { |
|
(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && |
|
-f _ && |
|
/^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ && |
|
push(@metalist,"$dir/$_"); |
|
} |
|
|
|
# --------------- Read loncapa_apache.conf and loncapa.conf and get variables |
# --------------- Read loncapa_apache.conf and loncapa.conf and get variables |
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
my %perlvar=%{$perlvarref}; |
my %perlvar=%{$perlvarref}; |
Line 195 exit unless $perlvar{'lonRole'} eq 'libr
|
Line 245 exit unless $perlvar{'lonRole'} eq 'libr
|
|
|
my $wwwid=getpwnam('www'); |
my $wwwid=getpwnam('www'); |
if ($wwwid!=$<) { |
if ($wwwid!=$<) { |
$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
$subj="LON: $perlvar{'lonHostID'} User ID mismatch"; |
my $subj="LON: $perlvar{'lonHostID'} User ID mismatch"; |
system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\ |
system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\ |
mailto $emailto -s '$subj' > /dev/null"); |
mailto $emailto -s '$subj' > /dev/null"); |
exit 1; |
exit 1; |
Line 207 if ($wwwid!=$<) {
|
Line 257 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 265 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 (". |
|
|
# Make temporary table |
|
$dbh->do("DROP TABLE IF EXISTS newmetadata"); |
|
my $make_metadata_table = "CREATE TABLE IF NOT EXISTS newmetadata (". |
"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, ". |
"creationdate DATETIME, lastrevisiondate DATETIME, owner TEXT, ". |
"creationdate DATETIME, lastrevisiondate DATETIME, owner TEXT, ". |
"copyright TEXT, FULLTEXT idx_title (title), ". |
"copyright TEXT, ". |
|
"count INTEGER UNSIGNED, ". |
|
"course INTEGER UNSIGNED, course_list TEXT, ". |
|
"goto INTEGER UNSIGNED, goto_list TEXT, ". |
|
"comefrom INTEGER UNSIGNED, comefrom_list TEXT, ". |
|
"sequsage INTEGER UNSIGNED, sequsage_list TEXT, ". |
|
"stdno INTEGER UNSIGNED, stdno_list TEXT, ". |
|
"avetries FLOAT, avetries_list TEXT, ". |
|
"difficulty FLOAT, difficulty_list TEXT, ". |
|
"FULLTEXT idx_title (title), ". |
"FULLTEXT idx_author (author), FULLTEXT idx_subject (subject), ". |
"FULLTEXT idx_author (author), FULLTEXT idx_subject (subject), ". |
"FULLTEXT idx_url (url), FULLTEXT idx_keywords (keywords), ". |
"FULLTEXT idx_url (url), FULLTEXT idx_keywords (keywords), ". |
"FULLTEXT idx_version (version), FULLTEXT idx_notes (notes), ". |
"FULLTEXT idx_version (version), FULLTEXT idx_notes (notes), ". |
"FULLTEXT idx_abstract (abstract), FULLTEXT idx_mime (mime), ". |
"FULLTEXT idx_abstract (abstract), FULLTEXT idx_mime (mime), ". |
"FULLTEXT idx_language (language), FULLTEXT idx_owner (owner), ". |
"FULLTEXT idx_language (language), FULLTEXT idx_owner (owner), ". |
"FULLTEXT idx_copyright (copyright)) TYPE=MYISAM"; |
"FULLTEXT idx_copyright (copyright)) ". |
|
"TYPE=MyISAM"; |
# It would sure be nice to have some logging mechanism. |
# It would sure be nice to have some logging mechanism. |
$dbh->do($make_metadata_table); |
unless ($dbh->do($make_metadata_table)) { |
|
print LOG "\nMySQL Error Create: ".$dbh->errstr."\n"; |
|
die $dbh->errstr; |
|
} |
} |
} |
|
|
# ------------------------------------------------------------- get .meta files |
# ------------------------------------------------------------- get .meta files |
Line 240 closedir RESOURCES;
|
Line 309 closedir RESOURCES;
|
|
|
# |
# |
# Create the statement handlers we need |
# Create the statement handlers we need |
my $delete_sth = $dbh->prepare |
|
("DELETE FROM metadata WHERE url LIKE BINARY ?"); |
|
|
|
my $insert_sth = $dbh->prepare |
my $insert_sth = $dbh->prepare |
("INSERT INTO metadata VALUES (". |
("INSERT INTO newmetadata VALUES (". |
"?,". # title |
"?,". # title |
"?,". # author |
"?,". # author |
"?,". # subject |
"?,". # subject |
"?,". # m2??? |
"?,". # declutter url |
"?,". # version |
"?,". # version |
"?,". # current |
"?,". # current |
"?,". # notes |
"?,". # notes |
Line 258 my $insert_sth = $dbh->prepare
|
Line 325 my $insert_sth = $dbh->prepare
|
"?,". # creationdate |
"?,". # creationdate |
"?,". # revisiondate |
"?,". # revisiondate |
"?,". # owner |
"?,". # owner |
"?)" # copyright |
"?,". # copyright |
|
"?,". # count |
|
"?,". # course |
|
"?,". # course_list |
|
"?,". # goto |
|
"?,". # goto_list |
|
"?,". # comefrom |
|
"?,". # comefrom_list |
|
"?,". # usage |
|
"?,". # usage_list |
|
"?,". # stdno |
|
"?,". # stdno_list |
|
"?,". # avetries |
|
"?,". # avetries_list |
|
"?,". # difficulty |
|
"?". # difficulty_list |
|
")" |
); |
); |
|
|
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 278 foreach my $user (@homeusers) {
|
Line 360 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); |
if ($ref->{'obsolete'}) { print LOG "obsolete\n"; next; } |
$delete_sth->execute($m2); |
if ($ref->{'copyright'} eq 'private') { print LOG "private\n"; next; } |
$insert_sth->execute($ref->{'title'}, |
my %dyn=&dynamicmeta($m2); |
|
&count($m2); |
|
unless ($insert_sth->execute( |
|
$ref->{'title'}, |
$ref->{'author'}, |
$ref->{'author'}, |
$ref->{'subject'}, |
$ref->{'subject'}, |
$m2, |
$m2, |
Line 293 foreach my $user (@homeusers) {
|
Line 378 foreach my $user (@homeusers) {
|
sqltime($ref->{'creationdate'}), |
sqltime($ref->{'creationdate'}), |
sqltime($ref->{'lastrevisiondate'}), |
sqltime($ref->{'lastrevisiondate'}), |
$ref->{'owner'}, |
$ref->{'owner'}, |
$ref->{'copyright'}); |
$ref->{'copyright'}, |
# if ($dbh->err()) { |
$dyn{'count'}, |
# print STDERR "Error:".$dbh->errstr()."\n"; |
$dyn{'course'}, |
# } |
$dyn{'course_list'}, |
|
$dyn{'goto'}, |
|
$dyn{'goto_list'}, |
|
$dyn{'comefrom'}, |
|
$dyn{'comefrom_list'}, |
|
$dyn{'usage'}, |
|
$dyn{'usage_list'}, |
|
$dyn{'stdno'}, |
|
$dyn{'stdno_list'}, |
|
$dyn{'avetries'}, |
|
$dyn{'avetries_list'}, |
|
$dyn{'difficulty'}, |
|
$dyn{'difficulty_list'} |
|
)) { |
|
print LOG "\nMySQL Error Insert: ".$dbh->errstr."\n"; |
|
die $dbh->errstr; |
|
} |
$ref = undef; |
$ref = undef; |
} |
} |
|
|
# --------------------------------------------------- Clean up database |
|
# Need to, perhaps, remove stale SQL database records. |
|
# ... not yet implemented |
|
|
|
# ------------------------------------------- Copy over the new db-files |
|
system('mv '.$prodir.'/nohist_new_resevaldata.db '. |
|
$prodir.'/nohist_resevaldata.db'); |
|
} |
} |
# --------------------------------------------------- Close database connection |
# --------------------------------------------------- Close database connection |
$dbh->disconnect; |
$dbh->do("DROP TABLE IF EXISTS metadata"); |
|
unless ($dbh->do("RENAME TABLE newmetadata TO metadata")) { |
|
print LOG "\nMySQL Error Rename: ".$dbh->errstr."\n"; |
|
die $dbh->errstr; |
|
} |
|
unless ($dbh->disconnect) { |
|
print LOG "\nMySQL Error Disconnect: ".$dbh->errstr."\n"; |
|
die $dbh->errstr; |
|
} |
print LOG "\n==== Searchcat completed ".localtime()." ====\n"; |
print LOG "\n==== Searchcat completed ".localtime()." ====\n"; |
close(LOG); |
close(LOG); |
|
&writesimple(); |
|
&writecount(); |
exit 0; |
exit 0; |
|
|
|
|
Line 322 exit 0;
|
Line 425 exit 0;
|
# significantly altered from subroutine present in lonnet |
# significantly altered from subroutine present in lonnet |
sub metadata { |
sub metadata { |
my ($uri,$what)=@_; |
my ($uri,$what)=@_; |
my %metacache; |
my %metacache=(); |
$uri=&declutter($uri); |
$uri=&declutter($uri); |
my $filename=$uri; |
my $filename=$uri; |
$uri=~s/\.meta$//; |
$uri=~s/\.meta$//; |
Line 436 sub unsqltime {
|
Line 539 sub unsqltime {
|
return $timestamp; |
return $timestamp; |
} |
} |
|
|
|
# ----------------- Code to enable 'find' subroutine listing of the .meta files |
|
|
|
no strict "vars"; |
|
|
|
sub wanted { |
|
(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && |
|
-f _ && |
|
/^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ && |
|
push(@metalist,"$dir/$_"); |
|
} |