version 1.60, 2004/08/30 14:31:42
|
version 1.66, 2006/01/27 15:53:49
|
Line 65 and correct user experience.
|
Line 65 and correct user experience.
|
=cut |
=cut |
|
|
use strict; |
use strict; |
|
BEGIN { |
|
eval "use Apache2::compat();"; |
|
}; |
use DBI; |
use DBI; |
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use LONCAPA::Configuration; |
|
use LONCAPA::lonmetadata; |
use LONCAPA::lonmetadata; |
|
|
use Getopt::Long; |
use Getopt::Long; |
Line 77 use HTML::TokeParser;
|
Line 78 use HTML::TokeParser;
|
use GDBM_File; |
use GDBM_File; |
use POSIX qw(strftime mktime); |
use POSIX qw(strftime mktime); |
|
|
|
use Apache::lonnet(); |
|
|
use File::Find; |
use File::Find; |
|
|
# |
# |
Line 122 my $oldname = 'metadata';
|
Line 125 my $oldname = 'metadata';
|
my $newname = 'newmetadata'.$$; # append pid to have unique temporary table |
my $newname = 'newmetadata'.$$; # append pid to have unique temporary table |
|
|
# |
# |
# Read loncapa_apache.conf and loncapa.conf |
|
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
|
my %perlvar=%{$perlvarref}; |
|
undef $perlvarref; |
|
delete $perlvar{'lonReceipt'}; # remove since sensitive (really?) & not needed |
|
# |
|
# Only run if machine is a library server |
# Only run if machine is a library server |
exit if ($perlvar{'lonRole'} ne 'library'); |
exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library'); |
# |
# |
# Make sure this process is running from user=www |
# Make sure this process is running from user=www |
my $wwwid=getpwnam('www'); |
my $wwwid=getpwnam('www'); |
if ($wwwid!=$<) { |
if ($wwwid!=$<) { |
my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}"; |
my $subj="LON: $perlvar{'lonHostID'} User ID mismatch"; |
my $subj="LON: $Apache::lonnet::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"); |
mail -s '$subj' $emailto > /dev/null"); |
exit 1; |
exit 1; |
} |
} |
# |
# |
# Let people know we are running |
# Let people know we are running |
open(LOG,'>>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log'); |
open(LOG,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/searchcat.log'); |
&log(0,'==== Searchcat Run '.localtime()."===="); |
&log(0,'==== Searchcat Run '.localtime()."===="); |
|
|
|
|
Line 154 if ($debug) {
|
Line 151 if ($debug) {
|
# |
# |
# Connect to database |
# Connect to database |
my $dbh; |
my $dbh; |
if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'}, |
if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$Apache::lonnet::perlvar{'lonSqlAccess'}, |
{ RaiseError =>0,PrintError=>0}))) { |
{ RaiseError =>0,PrintError=>0}))) { |
&log(0,"Cannot connect to database!"); |
&log(0,"Cannot connect to database!"); |
die "MySQL Error: Cannot connect to database!\n"; |
die "MySQL Error: Cannot connect to database!\n"; |
Line 173 if ($dbh->err) {
|
Line 170 if ($dbh->err) {
|
} |
} |
# |
# |
# find out which users we need to examine |
# find out which users we need to examine |
my $dom = $perlvar{'lonDefDomain'}; |
my @domains = sort(&Apache::lonnet::current_machine_domains()); |
opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$dom"); |
&log(9,'domains ="'.join('","',@domains).'"'); |
my @homeusers = |
|
grep { |
foreach my $dom (@domains) { |
&ishome("$perlvar{'lonDocRoot'}/res/$dom/$_"); |
&log(9,'domain = '.$dom); |
} grep { |
opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom"); |
!/^\.\.?$/; |
my @homeusers = |
} readdir(RESOURCES); |
grep { |
closedir RESOURCES; |
&ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_"); |
# |
} grep { |
if ($oneuser) { |
!/^\.\.?$/; |
@homeusers=($oneuser); |
} readdir(RESOURCES); |
} |
closedir RESOURCES; |
# |
&log(5,'users = '.$dom.':'.join(',',@homeusers)); |
# Loop through the users |
# |
foreach my $user (@homeusers) { |
if ($oneuser) { |
&log(0,"=== User: ".$user); |
@homeusers=($oneuser); |
&process_dynamic_metadata($user,$dom); |
} |
# |
# |
# Use File::Find to get the files we need to read/modify |
# Loop through the users |
find( |
foreach my $user (@homeusers) { |
{preprocess => \&only_meta_files, |
&log(0,"=== User: ".$user); |
# wanted => \&print_filename, |
&process_dynamic_metadata($user,$dom); |
# wanted => \&log_metadata, |
# |
wanted => \&process_meta_file, |
# Use File::Find to get the files we need to read/modify |
}, |
find( |
"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user"); |
{preprocess => \&only_meta_files, |
|
#wanted => \&print_filename, |
|
#wanted => \&log_metadata, |
|
wanted => \&process_meta_file, |
|
no_chdir => 1, |
|
}, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) ); |
|
} |
} |
} |
# |
# |
# Rename the table |
# Rename the table |
Line 212 if (! $simulate) {
|
Line 215 if (! $simulate) {
|
&log(1,"MySQL table rename successful."); |
&log(1,"MySQL table rename successful."); |
} |
} |
} |
} |
|
|
if (! $dbh->disconnect) { |
if (! $dbh->disconnect) { |
&log(0,"MySQL Error Disconnect: ".$dbh->errstr); |
&log(0,"MySQL Error Disconnect: ".$dbh->errstr); |
die $dbh->errstr; |
die $dbh->errstr; |
Line 321 sub process_meta_file {
|
Line 323 sub process_meta_file {
|
my $ref=&metadata($filename); |
my $ref=&metadata($filename); |
# |
# |
# $url is the original file url, not the metadata file |
# $url is the original file url, not the metadata file |
my $url='/res/'.&declutter($filename); |
my $target = $filename; |
$url=~s/\.meta$//; |
$target =~ s/\.meta$//; |
|
my $url='/res/'.&declutter($target); |
&log(3," ".$url) if ($debug); |
&log(3," ".$url) if ($debug); |
# |
# |
# Ignore some files based on their metadata |
# Ignore some files based on their metadata |
Line 347 sub process_meta_file {
|
Line 350 sub process_meta_file {
|
&count_type($url); |
&count_type($url); |
} |
} |
# |
# |
|
if (! defined($ref->{'creationdate'}) || |
|
$ref->{'creationdate'} =~ /^\s*$/) { |
|
$ref->{'creationdate'} = (stat($target))[9]; |
|
} |
|
if (! defined($ref->{'lastrevisiondate'}) || |
|
$ref->{'lastrevisiondate'} =~ /^\s*$/) { |
|
$ref->{'lastrevisiondate'} = (stat($target))[9]; |
|
} |
$ref->{'creationdate'} = &sqltime($ref->{'creationdate'}); |
$ref->{'creationdate'} = &sqltime($ref->{'creationdate'}); |
$ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'}); |
$ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'}); |
my %Data = ( |
my %Data = ( |
Line 387 sub metadata {
|
Line 398 sub metadata {
|
if ($filename !~ /\.meta$/) { |
if ($filename !~ /\.meta$/) { |
$filename.='.meta'; |
$filename.='.meta'; |
} |
} |
my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename); |
my $metastring=&getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$filename); |
return undef if (! defined($metastring)); |
return undef if (! defined($metastring)); |
my $parser=HTML::TokeParser->new(\$metastring); |
my $parser=HTML::TokeParser->new(\$metastring); |
my $token; |
my $token; |
Line 495 sub process_dynamic_metadata {
|
Line 506 sub process_dynamic_metadata {
|
# |
# |
%DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata); |
%DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata); |
untie(%evaldata); |
untie(%evaldata); |
|
$DynamicData{'domain'} = $dom; |
|
#print('user = '.$user.' domain = '.$dom.$/); |
# |
# |
# Read in the access count data |
# Read in the access count data |
&log(7,'Reading access count data') if ($debug); |
&log(7,'Reading access count data') if ($debug); |
Line 523 sub process_dynamic_metadata {
|
Line 536 sub process_dynamic_metadata {
|
sub get_dynamic_metadata { |
sub get_dynamic_metadata { |
my ($url) = @_; |
my ($url) = @_; |
$url =~ s:^/res/::; |
$url =~ s:^/res/::; |
if (! exists($DynamicData{$url})) { |
|
&log(7,' No dynamic data for '.$url) if ($debug); |
|
return (); |
|
} |
|
my %data = &LONCAPA::lonmetadata::process_dynamic_metadata($url, |
my %data = &LONCAPA::lonmetadata::process_dynamic_metadata($url, |
\%DynamicData); |
\%DynamicData); |
# find the count |
# find the count |
Line 624 sub propath {
|
Line 633 sub propath {
|
$uname=~s/\W//g; |
$uname=~s/\W//g; |
my $subdir=$uname.'__'; |
my $subdir=$uname.'__'; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
return $proname; |
return $proname; |
} |
} |
|
|
Line 668 sub sqltime {
|
Line 677 sub sqltime {
|
## Given a filename, returns a url for the filename. |
## Given a filename, returns a url for the filename. |
sub declutter { |
sub declutter { |
my $thisfn=shift; |
my $thisfn=shift; |
$thisfn=~s/^$perlvar{'lonDocRoot'}//; |
$thisfn=~s/^$Apache::lonnet::perlvar{'lonDocRoot'}//; |
$thisfn=~s/^\///; |
$thisfn=~s/^\///; |
$thisfn=~s/^res\///; |
$thisfn=~s/^res\///; |
return $thisfn; |
return $thisfn; |