--- loncom/metadata_database/searchcat.pl 2004/04/12 21:11:45 1.57 +++ loncom/metadata_database/searchcat.pl 2006/01/27 15:53:49 1.66 @@ -2,7 +2,7 @@ # The LearningOnline Network # searchcat.pl "Search Catalog" batch script # -# $Id: searchcat.pl,v 1.57 2004/04/12 21:11:45 matthew Exp $ +# $Id: searchcat.pl,v 1.66 2006/01/27 15:53:49 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -65,10 +65,11 @@ and correct user experience. =cut use strict; - +BEGIN { + eval "use Apache2::compat();"; +}; use DBI; use lib '/home/httpd/lib/perl/'; -use LONCAPA::Configuration; use LONCAPA::lonmetadata; use Getopt::Long; @@ -77,6 +78,8 @@ use HTML::TokeParser; use GDBM_File; use POSIX qw(strftime mktime); +use Apache::lonnet(); + use File::Find; # @@ -119,30 +122,24 @@ if (defined($oneuser)) { ## ## Use variables for table names so we can test this routine a little easier my $oldname = 'metadata'; -my $newname = 'newmetadata'; +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 -exit if ($perlvar{'lonRole'} ne 'library'); +exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library'); # # Make sure this process is running from user=www my $wwwid=getpwnam('www'); if ($wwwid!=$<) { - my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; - my $subj="LON: $perlvar{'lonHostID'} User ID mismatch"; + my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}"; + my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch"; 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; } # # 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()."===="); @@ -154,7 +151,7 @@ if ($debug) { # # Connect to database 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}))) { &log(0,"Cannot connect to database!"); die "MySQL Error: Cannot connect to database!\n"; @@ -173,33 +170,39 @@ if ($dbh->err) { } # # find out which users we need to examine -my $dom = $perlvar{'lonDefDomain'}; -opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$dom"); -my @homeusers = - grep { - &ishome("$perlvar{'lonDocRoot'}/res/$dom/$_"); - } grep { - !/^\.\.?$/; - } readdir(RESOURCES); -closedir RESOURCES; -# -if ($oneuser) { - @homeusers=($oneuser); -} -# -# Loop through the users -foreach my $user (@homeusers) { - &log(0,"=== User: ".$user); - &process_dynamic_metadata($user,$dom); - # - # Use File::Find to get the files we need to read/modify - find( - {preprocess => \&only_meta_files, -# wanted => \&print_filename, -# wanted => \&log_metadata, - wanted => \&process_meta_file, - }, - "$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user"); +my @domains = sort(&Apache::lonnet::current_machine_domains()); +&log(9,'domains ="'.join('","',@domains).'"'); + +foreach my $dom (@domains) { + &log(9,'domain = '.$dom); + opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom"); + my @homeusers = + grep { + &ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_"); + } grep { + !/^\.\.?$/; + } readdir(RESOURCES); + closedir RESOURCES; + &log(5,'users = '.$dom.':'.join(',',@homeusers)); + # + if ($oneuser) { + @homeusers=($oneuser); + } + # + # Loop through the users + foreach my $user (@homeusers) { + &log(0,"=== User: ".$user); + &process_dynamic_metadata($user,$dom); + # + # Use File::Find to get the files we need to read/modify + find( + {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 @@ -212,7 +215,6 @@ if (! $simulate) { &log(1,"MySQL table rename successful."); } } - if (! $dbh->disconnect) { &log(0,"MySQL Error Disconnect: ".$dbh->errstr); die $dbh->errstr; @@ -321,8 +323,9 @@ sub process_meta_file { my $ref=&metadata($filename); # # $url is the original file url, not the metadata file - my $url='/res/'.&declutter($filename); - $url=~s/\.meta$//; + my $target = $filename; + $target =~ s/\.meta$//; + my $url='/res/'.&declutter($target); &log(3," ".$url) if ($debug); # # Ignore some files based on their metadata @@ -347,6 +350,14 @@ sub process_meta_file { &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->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'}); my %Data = ( @@ -387,7 +398,7 @@ sub metadata { if ($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)); my $parser=HTML::TokeParser->new(\$metastring); my $token; @@ -443,27 +454,30 @@ sub getfile { ######################################################## ######################################################## ## -## Dynamic metadata description +## Dynamic metadata description (incomplete) +## +## For a full description of all fields, +## see LONCAPA::lonmetadata ## ## Field Type ##----------------------------------------------------------- ## count integer ## course integer -## course_list comma seperated list of course ids +## course_list comma separated list of course ids ## avetries real -## avetries_list comma seperated list of real numbers +## avetries_list comma separated list of real numbers ## stdno real -## stdno_list comma seperated list of real numbers +## stdno_list comma separated list of real numbers ## usage integer -## usage_list comma seperated list of resources +## usage_list comma separated list of resources ## goto scalar -## goto_list comma seperated list of resources +## goto_list comma separated list of resources ## comefrom scalar -## comefrom_list comma seperated list of resources +## comefrom_list comma separated list of resources ## difficulty real -## difficulty_list comma seperated list of real numbers +## difficulty_list comma separated list of real numbers ## sequsage scalar -## sequsage_list comma seperated list of resources +## sequsage_list comma separated list of resources ## clear real ## technical real ## correct real @@ -492,6 +506,8 @@ sub process_dynamic_metadata { # %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata); untie(%evaldata); + $DynamicData{'domain'} = $dom; + #print('user = '.$user.' domain = '.$dom.$/); # # Read in the access count data &log(7,'Reading access count data') if ($debug); @@ -520,10 +536,6 @@ sub process_dynamic_metadata { sub get_dynamic_metadata { my ($url) = @_; $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, \%DynamicData); # find the count @@ -621,7 +633,7 @@ sub propath { $uname=~s/\W//g; my $subdir=$uname.'__'; $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; - my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; + my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; return $proname; } @@ -665,7 +677,7 @@ sub sqltime { ## Given a filename, returns a url for the filename. sub declutter { my $thisfn=shift; - $thisfn=~s/^$perlvar{'lonDocRoot'}//; + $thisfn=~s/^$Apache::lonnet::perlvar{'lonDocRoot'}//; $thisfn=~s/^\///; $thisfn=~s/^res\///; return $thisfn;