version 1.20, 2002/09/09 14:00:24
|
version 1.31, 2003/02/03 18:03:53
|
Line 26
|
Line 26
|
# |
# |
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
# YEAR=2001 |
|
# 04/14/2001, 04/16/2001 Scott Harrison |
|
# |
|
# YEAR=2002 |
|
# 05/11/2002 Scott Harrison |
|
# |
|
### |
### |
|
|
# This script goes through a LON-CAPA resource |
# This script goes through a LON-CAPA resource |
Line 44 use LONCAPA::Configuration;
|
Line 38 use LONCAPA::Configuration;
|
use IO::File; |
use IO::File; |
use HTML::TokeParser; |
use HTML::TokeParser; |
use DBI; |
use DBI; |
|
use GDBM_File; |
|
use POSIX qw(strftime mktime); |
|
|
my @metalist; |
my @metalist; |
|
|
|
|
|
# ----------------------------------------------------- Un-Escape Special Chars |
|
|
|
sub unescape { |
|
my $str=shift; |
|
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
return $str; |
|
} |
|
|
|
# -------------------------------------------------------- Escape Special Chars |
|
|
|
sub escape { |
|
my $str=shift; |
|
$str =~ s/(\W)/"%".unpack('H2',$1)/eg; |
|
return $str; |
|
} |
|
|
|
|
|
# ------------------------------------------- Code to evaluate dynamic metadata |
|
|
|
sub dynamicmeta { |
|
|
|
my $url=&declutter(shift); |
|
$url=~s/\.meta$//; |
|
my %returnhash=(); |
|
my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//); |
|
my $prodir=&propath($adomain,$aauthor); |
|
if ((tie(%evaldata,'GDBM_File', |
|
$prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) && |
|
(tie(%newevaldata,'GDBM_File', |
|
$prodir.'/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) { |
|
my %sum=(); |
|
my %cnt=(); |
|
my %listitems=('count' => 'add', |
|
'course' => 'add', |
|
'avetries' => 'avg', |
|
'stdno' => 'add', |
|
'difficulty' => 'avg', |
|
'clear' => 'avg', |
|
'technical' => 'avg', |
|
'helpful' => 'avg', |
|
'correct' => 'avg', |
|
'depth' => 'avg', |
|
'comments' => 'app', |
|
'usage' => 'cnt' |
|
); |
|
my $regexp=$url; |
|
$regexp=~s/(\W)/\\$1/g; |
|
$regexp='___'.$regexp.'___([a-z]+)$'; |
|
foreach (keys %evaldata) { |
|
my $key=&unescape($_); |
|
if ($key=~/$regexp/) { |
|
my $ctype=$1; |
|
if (defined($cnt{$ctype})) { |
|
$cnt{$ctype}++; |
|
} else { |
|
$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{$_}; |
|
} |
|
} |
|
} |
|
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 64 delete $perlvar{'lonReceipt'}; # remove
|
Line 158 delete $perlvar{'lonReceipt'}; # remove
|
# ------------------------------------- Only run if machine is a library server |
# ------------------------------------- Only run if machine is a library server |
exit unless $perlvar{'lonRole'} eq 'library'; |
exit unless $perlvar{'lonRole'} eq 'library'; |
|
|
|
# ----------------------------- Make sure this process is running from user=www |
|
|
|
my $wwwid=getpwnam('www'); |
|
if ($wwwid!=$<) { |
|
$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
|
$subj="LON: $perlvar{'lonHostID'} User ID mismatch"; |
|
system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\ |
|
mailto $emailto -s '$subj' > /dev/null"); |
|
exit 1; |
|
} |
|
|
|
|
|
# ---------------------------------------------------------- We are in business |
|
|
|
open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log'); |
|
print LOG '==== Searchcat Run '.localtime()."====\n\n"; |
my $dbh; |
my $dbh; |
# ------------------------------------- Make sure that database can be accessed |
# ------------------------------------- Make sure that database can be accessed |
{ |
{ |
unless ( |
unless ( |
$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 "Cannot connect to database!\n"; |
print LOG "Cannot connect to database!\n"; |
exit; |
exit; |
} |
} |
my $make_metadata_table = "CREATE TABLE IF NOT EXISTS metadata (". |
my $make_metadata_table = "CREATE TABLE IF NOT EXISTS metadata (". |
Line 95 my @homeusers=grep
|
Line 205 my @homeusers=grep
|
grep {!/^\.\.?$/} readdir(RESOURCES); |
grep {!/^\.\.?$/} readdir(RESOURCES); |
closedir RESOURCES; |
closedir RESOURCES; |
foreach my $user (@homeusers) { |
foreach my $user (@homeusers) { |
|
print LOG "\n=== User: ".$user."\n\n"; |
|
# Remove left-over db-files from potentially crashed searchcat run |
|
my $prodir=&propath($perlvar{'lonDefDomain'},$user); |
|
unlink($prodir.'/nohist_new_resevaldata.db'); |
|
# Use find.pl |
|
undef @metalist; |
|
@metalist=(); |
&find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user"); |
&find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user"); |
} |
|
|
|
# -- process each file to get metadata and put into search catalog SQL database |
# -- process each file to get metadata and put into search catalog SQL database |
# Also, check to see if already there. |
# Also, check to see if already there. |
# I could just delete (without searching first), but this works for now. |
# I could just delete (without searching first), but this works for now. |
foreach my $m (@metalist) { |
foreach my $m (@metalist) { |
|
print LOG "- ".$m."\n"; |
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); |
my $q2="select * from metadata where url like binary '$m2'"; |
my $q2="select * from metadata where url like binary '$m2'"; |
my $sth = $dbh->prepare($q2); |
my $sth = $dbh->prepare($q2); |
$sth->execute(); |
$sth->execute(); |
Line 135 foreach my $m (@metalist) {
|
Line 253 foreach my $m (@metalist) {
|
# 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 |
|
system('mv '.$prodir.'/nohist_new_resevaldata.db '. |
|
$prodir.'/nohist_resevaldata.db'); |
|
} |
# --------------------------------------------------- Close database connection |
# --------------------------------------------------- Close database connection |
$dbh->disconnect; |
$dbh->disconnect; |
|
print LOG "\n==== Searchcat completed ".localtime()." ====\n"; |
|
close(LOG); |
|
exit 0; |
|
# ============================================================================= |
|
|
# ---------------------------------------------------------------- Get metadata |
# ---------------------------------------------------------------- Get metadata |
# significantly altered from subroutine present in lonnet |
# significantly altered from subroutine present in lonnet |
Line 230 sub propath {
|
Line 357 sub propath {
|
# ---------------------------- convert 'time' format into a datetime sql format |
# ---------------------------- convert 'time' format into a datetime sql format |
sub sqltime { |
sub sqltime { |
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = |
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = |
localtime(@_[0]); |
localtime(&unsqltime(@_[0])); |
$mon++; $year+=1900; |
$mon++; $year+=1900; |
return "$year-$mon-$mday $hour:$min:$sec"; |
return "$year-$mon-$mday $hour:$min:$sec"; |
} |
} |
|
|
|
sub maketime { |
|
my %th=@_; |
|
return POSIX::mktime( |
|
($th{'seconds'},$th{'minutes'},$th{'hours'}, |
|
$th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'})); |
|
} |
|
|
|
|
|
######################################### |
|
# |
|
# Retro-fixing of un-backward-compatible time format |
|
|
|
sub unsqltime { |
|
my $timestamp=shift; |
|
if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) { |
|
$timestamp=&maketime( |
|
'year'=>$1,'month'=>$2,'day'=>$3, |
|
'hours'=>$4,'minutes'=>$5,'seconds'=>$6); |
|
} |
|
return $timestamp; |
|
} |
|
|