version 1.2, 2010/03/15 20:13:14
|
version 1.4, 2010/07/24 00:01:12
|
Line 54 use strict;
|
Line 54 use strict;
|
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use Apache::lonnet; |
use Apache::lonnet; |
use Apache::loncommon; |
use Apache::loncommon; |
|
use Apache::lonuserstate; |
|
use Apache::loncoursedata; |
|
use Apache::lonnavmaps; |
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( %needsrelease %checkparms %checkresponsetypes %checkcrstypes); |
|
|
# 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 73 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()); |
|
|
|
&parse_releases_xml(); |
|
$env{'allowed.bre'} = 'F'; |
|
|
foreach my $dom (@domains) { |
foreach my $dom (@domains) { |
my %courseshash; |
my %courseshash; |
my @ids=&Apache::lonnet::current_machine_ids(); |
my @ids=&Apache::lonnet::current_machine_ids(); |
Line 92 foreach my $dom (@domains) {
|
Line 101 foreach my $dom (@domains) {
|
} |
} |
} |
} |
|
|
|
delete($env{'allowed.bre'}); |
|
|
## Finished! |
## Finished! |
print $fh "==== refresh_courseids.db completed ".localtime()." ====\n"; |
print $fh "==== refresh_courseids.db completed ".localtime()." ====\n"; |
close($fh); |
close($fh); |
Line 140 sub recurse_courses {
|
Line 151 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 (%roleshash,$gotcc); |
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); |
$gotcc = 1; |
$gotcc = 1; |
Line 201 sub recurse_courses {
|
Line 212 sub recurse_courses {
|
} |
} |
} |
} |
} |
} |
|
|
|
$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 course contents |
|
($reqdmajor,$reqdminor) = &coursecontent_constraints($cnum,$cdom, |
|
$reqdmajor, |
|
$reqdminor); |
|
delete($env{'request.course.id'}); |
|
delete($env{'request.role'}); |
|
|
unless ($chome eq 'no_host') { |
unless ($chome eq 'no_host') { |
$courseshash->{$chome}{$cid} = { |
$courseshash->{$chome}{$cid} = { |
description => $courseinfo{'description'}, |
description => $courseinfo{'description'}, |
Line 263 sub recurse_courses {
|
Line 293 sub recurse_courses {
|
} elsif ($courseinfo{'internal.co-owners'} ne '') { |
} elsif ($courseinfo{'internal.co-owners'} ne '') { |
$courseshash->{$chome}{$cid}{'co-owners'} = $courseinfo{'internal.co-owners'}; |
$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 ne '' && $reqdminor ne '') { |
|
$courseshash->{$chome}{$cid}{'releaserequired'} = $reqdmajor.'.'.$reqdminor; |
|
} |
|
if ($courseinfo{'internal.releaserequired'} ne $reqdmajor.'.'.$reqdminor) { |
|
$changes{'internal.releaserequired'} = $reqdmajor.'.'.$reqdminor; |
|
} |
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 281 sub recurse_courses {
|
Line 328 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(/\./,$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 coursecontent_constraints { |
|
my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_; |
|
my $navmap = Apache::lonnavmaps::navmap->new(); |
|
if (defined($navmap)) { |
|
my %allresponses; |
|
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}; |
|
} |
|
} |
|
foreach my $key (keys(%allresponses)) { |
|
my ($major,$minor) = split(/\./,$checkresponsetypes{$key}); |
|
($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$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 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; |
|
} |
|
|