version 1.4, 2010/07/24 00:01:12
|
version 1.5, 2010/07/29 17:44:45
|
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 ); |
|
|
# 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 79 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()); |
|
|
&parse_releases_xml(); |
&build_release_hashes(); |
$env{'allowed.bre'} = 'F'; |
$env{'allowed.bre'} = 'F'; |
|
|
foreach my $dom (@domains) { |
foreach my $dom (@domains) { |
Line 339 sub parameter_constraints {
|
Line 339 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 365 sub coursecontent_constraints {
|
Line 365 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 %resourcetracker = &Apache::lonnet::dump('nohist_resourcetracker', |
|
$cdom,$cnum); |
my %allresponses; |
my %allresponses; |
|
my $anonsurv_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($resourcetracker{$symb."\0".$part."\0anonymous"})) { |
|
$anonsurv_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); |
|
} |
} |
} |
return ($reqdmajor,$reqdminor); |
return ($reqdmajor,$reqdminor); |
} |
} |
Line 416 sub read_paramdata {
|
Line 430 sub read_paramdata {
|
return $resourcedata; |
return $resourcedata; |
} |
} |
|
|
sub parse_releases_xml { |
sub build_release_hashes { |
my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml'; |
foreach my $key (keys(%Apache::lonnet::needsrelease)) { |
if (-e $file) { |
my ($item,$name,$value) = split(/:/,$key); |
my $parser = HTML::LCParser->new($file); |
if ($item eq 'parameter') { |
while (my $token = $parser->get_token()) { |
if (ref($checkparms{$name}) eq 'ARRAY') { |
if ($token->[0] eq 'S') { |
unless(grep(/^\Q$name\E$/,@{$checkparms{$name}})) { |
my $item = $token->[1]; |
push(@{$checkparms{$name}},$value); |
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; |
|
} |
|
} |
|
} |
} |
|
} else { |
|
push(@{$checkparms{$name}},$value); |
|
} |
|
} elsif ($item eq 'resourcetag') { |
|
if ($name eq 'responsetype') { |
|
$checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key} |
|
} |
|
} elsif ($item eq 'course') { |
|
if ($name eq 'crstype') { |
|
$checkcrstypes{$value} = $Apache::lonnet::needsrelease{$key}; |
} |
} |
} |
} |
} |
} |
|
($anonsurvey{major},$anonsurvey{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'}); |
return; |
return; |
} |
} |
|
|