version 1.62, 2005/03/11 03:25:18
|
version 1.63, 2005/03/21 20:36:11
|
Line 68 use strict;
|
Line 68 use strict;
|
|
|
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 76 use HTML::TokeParser;
|
use GDBM_File; |
use GDBM_File; |
use POSIX qw(strftime mktime); |
use POSIX qw(strftime mktime); |
|
|
use Sys::Hostname; |
use Apache::lonnet(); |
|
|
use File::Find; |
use File::Find; |
|
|
# |
# |
# Set up configuration options |
# Set up configuration options |
my ($simulate,$oneuser,$help,$verbose,$logfile,$debug,$multidom); |
my ($simulate,$oneuser,$help,$verbose,$logfile,$debug); |
GetOptions ( |
GetOptions ( |
'help' => \$help, |
'help' => \$help, |
'simulate' => \$simulate, |
'simulate' => \$simulate, |
'only=s' => \$oneuser, |
'only=s' => \$oneuser, |
'verbose=s' => \$verbose, |
'verbose=s' => \$verbose, |
'debug' => \$debug, |
'debug' => \$debug, |
'multi_domain' => \$multidom, |
|
); |
); |
|
|
if ($help) { |
if ($help) { |
Line 103 Options:
|
Line 101 Options:
|
-only=user Only compute for the given user. Implies -simulate |
-only=user Only compute for the given user. Implies -simulate |
-verbose=val Sets logging level, val must be a number |
-verbose=val Sets logging level, val must be a number |
-debug Turns on debugging output |
-debug Turns on debugging output |
-multi_domain Parse the hosts.tab file domain(s) to use. |
|
ENDHELP |
ENDHELP |
exit 0; |
exit 0; |
} |
} |
Line 126 my $oldname = 'metadata';
|
Line 123 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 158 if ($debug) {
|
Line 149 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 177 if ($dbh->err) {
|
Line 168 if ($dbh->err) {
|
} |
} |
# |
# |
# find out which users we need to examine |
# find out which users we need to examine |
my @domains; |
my @domains = sort(&Apache::lonnet::current_machine_domains()); |
if (defined($multidom)) { |
&log(9,'domains ="'.join('","',@domains).'"'); |
&log(1,'====multi domain setup===='); |
|
# Peek into the hosts.tab and look for matches of our hostname |
|
my $host = hostname(); |
|
&log(9,'hostname = "'.$host.'"'); |
|
open(HOSTFILE,$perlvar{'lonTabDir'}.'/hosts.tab') || |
|
die ("Unable to determine domain(s) of multi-domain server"); |
|
my %domains; |
|
while (<HOSTFILE>) { |
|
next if (/^\#/); |
|
next if (!/:\Q$host\E/); |
|
&log(9,$_); |
|
$domains{(split(':',$_))[1]}++; |
|
} |
|
close HOSTFILE; |
|
@domains = sort(keys(%domains)); |
|
&log(9,join(',',@domains)); |
|
if (! scalar(@domains)) { |
|
die ("Unable to find any domains in the hosts.tab that match ".$host); |
|
} |
|
} else { |
|
push(@domains,$perlvar{'lonDefDomain'}); |
|
} |
|
|
|
foreach my $dom (@domains) { |
foreach my $dom (@domains) { |
&log(9,'domain = '.$dom); |
&log(9,'domain = '.$dom); |
opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$dom"); |
opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom"); |
my @homeusers = |
my @homeusers = |
grep { |
grep { |
&ishome("$perlvar{'lonDocRoot'}/res/$dom/$_"); |
&ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_"); |
} grep { |
} grep { |
!/^\.\.?$/; |
!/^\.\.?$/; |
} readdir(RESOURCES); |
} readdir(RESOURCES); |
Line 229 foreach my $dom (@domains) {
|
Line 198 foreach my $dom (@domains) {
|
#wanted => \&print_filename, |
#wanted => \&print_filename, |
#wanted => \&log_metadata, |
#wanted => \&log_metadata, |
wanted => \&process_meta_file, |
wanted => \&process_meta_file, |
}, join('/',($perlvar{'lonDocRoot'},'res',$dom,$user)) ); |
}, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) ); |
} |
} |
} |
} |
# |
# |
Line 426 sub metadata {
|
Line 395 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 661 sub propath {
|
Line 630 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 705 sub sqltime {
|
Line 674 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; |