version 1.14, 2013/05/10 15:57:36
|
version 1.24, 2023/10/02 21:01:21
|
Line 57 use Apache::loncommon;
|
Line 57 use Apache::loncommon;
|
use Apache::lonuserstate; |
use Apache::lonuserstate; |
use Apache::loncoursedata; |
use Apache::loncoursedata; |
use Apache::lonnavmaps; |
use Apache::lonnavmaps; |
|
use Apache::lonrelrequtils; |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
|
|
exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library'); |
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 |
# Make sure this process is running from user=www |
my $wwwid=getpwnam('www'); |
my $wwwid=getpwnam('www'); |
if ($wwwid!=$<) { |
if ($wwwid!=$<) { |
Line 80 print $fh "==== refresh_courseids_db.pl
|
Line 79 print $fh "==== refresh_courseids_db.pl
|
my @domains = sort(&Apache::lonnet::current_machine_domains()); |
my @domains = sort(&Apache::lonnet::current_machine_domains()); |
my @ids=&Apache::lonnet::current_machine_ids(); |
my @ids=&Apache::lonnet::current_machine_ids(); |
|
|
&Apache::loncommon::build_release_hashes(\%checkparms,\%checkresponsetypes, |
&Apache::lonrelrequtils::init_global_hashes(); |
\%checkcrstypes,\%anonsurvey,\%randomizetry); |
my $globals_set = 1; |
|
|
$env{'allowed.bre'} = 'F'; |
$env{'allowed.bre'} = 'F'; |
|
|
foreach my $dom (@domains) { |
foreach my $dom (@domains) { |
Line 103 foreach my $dom (@domains) {
|
Line 103 foreach my $dom (@domains) {
|
} |
} |
} |
} |
} |
} |
delete($env{'user.name'}; |
delete($env{'user.name'}); |
delete($env{'user.domain'}); |
delete($env{'user.domain'}); |
} |
} |
|
|
Line 122 sub recurse_courses {
|
Line 122 sub recurse_courses {
|
closedir(DIR); |
closedir(DIR); |
$depth ++; |
$depth ++; |
foreach my $item (@contents) { |
foreach my $item (@contents) { |
if ($depth < 4) { |
if (($depth < 4) && (length($item) == 1)) { |
&recurse_courses($cdom,$dir.'/'.$item,$depth,$courseshash, |
&recurse_courses($cdom,$dir.'/'.$item,$depth,$courseshash, |
$currhash,$lastaccess,$autoassign,$fh); |
$currhash,$lastaccess,$autoassign,$fh); |
} elsif ($item =~ /^$match_courseid$/) { |
} elsif ($item =~ /^$match_courseid$/) { |
Line 183 sub recurse_courses {
|
Line 183 sub recurse_courses {
|
my $creator = $courseinfo{'internal.creator'}; |
my $creator = $courseinfo{'internal.creator'}; |
my $creationcontext = $courseinfo{'internal.creationcontext'}; |
my $creationcontext = $courseinfo{'internal.creationcontext'}; |
my $inst_code = $courseinfo{'internal.coursecode'}; |
my $inst_code = $courseinfo{'internal.coursecode'}; |
|
my $xlists = $courseinfo{'internal.crosslistings'}; |
my $releaserequired = $courseinfo{'internal.releaserequired'}; |
my $releaserequired = $courseinfo{'internal.releaserequired'}; |
|
my $uniquecode = $courseinfo{'internal.uniquecode'}; |
$inst_code = '' if (!defined($inst_code)); |
$inst_code = '' if (!defined($inst_code)); |
$owner = '' if (!defined($owner)); |
$owner = '' if (!defined($owner)); |
|
$uniquecode = '' if (!defined($uniquecode)); |
if ($created eq '') { |
if ($created eq '') { |
if (ref($currhash->{$cid}) eq 'HASH') { |
if (ref($currhash->{$cid}) eq 'HASH') { |
$created = $currhash->{$cid}{'created'}; |
$created = $currhash->{$cid}{'created'}; |
Line 222 sub recurse_courses {
|
Line 225 sub recurse_courses {
|
if (($chome ne '') && ($lastaccess->{$cid} > $twodaysago)) { |
if (($chome ne '') && ($lastaccess->{$cid} > $twodaysago)) { |
$env{'request.course.id'} = $cdom.'_'.$cnum; |
$env{'request.course.id'} = $cdom.'_'.$cnum; |
$env{'request.role'} = 'cc./'.$cdom.'/'.$cnum; |
$env{'request.role'} = 'cc./'.$cdom.'/'.$cnum; |
&Apache::lonuserstate::readmap($cdom.'/'.$cnum); |
$env{'request.role.adv'} = 1; |
|
|
# check all parameters |
my $readmap = 1; |
($reqdmajor,$reqdminor) = ¶meter_constraints($cnum,$cdom); |
($reqdmajor,$reqdminor) = &Apache::lonrelrequtils::get_release_req($cnum,$cdom, |
|
$crstype,$readmap, |
# check course type |
$globals_set); |
($reqdmajor,$reqdminor) = &coursetype_constraints($cnum,$cdom,$crstype, |
delete($env{'request.role.adv'}); |
$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.course.id'}); |
delete($env{'request.role'}); |
delete($env{'request.role'}); |
} elsif ($releaserequired) { |
} elsif ($releaserequired) { |
Line 289 sub recurse_courses {
|
Line 282 sub recurse_courses {
|
my $cc = $1; |
my $cc = $1; |
unless ($cc eq $owner) { |
unless ($cc eq $owner) { |
my ($result,$desc) = &Apache::lonnet::auto_validate_instcode($cnum,$cdom,$inst_code,$cc); |
my ($result,$desc) = &Apache::lonnet::auto_validate_instcode($cnum,$cdom,$inst_code,$cc); |
|
unless ($result eq 'valid') { |
|
if ($xlists ne '') { |
|
foreach my $xlist (split(',',$xlists)) { |
|
my ($inst_crosslist,$lcsec) = split(':',$xlist); |
|
$result = |
|
&Apache::lonnet::auto_validate_inst_crosslist($cnum,$cdom,$inst_code, |
|
$inst_crosslist,$cc); |
|
last if ($result eq 'valid'); |
|
} |
|
} |
|
} |
if ($result eq 'valid') { |
if ($result eq 'valid') { |
if (@newcoowners > 0) { |
if (@newcoowners > 0) { |
unless (grep(/^\Q$cc\E$/,@newcoowners)) { |
unless (grep(/^\Q$cc\E$/,@newcoowners)) { |
push(@newcoowners,$cc); |
push(@newcoowners,$cc); |
} |
} |
} else { |
} else { |
Line 326 sub recurse_courses {
|
Line 330 sub recurse_courses {
|
$courseshash->{$chome}{$cid}{$item} = $courseinfo{$item}; |
$courseshash->{$chome}{$cid}{$item} = $courseinfo{$item}; |
} |
} |
} |
} |
foreach my $item ('selfenroll_types','selfenroll_start_date','selfenroll_end_date') { |
foreach my $item ('selfenroll_types','selfenroll_start_date','selfenroll_end_date','uniquecode') { |
if ($courseinfo{'internal.'.$item} ne '') { |
if ($courseinfo{'internal.'.$item} ne '') { |
$courseshash->{$chome}{$cid}{$item} = |
$courseshash->{$chome}{$cid}{$item} = |
$courseinfo{'internal.'.$item}; |
$courseinfo{'internal.'.$item}; |
Line 343 sub recurse_courses {
|
Line 347 sub recurse_courses {
|
$changes{'internal.releaserequired'} = $releasereq; |
$changes{'internal.releaserequired'} = $releasereq; |
} else { |
} else { |
if ($courseinfo{'internal.releaserequired'} ne $releasereq) { |
if ($courseinfo{'internal.releaserequired'} ne $releasereq) { |
|
|
$changes{'internal.releaserequired'} = $releasereq; |
$changes{'internal.releaserequired'} = $releasereq; |
} |
} |
} |
} |
} |
} |
|
my $curruserdoms = $courseinfo{'internal.userdomains'}; |
|
my $updateduserdoms = &get_unique_domains($cdom,$cnum); |
|
if ($curruserdoms ne $updateduserdoms) { |
|
$changes{'internal.userdomains'} = $updateduserdoms; |
|
} |
if (keys(%changes)) { |
if (keys(%changes)) { |
if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') { |
if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') { |
print $fh "Course's environment.db for ".$cdom."_".$cnum." successfully updated with following entries: "; |
print $fh "Course's environment.db for ".$cdom."_".$cnum." successfully updated with following entries: "; |
Line 366 sub recurse_courses {
|
Line 374 sub recurse_courses {
|
return; |
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 { |
sub last_map_update { |
my ($cnum,$cdom) = @_; |
my ($cnum,$cdom) = @_; |
my $lastupdate = 0; |
my $lastupdate = 0; |
Line 525 sub last_map_update {
|
Line 392 sub last_map_update {
|
return $lastupdate; |
return $lastupdate; |
} |
} |
|
|
|
sub get_unique_domains { |
|
my ($cdom,$cnum) = @_; |
|
my %classlist = &Apache::lonnet::dump('classlist',$cdom,$cnum); |
|
my (%uniquedom,$udomstr); |
|
foreach my $key (keys(%classlist)) { |
|
my $udom = (split(/:/,$key))[1]; |
|
$uniquedom{$udom} = 1; |
|
} |
|
my %dumphash = |
|
&Apache::lonnet::dump('nohist_userroles',$cdom,$cnum); |
|
foreach my $entry (keys(%dumphash)) { |
|
my $udom = (split(/\:/,$entry))[2]; |
|
$uniquedom{$udom} = 1; |
|
} |
|
foreach my $udom (keys(%uniquedom)) { |
|
if (&Apache::lonnet::domain($udom) eq '') { |
|
delete($uniquedom{$udom}); |
|
} |
|
} |
|
if (keys(%uniquedom) > 0) { |
|
$udomstr = join(',',sort(keys(%uniquedom))); |
|
} |
|
return $udomstr; |
|
} |
|
|