version 1.4, 2010/07/24 00:01:12
|
version 1.11, 2012/03/31 22:10:16
|
Line 61 use LONCAPA qw(:DEFAULT :match);
|
Line 61 use LONCAPA qw(:DEFAULT :match);
|
|
|
exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library'); |
exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library'); |
|
|
use vars qw( %needsrelease %checkparms %checkresponsetypes %checkcrstypes); |
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'); |
Line 78 open(my $fh,'>>'.$Apache::lonnet::perlva
|
Line 78 open(my $fh,'>>'.$Apache::lonnet::perlva
|
print $fh "==== refresh_courseids_db.pl Run ".localtime()."====\n"; |
print $fh "==== refresh_courseids_db.pl Run ".localtime()."====\n"; |
|
|
my @domains = sort(&Apache::lonnet::current_machine_domains()); |
my @domains = sort(&Apache::lonnet::current_machine_domains()); |
|
my @ids=&Apache::lonnet::current_machine_ids(); |
|
|
&parse_releases_xml(); |
&Apache::loncommon::build_release_hashes(\%checkparms,\%checkresponsetypes, |
|
\%checkcrstypes,\%anonsurvey,\%randomizetry); |
$env{'allowed.bre'} = 'F'; |
$env{'allowed.bre'} = 'F'; |
|
|
foreach my $dom (@domains) { |
foreach my $dom (@domains) { |
my %courseshash; |
my %courseshash; |
my @ids=&Apache::lonnet::current_machine_ids(); |
|
my %currhash = &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,\@ids,'.'); |
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 $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom; |
my %domdesign = &Apache::loncommon::get_domainconf($dom); |
my %domdesign = &Apache::loncommon::get_domainconf($dom); |
my $autoassign = $domdesign{$dom.'.autoassign.co-owners'}; |
my $autoassign = $domdesign{$dom.'.autoassign.co-owners'}; |
&recurse_courses($dom,$dir,0,\%courseshash,\%currhash,$autoassign,$fh); |
&recurse_courses($dom,$dir,0,\%courseshash,\%currhash,\%lastaccess,$autoassign,$fh); |
foreach my $lonhost (keys(%courseshash)) { |
foreach my $lonhost (keys(%courseshash)) { |
if (ref($courseshash{$lonhost}) eq 'HASH') { |
if (ref($courseshash{$lonhost}) eq 'HASH') { |
if (&Apache::lonnet::courseidput($dom,$courseshash{$lonhost},$lonhost,'notime') eq 'ok') { |
if (&Apache::lonnet::courseidput($dom,$courseshash{$lonhost},$lonhost,'notime') eq 'ok') { |
Line 108 print $fh "==== refresh_courseids.db com
|
Line 110 print $fh "==== refresh_courseids.db com
|
close($fh); |
close($fh); |
|
|
sub recurse_courses { |
sub recurse_courses { |
my ($cdom,$dir,$depth,$courseshash,$currhash,$autoassign,$fh) = @_; |
my ($cdom,$dir,$depth,$courseshash,$currhash,$lastaccess,$autoassign,$fh) = @_; |
next unless (ref($currhash) eq 'HASH'); |
next unless (ref($currhash) eq 'HASH'); |
if (-d $dir) { |
if (-d $dir) { |
opendir(DIR,$dir); |
opendir(DIR,$dir); |
Line 118 sub recurse_courses {
|
Line 120 sub recurse_courses {
|
foreach my $item (@contents) { |
foreach my $item (@contents) { |
if ($depth < 4) { |
if ($depth < 4) { |
&recurse_courses($cdom,$dir.'/'.$item,$depth,$courseshash, |
&recurse_courses($cdom,$dir.'/'.$item,$depth,$courseshash, |
$currhash,$autoassign,$fh); |
$currhash,$lastaccess,$autoassign,$fh); |
} elsif ($item =~ /^$match_courseid$/) { |
} elsif ($item =~ /^$match_courseid$/) { |
my $cnum = $item; |
my $cnum = $item; |
my $cid = $cdom.'_'.$cnum; |
my $cid = $cdom.'_'.$cnum; |
Line 151 sub recurse_courses {
|
Line 153 sub recurse_courses {
|
} |
} |
my $chome = &Apache::lonnet::homeserver($cnum,$cdom); |
my $chome = &Apache::lonnet::homeserver($cnum,$cdom); |
my $owner = $courseinfo{'internal.courseowner'}; |
my $owner = $courseinfo{'internal.courseowner'}; |
|
my $twodaysago = time - 172800; |
my (%roleshash,$gotcc,$reqdmajor,$reqdminor); |
my (%roleshash,$gotcc,$reqdmajor,$reqdminor); |
if ($owner eq '') { |
if ($owner eq '') { |
%roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1); |
%roleshash = &Apache::lonnet::get_my_roles($cnum,$cdom,undef,undef,['cc'],undef,undef,1); |
Line 176 sub recurse_courses {
|
Line 179 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 $releaserequired = $courseinfo{'internal.releaserequired'}; |
$inst_code = '' if (!defined($inst_code)); |
$inst_code = '' if (!defined($inst_code)); |
$owner = '' if (!defined($owner)); |
$owner = '' if (!defined($owner)); |
if ($created eq '') { |
if ($created eq '') { |
Line 198 sub recurse_courses {
|
Line 202 sub recurse_courses {
|
my @stats = stat("$dir/$cnum/passwd"); |
my @stats = stat("$dir/$cnum/passwd"); |
$created = $stats[9]; |
$created = $stats[9]; |
} |
} |
my %lastaccess = |
if ($lastaccess->{$cid}) { |
&Apache::lonnet::courselastaccess($cdom,$cnum); |
|
if ($lastaccess{$cid}) { |
|
if ($created eq '') { |
if ($created eq '') { |
$created = $lastaccess{$cid}; |
$created = $lastaccess->{$cid}; |
} elsif ($lastaccess{$cid} < $created) { |
} elsif ($lastaccess->{$cid} < $created) { |
$created = $lastaccess{$cid}; |
$created = $lastaccess->{$cid}; |
} |
} |
} |
} |
unless ($created eq '') { |
unless ($created eq '') { |
Line 212 sub recurse_courses {
|
Line 214 sub recurse_courses {
|
} |
} |
} |
} |
} |
} |
|
|
$env{'request.course.id'} = $cdom.'_'.$cnum; |
if (($chome ne '') && ($lastaccess->{$cid} > $twodaysago)) { |
$env{'request.role'} = 'cc./'.$cdom.'/'.$cnum; |
$env{'request.course.id'} = $cdom.'_'.$cnum; |
&Apache::lonuserstate::readmap($cdom.'/'.$cnum); |
$env{'request.role'} = 'cc./'.$cdom.'/'.$cnum; |
|
&Apache::lonuserstate::readmap($cdom.'/'.$cnum); |
# check all parameters |
|
($reqdmajor,$reqdminor) = ¶meter_constraints($cnum,$cdom); |
# check all parameters |
|
($reqdmajor,$reqdminor) = ¶meter_constraints($cnum,$cdom); |
# check course type |
|
($reqdmajor,$reqdminor) = &coursetype_constraints($cnum,$cdom,$crstype, |
# check course type |
$reqdmajor, |
($reqdmajor,$reqdminor) = &coursetype_constraints($cnum,$cdom,$crstype, |
$reqdminor); |
$reqdmajor, |
# check course contents |
$reqdminor); |
($reqdmajor,$reqdminor) = &coursecontent_constraints($cnum,$cdom, |
# check communication blocks |
|
($reqdmajor,$reqdminor) = &commblock_constraints($cnum,$cdom, |
$reqdmajor, |
$reqdmajor, |
$reqdminor); |
$reqdminor); |
delete($env{'request.course.id'}); |
# check course contents |
delete($env{'request.role'}); |
($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') { |
unless ($chome eq 'no_host') { |
$courseshash->{$chome}{$cid} = { |
$courseshash->{$chome}{$cid} = { |
Line 304 sub recurse_courses {
|
Line 314 sub recurse_courses {
|
$courseinfo{'internal.'.$item}; |
$courseinfo{'internal.'.$item}; |
} |
} |
} |
} |
if ($reqdmajor ne '' && $reqdminor ne '') { |
if ($reqdmajor eq '' && $reqdminor eq '') { |
$courseshash->{$chome}{$cid}{'releaserequired'} = $reqdmajor.'.'.$reqdminor; |
if ($courseinfo{'internal.releaserequired'} ne '') { |
} |
$changes{'internal.releaserequired'} = ''; |
if ($courseinfo{'internal.releaserequired'} ne $reqdmajor.'.'.$reqdminor) { |
} |
$changes{'internal.releaserequired'} = $reqdmajor.'.'.$reqdminor; |
} 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 (keys(%changes)) { |
if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') { |
if (&Apache::lonnet::put('environment',\%changes,$cdom,$cnum) eq 'ok') { |
Line 339 sub parameter_constraints {
|
Line 359 sub parameter_constraints {
|
if (ref($checkparms{$item}) eq 'ARRAY') { |
if (ref($checkparms{$item}) eq 'ARRAY') { |
my $value = $resourcedata->{$key}; |
my $value = $resourcedata->{$key}; |
if (grep(/^\Q$value\E$/,@{$checkparms{$item}})) { |
if (grep(/^\Q$value\E$/,@{$checkparms{$item}})) { |
my ($major,$minor) = split(/\./,$needsrelease{'parameter'}{$item}{$value}); |
my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'parameter:'.$item.':'.$value}); |
($reqdmajor,$reqdminor) = |
($reqdmajor,$reqdminor) = |
&update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor); |
&update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor); |
} |
} |
Line 361 sub coursetype_constraints {
|
Line 381 sub coursetype_constraints {
|
return ($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 { |
sub coursecontent_constraints { |
my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_; |
my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_; |
my $navmap = Apache::lonnavmaps::navmap->new(); |
my $navmap = Apache::lonnavmaps::navmap->new(); |
if (defined($navmap)) { |
if (defined($navmap)) { |
|
my %anonsubmissions = &Apache::lonnet::dump('nohist_anonsurveys', |
|
$cdom,$cnum); |
|
my %randomizetrysubm = &Apache::lonnet::dump('nohist_randomizetry', |
|
$cdom,$cnum); |
my %allresponses; |
my %allresponses; |
|
my ($anonsurv_subm,$randbytry_subm); |
foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) { |
foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) { |
my %responses = $res->responseTypes(); |
my %responses = $res->responseTypes(); |
foreach my $key (keys(%responses)) { |
foreach my $key (keys(%responses)) { |
next unless(exists($checkresponsetypes{$key})); |
next unless(exists($checkresponsetypes{$key})); |
$allresponses{$key} += $responses{$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)) { |
foreach my $key (keys(%allresponses)) { |
my ($major,$minor) = split(/\./,$checkresponsetypes{$key}); |
my ($major,$minor) = split(/\./,$checkresponsetypes{$key}); |
($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor); |
($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); |
return ($reqdmajor,$reqdminor); |
} |
} |
Line 416 sub read_paramdata {
|
Line 489 sub read_paramdata {
|
return $resourcedata; |
return $resourcedata; |
} |
} |
|
|
sub parse_releases_xml { |
|
my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml'; |
|
if (-e $file) { |
|
my $parser = HTML::LCParser->new($file); |
|
while (my $token = $parser->get_token()) { |
|
if ($token->[0] eq 'S') { |
|
my $item = $token->[1]; |
|
my $name = $token->[2]{'name'}; |
|
my $value = $token->[2]{'value'}; |
|
if ($item ne '' && $name ne '' && $value ne '') { |
|
my $release = $parser->get_text(); |
|
$release =~ s/(^\s*|\s*$ )//gx; |
|
$needsrelease{$item}{$name}{$value} = $release; |
|
if ($item eq 'parameter') { |
|
if (ref($checkparms{$name}) eq 'ARRAY') { |
|
unless(grep(/^\Q$name\E$/,@{$checkparms{$name}})) { |
|
push(@{$checkparms{$name}},$value); |
|
} |
|
} else { |
|
push(@{$checkparms{$name}},$value); |
|
} |
|
} elsif ($item eq 'resourcetag') { |
|
if ($name eq 'responsetype') { |
|
$checkresponsetypes{$value} = $release; |
|
} |
|
} elsif ($item eq 'course') { |
|
if ($name eq 'crstype') { |
|
$checkcrstypes{$value} = $release; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
return; |
|
} |
|
|
|