version 1.24, 2002/10/18 13:54:31
|
version 1.26, 2003/01/04 15:04:12
|
Line 70 sub escape {
|
Line 70 sub escape {
|
# ------------------------------------------- Code to evaluate dynamic metadata |
# ------------------------------------------- Code to evaluate dynamic metadata |
|
|
sub dynamicmeta { |
sub dynamicmeta { |
# |
|
# |
|
# Do nothing for now ... |
|
# |
|
# |
|
return; |
|
# |
|
# ..., but stuff below already works |
|
# |
|
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', |
if ((tie(%evaldata,'GDBM_File', |
$prodir.'/nohist_resevaldata.db',&GDBM_WRCREAT(),0640)) { |
$prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) && |
|
(tie(%newevaldata,'GDBM_File', |
|
$prodir.'/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) { |
my %sum=(); |
my %sum=(); |
my %cnt=(); |
my %cnt=(); |
my %listitems=('count' => 'add', |
my %listitems=('count' => 'add', |
Line 128 sub dynamicmeta {
|
Line 122 sub dynamicmeta {
|
$sum{$ctype}=''.$evaldata{$_}; |
$sum{$ctype}=''.$evaldata{$_}; |
} |
} |
} |
} |
if ($ctype eq 'count') { |
if ($ctype ne 'count') { |
delete($evaldata{$_}); |
$newevaldata{$_}=$evaldata{$_}; |
} |
} |
} |
} |
} |
} |
foreach (keys %cnt) { |
foreach (keys %cnt) { |
Line 144 sub dynamicmeta {
|
Line 138 sub dynamicmeta {
|
} |
} |
if ($returnhash{'count'}) { |
if ($returnhash{'count'}) { |
my $newkey=$$.'_'.time.'_searchcat___'.&escape($url).'___count'; |
my $newkey=$$.'_'.time.'_searchcat___'.&escape($url).'___count'; |
$evaldata{$newkey}=$returnhash{'count'}; |
$newevaldata{$newkey}=$returnhash{'count'}; |
} |
} |
untie(%evaldata); |
untie(%evaldata); |
|
untie(%newevaldata); |
} |
} |
return %returnhash; |
return %returnhash; |
} |
} |
Line 169 delete $perlvar{'lonReceipt'}; # remove
|
Line 164 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'; |
|
|
|
# ---------------------------------------------------------- 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 200 my @homeusers=grep
|
Line 199 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$//; |
Line 241 foreach my $m (@metalist) {
|
Line 247 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'); |
|
system('chown www:www '.$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 |