#!/usr/bin/perl
# The LearningOnline Network
#
# $Id: refresh_courseids_db.pl,v 1.14 2013/05/10 15:57:36 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
#################################################
=pod
=head1 NAME
refresh_courseids_db.pl
=head1 SYNOPSIS
refresh_courseids_db.pl is run on a library server and gathers
course information for each course for which the current server is
the home server. Entries (excluding last access time) for each course
in nohist_courseids.db are updated.
=head1 DESCRIPTION
refresh_courseids_db.pl will update course information, apart
from last access time, in nohist_courseids.db, using course data
from each course's environment.db file.
=cut
#################################################
use strict;
use lib '/home/httpd/lib/perl/';
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonuserstate;
use Apache::loncoursedata;
use Apache::lonnavmaps;
use LONCAPA qw(:DEFAULT :match);
exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library');
use vars qw( %checkparms %checkresponsetypes %checkcrstypes %anonsurvey %randomizetry );
# Make sure this process is running from user=www
my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
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. refresh_courseids_db.pl must be run as user www.' |\
mail -s '$subj' $emailto > /dev/null");
exit 1;
}
#
# Let people know we are running
open(my $fh,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/refreshcourseids_db.log');
print $fh "==== refresh_courseids_db.pl Run ".localtime()."====\n";
my @domains = sort(&Apache::lonnet::current_machine_domains());
my @ids=&Apache::lonnet::current_machine_ids();
&Apache::loncommon::build_release_hashes(\%checkparms,\%checkresponsetypes,
\%checkcrstypes,\%anonsurvey,\%randomizetry);
$env{'allowed.bre'} = 'F';
foreach my $dom (@domains) {
$env{'user.domain'} = $dom;
$env{'user.name'} = &Apache::lonnet::get_domainconfiguser($dom);
my %courseshash;
my %currhash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,\@ids,'.');
my %lastaccess = &Apache::lonnet::courselastaccess($dom,undef,\@ids);
my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom;
my %domdesign = &Apache::loncommon::get_domainconf($dom);
my $autoassign = $domdesign{$dom.'.autoassign.co-owners'};
&recurse_courses($dom,$dir,0,\%courseshash,\%currhash,\%lastaccess,$autoassign,$fh);
foreach my $lonhost (keys(%courseshash)) {
if (ref($courseshash{$lonhost}) eq 'HASH') {
if (&Apache::lonnet::courseidput($dom,$courseshash{$lonhost},$lonhost,'notime') eq 'ok') {
print $fh "nohist_courseids.db updated successfully for domain $dom on lonHostID $lonhost\n";
} else {
print $fh "Error occurred when updating nohist_courseids.db for domain $dom on lonHostID $lonhost\n";
}
}
}
delete($env{'user.name'};
delete($env{'user.domain'});
}
delete($env{'allowed.bre'});
## Finished!
print $fh "==== refresh_courseids.db completed ".localtime()." ====\n";
close($fh);
sub recurse_courses {
my ($cdom,$dir,$depth,$courseshash,$currhash,$lastaccess,$autoassign,$fh) = @_;
next unless (ref($currhash) eq 'HASH');
if (-d $dir) {
opendir(DIR,$dir);
my @contents = grep(!/^\./,readdir(DIR));
closedir(DIR);
$depth ++;
foreach my $item (@contents) {
if ($depth < 4) {
&recurse_courses($cdom,$dir.'/'.$item,$depth,$courseshash,
$currhash,$lastaccess,$autoassign,$fh);
} elsif ($item =~ /^$match_courseid$/) {
my $cnum = $item;
my $cid = $cdom.'_'.$cnum;
unless (ref($currhash->{$cid}) eq 'HASH') {
my $is_course = 0;
if (-e "$dir/$cnum/passwd") {
if (open(my $pwfh,"<$dir/$cnum/passwd")) {
while (<$pwfh>) {
if (/^none:/) {
$is_course = 1;
last;
}
}
}
}
next unless ($is_course);
my @stats = stat("$dir/$cnum/passwd");
print $fh "Course missing from nohist_courseids.db: $cid, created:".localtime($stats[9])."\n";
}
my %courseinfo=&Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
my %changes = ();
my $crstype = $courseinfo{'type'};
if ($crstype eq '') {
if ($cnum =~ /^$match_community$/) {
$crstype = 'Community';
} else {
$crstype = 'Course';
}
$changes{'type'} = $crstype;
}
my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
my $owner = $courseinfo{'internal.courseowner'};
my $twodaysago = time - 172800;
my (%roleshash,$gotcc,$reqdmajor,$reqdminor);
if ($owner eq '') {
%roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
$gotcc = 1;
if (keys(%roleshash) == 1) {
foreach my $key (keys(%roleshash)) {
if ($key =~ /^($match_username\:$match_domain)\:cc$/) {
$owner = $1;
$changes{'internal.courseowner'} = $owner;
}
}
}
} elsif ($owner !~ /:/) {
if ($owner =~ /^$match_username$/) {
my $ownerhome=&Apache::lonnet::homeserver($owner,$cdom);
unless (($ownerhome eq '') || ($ownerhome eq 'no_host')) {
$owner .= ':'.$cdom;
$changes{'internal.courseowner'} = $owner;
}
}
}
my $created = $courseinfo{'internal.created'};
my $creator = $courseinfo{'internal.creator'};
my $creationcontext = $courseinfo{'internal.creationcontext'};
my $inst_code = $courseinfo{'internal.coursecode'};
my $releaserequired = $courseinfo{'internal.releaserequired'};
$inst_code = '' if (!defined($inst_code));
$owner = '' if (!defined($owner));
if ($created eq '') {
if (ref($currhash->{$cid}) eq 'HASH') {
$created = $currhash->{$cid}{'created'};
$creator = $currhash->{$cid}{'creator'};
$creationcontext = $currhash->{$cid}{'context'};
unless ($created eq '') {
$changes{'internal.created'} = $created;
}
if ($creator =~ /^($LONCAPA::match_username):($LONCAPA::match_domain)$/) {
$changes{'internal.creator'} = $creator;
}
unless ($creationcontext eq '') {
$changes{'internal.creationcontext'} = $creationcontext;
}
}
if ($created eq '') {
if (-e "$dir/$cnum/passwd") {
my @stats = stat("$dir/$cnum/passwd");
$created = $stats[9];
}
if ($lastaccess->{$cid}) {
if ($created eq '') {
$created = $lastaccess->{$cid};
} elsif ($lastaccess->{$cid} < $created) {
$created = $lastaccess->{$cid};
}
}
unless ($created eq '') {
$changes{'internal.created'} = $created;
}
}
}
if (($chome ne '') && ($lastaccess->{$cid} > $twodaysago)) {
$env{'request.course.id'} = $cdom.'_'.$cnum;
$env{'request.role'} = 'cc./'.$cdom.'/'.$cnum;
&Apache::lonuserstate::readmap($cdom.'/'.$cnum);
# check all parameters
($reqdmajor,$reqdminor) = ¶meter_constraints($cnum,$cdom);
# check course type
($reqdmajor,$reqdminor) = &coursetype_constraints($cnum,$cdom,$crstype,
$reqdmajor,
$reqdminor);
# check communication blocks
($reqdmajor,$reqdminor) = &commblock_constraints($cnum,$cdom,
$reqdmajor,
$reqdminor);
# check course contents
($reqdmajor,$reqdminor) = &coursecontent_constraints($cnum,$cdom,
$reqdmajor,
$reqdminor);
delete($env{'request.course.id'});
delete($env{'request.role'});
} elsif ($releaserequired) {
($reqdmajor,$reqdminor) = split(/\./,$releaserequired);
}
unless ($chome eq 'no_host') {
if (($lastaccess->{$cid} eq '') ||
($lastaccess->{$cid} > $twodaysago)) {
my $contentchange;
if ($courseinfo{'internal.created'} eq '') {
$contentchange = &last_map_update($cnum,$cdom);
} else {
unless ($courseinfo{'internal.created'} > $lastaccess->{$cid}) {
$contentchange = &last_map_update($cnum,$cdom);
}
}
if (($contentchange) && ($contentchange > $courseinfo{'internal.contentchange'})) {
$changes{'internal.contentchange'} = $contentchange;
}
}
$courseshash->{$chome}{$cid} = {
description => $courseinfo{'description'},
inst_code => $inst_code,
owner => $owner,
type => $crstype,
};
if ($creator ne '') {
$courseshash->{$chome}{$cid}{'creator'} = $creator;
}
if ($created ne '') {
$courseshash->{$chome}{$cid}{'created'} = $created;
}
if ($creationcontext ne '') {
$courseshash->{$chome}{$cid}{'context'} = $creationcontext;
}
if (($inst_code ne '') && ($autoassign)) {
unless ($gotcc) {
%roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1);
}
my @currcoowners;
my @newcoowners;
if ($courseinfo{'internal.co-owners'} ne '') {
@currcoowners = split(',',$courseinfo{'internal.co-owners'});
}
foreach my $key (keys(%roleshash)) {
if ($key =~ /^($match_username\:$match_domain)\:cc$/) {
my $cc = $1;
unless ($cc eq $owner) {
my ($result,$desc) = &Apache::lonnet::auto_validate_instcode($cnum,$cdom,$inst_code,$cc);
if ($result eq 'valid') {
if (@newcoowners > 0) {
unless (grep(/^\Q$cc\E$/,@newcoowners)) {
push(@newcoowners,$cc);
}
} else {
push(@newcoowners,$cc);
}
}
}
}
}
my @diffs = &Apache::loncommon::compare_arrays(\@currcoowners,\@newcoowners);
if (@diffs > 0) {
if (@newcoowners > 0) {
$changes{'internal.co-owners'} = join(',',@newcoowners);
$courseshash->{$chome}{$cid}{'co-owners'} = $changes{'internal.co-owners'};
} else {
if ($courseinfo{'internal.co-owners'} ne '') {
if (&Apache::lonnet::del('environment',['internal.co-owners'],$cdom,$cnum) eq 'ok') {
print $fh "Former co-owner(s): $courseinfo{'internal.co-owners'} for official course: $inst_code (".$cdom."_".$cnum.") no longer active CCs, co-ownership status deleted.\n";
}
} else {
print $fh "Error occurred when updating co-ownership in course's environment.db for ".$cdom."_".$cnum."\n";
}
}
} elsif (@currcoowners > 0) {
$courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
}
} elsif ($courseinfo{'internal.co-owners'} ne '') {
$courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'};
}
foreach my $item ('categories','cloners','hidefromcat') {
if ($courseinfo{$item} ne '') {
$courseshash->{$chome}{$cid}{$item} = $courseinfo{$item};
}
}
foreach my $item ('selfenroll_types','selfenroll_start_date','selfenroll_end_date') {
if ($courseinfo{'internal.'.$item} ne '') {
$courseshash->{$chome}{$cid}{$item} =
$courseinfo{'internal.'.$item};
}
}
if ($reqdmajor eq '' && $reqdminor eq '') {
if ($courseinfo{'internal.releaserequired'} ne '') {
$changes{'internal.releaserequired'} = '';
}
} else {
my $releasereq = $reqdmajor.'.'.$reqdminor;
$courseshash->{$chome}{$cid}{'releaserequired'} = $releasereq;
if ($courseinfo{'internal.releaserequired'} eq '') {
$changes{'internal.releaserequired'} = $releasereq;
} else {
if ($courseinfo{'internal.releaserequired'} ne $releasereq) {
$changes{'internal.releaserequired'} = $releasereq;
}
}
}
if (keys(%changes)) {
if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') {
print $fh "Course's environment.db for ".$cdom."_".$cnum." successfully updated with following entries: ";
foreach my $key (sort(keys(%changes))) {
print $fh "$key => $changes{$key} ";
}
print $fh "\n";
} else {
print $fh "Error occurred when updating course's environment.db for ".$cdom."_".$cnum."\n";
}
}
}
}
}
}
return;
}
sub parameter_constraints {
my ($cnum,$cdom) = @_;
my ($reqdmajor,$reqdminor);
my $resourcedata=&read_paramdata($cnum,$cdom);
if (ref($resourcedata) eq 'HASH') {
foreach my $key (keys(%{$resourcedata})) {
foreach my $item (keys(%checkparms)) {
if ($key =~ /(\Q$item\E)$/) {
if (ref($checkparms{$item}) eq 'ARRAY') {
my $value = $resourcedata->{$key};
if (grep(/^\Q$value\E$/,@{$checkparms{$item}})) {
my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'parameter:'.$item.':'.$value});
($reqdmajor,$reqdminor) =
&update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
}
}
}
}
}
}
return ($reqdmajor,$reqdminor);
}
sub coursetype_constraints {
my ($cnum,$cdom,$crstype,$reqdmajor,$reqdminor) = @_;
if (defined($checkcrstypes{$crstype})) {
my ($major,$minor) = split(/\./,$checkcrstypes{$crstype});
($reqdmajor,$reqdminor) =
&update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
}
return ($reqdmajor,$reqdminor);
}
sub commblock_constraints {
my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
my %comm_blocks = &Apache::lonnet::dump('commblock',$cdom,$cnum);
my $now = time;
if (keys(%comm_blocks) > 0) {
foreach my $block (keys(%comm_blocks)) {
if ($block =~ /^firstaccess____(.+)$/) {
my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course.commblock.timer'});
($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
last;
} elsif ($block =~ /^(\d+)____(\d+)$/) {
my ($start,$end) = ($1,$2);
next if ($end < $now);
}
if (ref($comm_blocks{$block}) eq 'HASH') {
if (ref($comm_blocks{$block}{'blocks'}) eq 'HASH') {
if (ref($comm_blocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
if (keys(%{$comm_blocks{$block}{'blocks'}{'docs'}}) > 0) {
my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course.commblock.docs'});
($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
last;
}
}
}
}
}
}
return;
}
sub coursecontent_constraints {
my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
my $navmap = Apache::lonnavmaps::navmap->new();
if (defined($navmap)) {
my %anonsubmissions = &Apache::lonnet::dump('nohist_anonsurveys',
$cdom,$cnum);
my %randomizetrysubm = &Apache::lonnet::dump('nohist_randomizetry',
$cdom,$cnum);
my %allresponses;
my ($anonsurv_subm,$randbytry_subm);
foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
my %responses = $res->responseTypes();
foreach my $key (keys(%responses)) {
next unless(exists($checkresponsetypes{$key}));
$allresponses{$key} += $responses{$key};
}
my @parts = @{$res->parts()};
my $symb = $res->symb();
foreach my $part (@parts) {
if (exists($anonsubmissions{$symb."\0".$part})) {
$anonsurv_subm = 1;
}
if (exists($randomizetrysubm{$symb."\0".$part})) {
$randbytry_subm = 1;
}
}
}
foreach my $key (keys(%allresponses)) {
my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
}
if ($anonsurv_subm) {
($reqdmajor,$reqdminor) = &update_reqd_loncaparev($anonsurvey{major},
$anonsurvey{minor},$reqdmajor,$reqdminor);
}
if ($randbytry_subm) {
($reqdmajor,$reqdminor) = &update_reqd_loncaparev($randomizetry{major},
$randomizetry{minor},$reqdmajor,$reqdminor);
}
}
return ($reqdmajor,$reqdminor);
}
sub update_reqd_loncaparev {
my ($major,$minor,$reqdmajor,$reqdminor) = @_;
if (($major ne '' && $major !~ /\D/) & ($minor ne '' && $minor !~ /\D/)) {
if ($reqdmajor eq '' || $reqdminor eq '') {
$reqdmajor = $major;
$reqdminor = $minor;
} elsif (($major > $reqdmajor) ||
($major == $reqdmajor && $minor > $reqdminor)) {
$reqdmajor = $major;
$reqdminor = $minor;
}
}
return ($reqdmajor,$reqdminor);
}
sub read_paramdata {
my ($cnum,$dom)=@_;
my $resourcedata=&Apache::lonnet::get_courseresdata($cnum,$dom);
my $classlist=&Apache::loncoursedata::get_classlist();
foreach my $student (keys(%{$classlist})) {
if ($student =~/^($LONCAPA::match_username)\:($LONCAPA::match_domain)$/) {
my ($tuname,$tudom)=($1,$2);
my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
foreach my $userkey (keys(%{$useropt})) {
if ($userkey=~/^$env{'request.course.id'}/) {
my $newkey=$userkey;
$newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
$$resourcedata{$newkey}=$$useropt{$userkey};
}
}
}
}
return $resourcedata;
}
sub last_map_update {
my ($cnum,$cdom) = @_;
my $lastupdate = 0;
my $path = &LONCAPA::propath($cdom,$cnum);
if (-d "$path/userfiles") {
if (opendir(my $dirh, "$path/userfiles")) {
my @maps = grep(/^default_?\d*\.(?:sequence|page)$/,readdir($dirh));
foreach my $map (@maps) {
my $mtime = (stat("$path/userfiles/$map"))[9];
if ($mtime > $lastupdate) {
$lastupdate = $mtime;
}
}
}
}
return $lastupdate;
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>