[LON-CAPA-cvs] cvs: loncom /interface courseprefs.pm lonblockingmenu.pm loncommon.pm lonrelrequtils.pm /misc refresh_courseids_db.pl doc/loncapafiles loncapafiles.lpml
raeburn
raeburn at source.lon-capa.org
Sat Jun 7 15:13:52 EDT 2014
raeburn Sat Jun 7 19:13:52 2014 EDT
Added files:
/loncom/interface lonrelrequtils.pm
Modified files:
/loncom/interface courseprefs.pm lonblockingmenu.pm loncommon.pm
/doc/loncapafiles loncapafiles.lpml
/loncom/misc refresh_courseids_db.pl
Log:
- Routines moved from refresh_courseids_db.pl to lonrelrequtils.pm
to facilitate re-use: parameter_constraints(), coursetype_constraints(),
commblock_constraints(), coursecontent_constraints(), read_paramdata(),
update_reqd_loncaparev().
- Clean-up handler phase for lonblockingmenu.pm and courseprefs.pm
(query string contains phase=releaseinfo) includes call to update
LON-CAPA version requirement in course's environment.db and course's
record in domain's nohost_courseids.db
- Display of details for LON-CAPA version requirement in course now
includes any requirements based on blocking (timer trigger, printout
or content access).
-------------- next part --------------
Index: loncom/interface/courseprefs.pm
diff -u loncom/interface/courseprefs.pm:1.65 loncom/interface/courseprefs.pm:1.66
--- loncom/interface/courseprefs.pm:1.65 Fri May 16 17:13:31 2014
+++ loncom/interface/courseprefs.pm Sat Jun 7 19:13:41 2014
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set configuration settings for a course
#
-# $Id: courseprefs.pm,v 1.65 2014/05/16 17:13:31 raeburn Exp $
+# $Id: courseprefs.pm,v 1.66 2014/06/07 19:13:41 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -215,10 +215,14 @@
use Apache::loncommon();
use Apache::lonhtmlcommon();
use Apache::lonconfigsettings;
+use Apache::lonrelrequtils;
use Apache::lonparmset;
use Apache::lonlocal;
use LONCAPA qw(:DEFAULT :match);
+my $registered_cleanup;
+my $modified_courses;
+
sub handler {
my $r=shift;
if ($r->header_only) {
@@ -228,7 +232,7 @@
}
my $context = 'course';
my $cid = $env{'request.course.id'};
- my ($cnum,$cdom) = &get_course($cid);
+ my ($cnum,$cdom,$chome) = &get_course($cid);
my $crstype = &Apache::loncommon::course_type();
my $parm_permission = &Apache::lonnet::allowed('opa',$cid);
my $navmap = Apache::lonnavmaps::navmap->new();
@@ -257,6 +261,9 @@
return HTTP_NOT_ACCEPTABLE;
}
+ $registered_cleanup=0;
+ @{$modified_courses}=();
+
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['phase','actions','origin']);
&Apache::lonhtmlcommon::clear_breadcrumbs();
@@ -344,7 +351,14 @@
if ($phase eq 'releaseinfo') {
my $loncaparev = $env{'course.'.$cid.'.internal.releaserequired'};
if ($loncaparev) {
- &display_loncaparev_constraints($r,$navmap,$loncaparev,$crstype);
+ if (&display_loncaparev_constraints($r,$navmap,$loncaparev,$crstype)) {
+ push(@{$modified_courses},[$cdom,$cnum,$chome,$crstype]);
+ unless ($registered_cleanup) {
+ my $handlers = $r->get_handlers('PerlCleanupHandler');
+ $r->set_handlers('PerlCleanupHandler' => [\&update_releasereq,@{$handlers}]);
+ $registered_cleanup=1;
+ }
+ }
return OK;
}
}
@@ -1663,7 +1677,8 @@
}
my $cdom=$env{'course.'.$courseid.'.domain'};
my $cnum=$env{'course.'.$courseid.'.num'};
- return ($cnum,$cdom);
+ my $chome=$env{'course.'.$courseid.'.home'};
+ return ($cnum,$cdom,$chome);
}
sub get_jscript {
@@ -2285,6 +2300,7 @@
sub display_loncaparev_constraints {
my ($r,$navmap,$loncaparev,$crstype) = @_;
+ my ($reqdmajor,$reqdminor);
my $cid = $env{'request.course.id'};
my $cdom = $env{'course.'.$cid.'.domain'};
my $cnum = $env{'course.'.$cid.'.num'};
@@ -2294,22 +2310,21 @@
'section/group' => 'section/group',
'user' => 'user',
);
- my (%checkparms,%checkresponsetypes,%checkcrstypes,%anonsurvey,%randomizetry);
- &Apache::loncommon::build_release_hashes(\%checkparms,\%checkresponsetypes,
- \%checkcrstypes,\%anonsurvey,\%randomizetry);
- if (defined($checkcrstypes{$crstype})) {
+ &Apache::lonrelrequtils::init_global_hashes();
+ if (defined($Apache::lonrelrequtils::checkcrstypes{$crstype})) {
+ ($reqdmajor,$reqdminor) = split(/\./,$Apache::lonrelrequtils::checkcrstypes{$crstype});
$output .= '<h4>'.&mt('Course type: [_1] requires [_2] or newer',$crstype,
- $checkcrstypes{$crstype}).'</h4>';
+ $Apache::lonrelrequtils::checkcrstypes{$crstype}).'</h4>';
}
my (%fromparam,%rowspan,%bymap,%byresource, at scopeorder,%toshow,%allmaps,
- %byresponsetype,%bysubmission);
+ %byresponsetype,%bysubmission,%fromblocks);
@scopeorder = ('all','section/group','user');
my $resourcedata = &Apache::lonparmset::readdata($cnum,$cdom);
if (ref($resourcedata) eq 'HASH') {
foreach my $key (keys(%{$resourcedata})) {
- foreach my $item (keys(%checkparms)) {
+ foreach my $item (keys(%Apache::lonrelrequtils::checkparms)) {
if ($key =~ /(\Q$item\E)$/) {
- if (ref($checkparms{$item}) eq 'ARRAY') {
+ if (ref($Apache::lonrelrequtils::checkparms{$item}) eq 'ARRAY') {
my $value = $resourcedata->{$key};
if ($item eq 'examcode') {
if (&Apache::lonnet::validCODE($value)) {
@@ -2319,7 +2334,7 @@
}
}
my ($middle,$scope,$which,$level,$map,$resource);
- if (grep(/^\Q$value\E$/,@{$checkparms{$item}})) {
+ if (grep(/^\Q$value\E$/,@{$Apache::lonrelrequtils::checkparms{$item}})) {
my $stdtype = &Apache::lonparmset::standard_parameter_types($item);
my $stdname = &Apache::lonparmset::standard_parameter_names($item);
my $valname = &get_param_description($stdtype,$value);
@@ -2411,6 +2426,9 @@
'<th>'.&mt('Extent').'</th><th>'.&mt('Setting').'</th>'.
&Apache::loncommon::end_data_table_header_row();
foreach my $rev (keys(%fromparam)) {
+ my ($major,$minor) = split(/\./,$rev);
+ ($reqdmajor,$reqdminor) =
+ &Apache::lonrelrequtils::update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
$output .= &Apache::loncommon::start_data_table_row().
'<td rowspan="'.$rowspan{$rev}.'">'.$rev.'</td>';
my $newrow;
@@ -2441,6 +2459,75 @@
}
}
+ my %comm_blocks = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
+ my $now = time;
+ if (keys(%comm_blocks) > 0) {
+ foreach my $block (keys(%comm_blocks)) {
+ if ($block =~ /^firstaccess____(.+)$/) {
+ my $rev = $Apache::lonnet::needsrelease{'course:commblock:timer'};
+ if (ref($comm_blocks{$block}) eq 'HASH') {
+ push(@{$fromblocks{'timer'}{$rev}},&unescape($comm_blocks{$block}{'event'}).
+ ' '.&mt('set by [_1]',
+ &Apache::loncommon::plainname(split(/:/,$comm_blocks{$block}{'setter'}))));
+ }
+ next;
+ } 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 $rev = $Apache::lonnet::needsrelease{'course:commblock:docs'};
+ push(@{$fromblocks{'docs'}{$rev}},&unescape($comm_blocks{$block}{'event'}).
+ ' '.
+ &mt('set by [_1]',
+ &Apache::loncommon::plainname(split(/:/,$comm_blocks{$block}{'setter'}))));
+ }
+ } elsif ($comm_blocks{$block}{'blocks'}{'printout'} eq 'on') {
+ my $rev = $Apache::lonnet::needsrelease{'course:commblock:printout'};
+ push(@{$fromblocks{'printout'}{$rev}},&unescape($comm_blocks{$block}{'event'}).
+ ' '.
+ &mt('set by [_1]',
+ &Apache::loncommon::plainname(split(/:/,$comm_blocks{$block}{'setter'}))));
+
+ }
+ }
+ }
+ }
+ if (keys(%fromblocks)) {
+ my %lt = (
+ docs => 'Content blocking',
+ printout => 'Printout generation',
+ timer => 'Timed quiz trigger',
+ );
+ $output .= '<h4>'.&mt('Requirements from exam blocking').'</h4>'.
+ &Apache::loncommon::start_data_table().
+ &Apache::loncommon::start_data_table_header_row().
+ '<th>'.&mt('Release').'</th><th>'.&mt('Setting').'</th>'.
+ '<th>'.&mt('Event(s)').'</th>'.
+ &Apache::loncommon::end_data_table_header_row();
+ foreach my $type ('docs','printout','timer') {
+ if (ref($fromblocks{$type}) eq 'HASH') {
+ foreach my $rev (keys(%{$fromblocks{$type}})) {
+ my ($major,$minor) = split(/\./,$rev);
+ ($reqdmajor,$reqdminor) =
+ &Apache::lonrelrequtils::update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
+ $output .= &Apache::loncommon::start_data_table_row().
+ '<td>'.$rev.'</td><td>'.$lt{$type}.'</td><td>';
+ foreach my $event (sort(@{$fromblocks{$type}{$rev}})) {
+ $output .= $event.'<br />';
+ }
+ $output =~ s{\Q<br />\E$}{};
+ $output .= '</td>'.&Apache::loncommon::end_data_table_row();
+ }
+ }
+ }
+ $output .= &Apache::loncommon::end_data_table().'<br />';
+ }
+ }
+
if (defined($navmap)) {
my %anonsubms=&Apache::lonnet::dump('nohist_anonsurveys',$cdom,$cnum);
my $rev_anonsurv=$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'};
@@ -2450,7 +2537,7 @@
my $stdname=&Apache::lonparmset::standard_parameter_names('type');
my $valanon=&get_param_description($stdtype,'anonsurvey');
my $valrandtry=&get_param_description($stdtype,'randomizetry');
-
+ my %checkedrev;
foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
my @parts = @{$res->parts()};
my $symb = $res->symb();
@@ -2467,6 +2554,13 @@
push(@{$bysubmission{$symb}{$rev}},$what);
}
$allmaps{$enclosing_map} = 1;
+ unless ($checkedrev{'anonsurvey'}) {
+ my ($major,$minor) = split(/\./,$rev);
+ ($reqdmajor,$reqdminor) =
+ &Apache::lonrelrequtils::update_reqd_loncaparev($major,$minor,
+ $reqdmajor,$reqdminor);
+ $checkedrev{'anonsurvey'} = 1;
+ }
}
if (exists($randtrysubms{$symb."\0".$part})) {
my $rev = $rev_randtry;
@@ -2479,12 +2573,27 @@
push(@{$bysubmission{$symb}{$rev}},$what);
}
$allmaps{$enclosing_map} = 1;
+ unless ($checkedrev{'randomizetry'}) {
+ my ($major,$minor) = split(/\./,$rev);
+ ($reqdmajor,$reqdminor) =
+ &Apache::lonrelrequtils::update_reqd_loncaparev($major,$minor,
+ $reqdmajor,$reqdminor);
+ $checkedrev{'randomizetry'} = 1;
+ }
}
}
my %responses = $res->responseTypes();
foreach my $key (keys(%responses)) {
- if (exists($checkresponsetypes{$key})) {
- push(@{$byresponsetype{$symb}{$checkresponsetypes{$key}}},$key);
+ if (exists($Apache::lonrelrequtils::checkresponsetypes{$key})) {
+ my $rev = $Apache::lonrelrequtils::checkresponsetypes{$key};
+ unless ($checkedrev{$key}) {
+ my ($major,$minor) = split(/\./,$rev);
+ ($reqdmajor,$reqdminor) =
+ &Apache::lonrelrequtils::update_reqd_loncaparev($major,$minor,
+ $reqdmajor,$reqdminor);
+ $checkedrev{$key} = 1;
+ }
+ push(@{$byresponsetype{$symb}{$rev}},$key);
$allmaps{$enclosing_map} = 1;
}
}
@@ -2545,6 +2654,10 @@
'</p>');
}
$r->print(&Apache::loncommon::end_page());
+ my ($currmajor,$currminor) = split(/\./,$loncaparev);
+ if (($currmajor != $reqdmajor) || ($currminor != $reqdminor)) {
+ return 1;
+ }
return;
}
@@ -2686,6 +2799,7 @@
}
$r->print(&Apache::loncommon::end_data_table());
}
+ return;
}
sub releases_by_map {
@@ -2739,6 +2853,24 @@
return $name;
}
+sub update_releasereq {
+ my $readmap = 1;
+ my $getrelreq = 1;
+ if (ref($modified_courses) eq 'ARRAY') {
+ foreach my $item (@{$modified_courses}) {
+ if (ref($item) eq 'ARRAY') {
+ my ($cdom,$cnum,$chome,$crstype) = @{$item};
+ &Apache::lonrelrequtils::modify_course_relreq(undef,undef,$cnum,$cdom,
+ $chome,$crstype,$cdom.'_'.$cnum,
+ $readmap,$getrelreq);
+ }
+ }
+ $modified_courses = [];
+ }
+ undef($registered_cleanup);
+ return;
+}
+
sub show_autocoowners {
my (@currcoown) = @_;
my $output = '<i><span class="LC_nobreak">'.&mt('Co-ownership is set automatically when a Course Coordinator role[_1] is assigned to official course personnel (from institutional data).','</span><br /><span class="LC_nobreak">').'</span></i>';
Index: loncom/interface/lonblockingmenu.pm
diff -u loncom/interface/lonblockingmenu.pm:1.11 loncom/interface/lonblockingmenu.pm:1.12
--- loncom/interface/lonblockingmenu.pm:1.11 Fri Feb 28 19:20:05 2014
+++ loncom/interface/lonblockingmenu.pm Sat Jun 7 19:13:42 2014
@@ -2,7 +2,7 @@
# Routines for configuring blocking of access to collaborative functions,
# and specific resources during an exam
#
-# $Id: lonblockingmenu.pm,v 1.11 2014/02/28 19:20:05 bisitz Exp $
+# $Id: lonblockingmenu.pm,v 1.12 2014/06/07 19:13:42 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -57,6 +57,9 @@
(b) those which a student could use to access materials prepared by the
student in advance of an exam, (e.g., for use during an online exam, to
gain an unfair advantage). Blogs and portfolio fall into this category.
+(c) those which a student could use to display or save content within
+the course itself (outside the exam folder). Printouts and resources
+fall into this category.
For communication blocking to be truly effective in preventing unwanted
communication, or access to online materials, online testing needs to
@@ -64,7 +67,7 @@
of web sites beyond LON-CAPA are unavailable.
Access to specified folder(s) and/or resources in the course contents
-can also be restricted for the duration of an exam.
+can be restricted for the duration of an exam.
Exam blocks are of two types:
(a) Blocks with a defined start and end date.
@@ -124,11 +127,15 @@
Stores changes to exam blocks in comm_block.db file for course.
Processes deletions, modifications and additions.
-Inputs: 2
+Inputs: 4
+ $r = request object
+
$crstype - Container type: Course or Community.
$blockcount - Total number of blocking events in course.
+ $currblockrecs - Ref to hash of current blocks in course.
+
Outputs: 2
$changestotal - Total number of changes made.
@@ -160,7 +167,7 @@
=item &get_block_choices()
Extract information from web form about which communication/
-collaboration features are to be blocked, for a partilcuar event,
+collaboration features are to be blocked, for a particular event,
and also which content areas will have access blocked for the
duration of the block.
@@ -184,12 +191,30 @@
(content) or blocking type (triggered by student starting timer)
require specific LON-CAPA version (i.e., 2.11).
-Inputs: 1 - type of constraint (currently: 'docs' or 'timer').
+Inputs: 3 - $value - type of constraint (currently: 'docs', 'printout' or 'timer'),
+ $chomemajor - course's home server LON-CAPA major version number.
+ $chomeminor - course's home server LON-CAPA minor version number.
-Outputs: None
+Outputs: 2 - status ('ok' or 'fail') and LON-CAPA version needed.
+
+=over
+
+ A status of 'fail' will be returned if the
+ LON-CAPA version installed on the course's
+ home server is older than the version
+ requirement for the blocking type.
+ For a trigger type event, the requested
+ blocking event will not be added if
+ the course's home server version is old to
+ support that type of block.
+
+=back
Side Effects: &update_released_required() called in lonnet, if
- needed to update version requirements for course.
+ course's home server version is requied version or
+ newer; will update version requirements for course to
+ a more recent version requirement than currently in
+ effect.
=item &display_blocker_status()
@@ -337,7 +362,8 @@
Create Javascript used to launch pop-up used for content selection, and to
toggle visibility of a number of expandable/collapsible divs.
-Inputs: 1 - $blockcount -
+Inputs: 1 - $blockcount - Total number of blocks in course's comm_block.db
+ database file.
Output: 1 - Javascript (with <script></script> tags) for functions used to:
(a) launch pop-up window for selection of course content to which
@@ -373,6 +399,9 @@
use lib '/home/httpd/lib/perl/';
use LONCAPA qw(:DEFAULT :match);
+my $registered_cleanup;
+my $modified_courses;
+
sub handler {
my $r=shift;
@@ -403,6 +432,9 @@
# -----------------------------Get action and calling context from query string
+ $registered_cleanup=0;
+ @{$modified_courses}=();
+
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['action','caller','block']);
@@ -449,7 +481,7 @@
# -------------------------- Store changes and retrieve latest block information
my $storeresult;
if ($env{'form.action'} eq 'store') {
- (my $numchanges,$storeresult) = &blockstore($crstype,$blockcount);
+ (my $numchanges,$storeresult) = &blockstore($r,$crstype,$blockcount,\%records);
if ($numchanges > 0) {
$blockcount = &get_blockdates(\%records);
}
@@ -629,7 +661,7 @@
}
sub blockstore {
- my ($crstype,$blockcount) = @_;
+ my ($r,$crstype,$blockcount,$currblockrecs) = @_;
my %lt=&Apache::lonlocal::texthash(
'tfcm' => 'The following changes were made',
'ncwm' => 'No changes were made.',
@@ -671,16 +703,42 @@
return ($changestotal,$output);
}
&Apache::loncourserespicker::enumerate_course_contents($navmap,\%map_url,\%resource_symb,\%titles,'examblock');
+ my $do_releasereq_update;
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
+ my $chostname = &Apache::lonnet::hostname($chome);
+ my ($chomemajor,$chomeminor) =
+ split(/\./,&Apache::lonnet::get_server_loncaparev($cdom,$chome));
+
+
foreach my $key (keys(%removals)) {
my $hashkey = $env{'form.key_'.$key};
- &Apache::lonnet::del('comm_block',["$hashkey"],
- $env{'course.'.$env{'request.course.id'}.'.domain'},
- $env{'course.'.$env{'request.course.id'}.'.num'}
- );
+ if ($hashkey =~ /firstaccess____/) {
+ $do_releasereq_update = 1;
+ }
+ if (ref($currblockrecs->{$hashkey}) eq 'HASH') {
+ if (ref($currblockrecs->{$hashkey}->{'blocks'}) eq 'HASH') {
+ foreach my $type ('docs','printout') {
+ if (exists($currblockrecs->{$hashkey}->{'blocks'}->{$type})) {
+ $do_releasereq_update = 1;
+ }
+ }
+ }
+ }
+ &Apache::lonnet::del('comm_block',["$hashkey"],$cdom,$cnum);
+ }
+ if ($do_releasereq_update) {
+ push(@{$modified_courses},[$cdom,$cnum,$chome,$crstype]);
+ unless ($registered_cleanup) {
+ my $handlers = $r->get_handlers('PerlCleanupHandler');
+ $r->set_handlers('PerlCleanupHandler' => [\&update_releasereq,@{$handlers}]);
+ $registered_cleanup=1;
+ }
}
foreach my $key (keys(%adds)) {
unless ( defined($cancels{$key}) ) {
- my $newkey;
+ my ($newkey,$status,$needsrelease);;
if ($env{'form.firstaccess_'.$key}) {
my $interval =
&HTML::Entities::decode($env{'form.firstaccess_'.$key});
@@ -698,7 +756,13 @@
}
if ($newkey ne '') {
unless (defined($removals{$key})) {
- $addtimer ++;
+ ($status,$needsrelease) = &check_release_required('timer',$chomemajor,$chomeminor);
+ if ($status eq 'fail') {
+ $newkey = '';
+ $output .= '<p class="LC_warning">'.
+ &mt('Triggering of blocking events not allowed for [_1]',
+ &escape($env{'form.title_'.$key})).'<br />';
+ }
}
}
}
@@ -706,22 +770,38 @@
my ($newstart,$newend) = &get_dates_from_form($key);
$newkey = $newstart.'____'.$newend;
}
+ if ($status eq 'fail') {
+ $output .= &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
+ $chomemajor.'.'.$chomeminor,$chostname,$needsrelease).'</p>';
+ }
if ($newkey ne '') {
my ($blocktypes,$blockdocs) =
&get_block_choices($key,\%map_url,\%resource_symb);
+ if (ref($blocktypes) eq 'HASH') {
+ if ($blocktypes->{'printout'} eq 'on') {
+ ($status,$needsrelease) = &check_release_required('printout',$chomemajor,$chomeminor);
+ if ($status eq 'fail') {
+ $blocktypes->{'printout'} = 'off';
+ $output .= '<p class="LC_warning">'.
+ &mt('Printout blocking not allowed for [_1]',
+ &escape($env{'form.title_'.$key})).'<br />';
+ }
+ }
+ }
+ if ($blockdocs) {
+ ($status,$needsrelease) = &check_release_required('docs',$chomemajor,$chomeminor);
+ if ($status eq 'fail') {
+ delete($blocktypes->{'docs'});
+ $output .= '<p class="LC_warning">'.
+ &mt('Content blocking not allowed for [_1]',
+ &escape($env{'form.title_'.$key})).'<br />';
+ }
+ }
$blocking{$newkey} = {
setter => $env{'user.name'}.':'.$env{'user.domain'},
event => &escape($env{'form.title_'.$key}),
blocks => $blocktypes,
};
- if ($blockdocs) {
- &check_release_required('docs');
- }
- if (ref($blocktypes) eq 'HASH') {
- if ($blocktypes->{'printout'} eq 'on') {
- &check_release_required('printout');
- }
- }
if (exists($removals{$key})) {
$modtotal ++;
} else {
@@ -729,9 +809,11 @@
}
} else {
if ($env{'form.toggle_'.$key} eq 'timer') {
- $output .= '<p class="LC_warning">'.
- &mt('Invalid trigger for new blocking event').
- '</p>';
+ unless ($status eq 'fail') {
+ $output .= '<p class="LC_warning">'.
+ &mt('Invalid trigger for new blocking event').
+ '</p>';
+ }
} else {
$output .= '<p class="LC_warning">'.
&mt('No date range found for new blocking event').
@@ -745,9 +827,6 @@
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'}
);
- if ($addtimer) {
- &check_release_required('timer');
- }
}
$changestotal = $canceltotal + $modtotal + $addtotal;
if ($changestotal > 0) {
@@ -780,6 +859,24 @@
return ($changestotal,$output);
}
+sub update_releasereq {
+ my $readmap = 1;
+ my $getrelreq = 1;
+ if (ref($modified_courses) eq 'ARRAY') {
+ foreach my $item (@{$modified_courses}) {
+ if (ref($item) eq 'ARRAY') {
+ my ($cdom,$cnum,$chome,$crstype) = @{$item};
+ &Apache::lonrelrequtils::modify_course_relreq(undef,undef,$cnum,$cdom,
+ $chome,$crstype,$cdom.'_'.$cnum,
+ $readmap,$getrelreq);
+ }
+ }
+ $modified_courses = [];
+ }
+ undef($registered_cleanup);
+ return;
+}
+
sub get_dates_from_form {
my $item = shift;
my $startdate = &Apache::lonhtmlcommon::get_date_from_form('startdate_'.$item);
@@ -846,10 +943,15 @@
}
sub check_release_required {
- my ($value) = @_;
+ my ($value,$chomemajor,$chomeminor) = @_;
my $needsrelease = $Apache::lonnet::needsrelease{'course:commblock:'.$value};
if ($needsrelease) {
- my $curr_required =
+ my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
+ if (($chomemajor < $needsmajor) ||
+ (($chomemajor == $needsmajor) && ($chomeminor < $needsminor))) {
+ return ('fail',$needsrelease);
+ }
+ my $curr_required =
$env{'course.'.$env{'request.course.id'}.'.internal.releaserequired'};
if ($curr_required eq '') {
&Apache::lonnet::update_released_required($needsrelease);
@@ -862,7 +964,7 @@
}
}
}
- return;
+ return ('ok',$needsrelease);
}
sub display_blocker_status {
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1191 loncom/interface/loncommon.pm:1.1192
--- loncom/interface/loncommon.pm:1.1191 Thu May 22 11:08:32 2014
+++ loncom/interface/loncommon.pm Sat Jun 7 19:13:42 2014
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1191 2014/05/22 11:08:32 raeburn Exp $
+# $Id: loncommon.pm,v 1.1192 2014/06/07 19:13:42 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -15228,36 +15228,6 @@
=cut
-sub build_release_hashes {
- my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
- return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
- (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
- (ref($randomizetry) eq 'HASH'));
- foreach my $key (keys(%Apache::lonnet::needsrelease)) {
- my ($item,$name,$value) = split(/:/,$key);
- 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} = $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'});
- ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
- return;
-}
-
sub update_content_constraints {
my ($cdom,$cnum,$chome,$cid) = @_;
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.892 doc/loncapafiles/loncapafiles.lpml:1.893
--- doc/loncapafiles/loncapafiles.lpml:1.892 Wed May 21 18:29:32 2014
+++ doc/loncapafiles/loncapafiles.lpml Sat Jun 7 19:13:46 2014
@@ -2,7 +2,7 @@
"http://lpml.sourceforge.net/DTD/lpml.dtd">
<!-- loncapafiles.lpml -->
-<!-- $Id: loncapafiles.lpml,v 1.892 2014/05/21 18:29:32 bisitz Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.893 2014/06/07 19:13:46 raeburn Exp $ -->
<!--
@@ -8369,6 +8369,15 @@
<status>works/unverified</status>
</file>
<file>
+<source>loncom/interface/lonrelrequtils.pm</source>
+<target dist='default'>home/httpd/lib/perl/Apache/lonrelrequtils.pm</target>
+<categoryname>handler</categoryname>
+<description>
+Utilities to update information about LON-CAPA version requirements
+in a course.</description>
+<status>works/unverified</status>
+</file>
+<file>
<source>loncom/automation/Autocreate.pl</source>Autocreate.pl
<target dist='default'>home/httpd/perl/Autocreate.pl</target>
<categoryname>script</categoryname>
Index: loncom/misc/refresh_courseids_db.pl
diff -u loncom/misc/refresh_courseids_db.pl:1.18 loncom/misc/refresh_courseids_db.pl:1.19
--- loncom/misc/refresh_courseids_db.pl:1.18 Sat Jun 7 03:07:06 2014
+++ loncom/misc/refresh_courseids_db.pl Sat Jun 7 19:13:51 2014
@@ -1,7 +1,7 @@
#!/usr/bin/perl
# The LearningOnline Network
#
-# $Id: refresh_courseids_db.pl,v 1.18 2014/06/07 03:07:06 raeburn Exp $
+# $Id: refresh_courseids_db.pl,v 1.19 2014/06/07 19:13:51 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -57,12 +57,11 @@
use Apache::lonuserstate;
use Apache::loncoursedata;
use Apache::lonnavmaps;
+use Apache::lonrelrequtils;
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!=$<) {
@@ -80,8 +79,9 @@
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);
+&Apache::lonrelrequtils::init_global_hashes();
+my $globals_set = 1;
+
$env{'allowed.bre'} = 'F';
foreach my $dom (@domains) {
@@ -224,23 +224,11 @@
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);
+ my $readmap = 1;
+ ($reqdmajor,$reqdminor) = &Apache::lonrelrequtils::get_release_req($cnum,$cdom,
+ $crstype,$readmap,
+ $globals_set);
delete($env{'request.course.id'});
delete($env{'request.role'});
} elsif ($releaserequired) {
@@ -368,154 +356,6 @@
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 ($item eq 'examcode') {
- if (&Apache::lonnet::validCODE($value)) {
- $value = 'valid';
- } else {
- $value = '';
- }
- }
- 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('comm_block',$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;
Index: loncom/interface/lonrelrequtils.pm
+++ loncom/interface/lonrelrequtils.pm
#!/usr/bin/perl
# The LearningOnline Network
#
# $Id: lonrelrequtils.pm,v 1.1 2014/06/07 19:13:42 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
lonrelrequtils.pm
=head1 SYNOPSIS
Contains utilities used to determine the LON-CAPA version
requirement in a course, based on course type, parameters,
responsetypes, and communication blocking events.
=head1 DESCRIPTION
lonrelrequtilities.pm includes a main subroutine:
get_release_req() which will return the current major
version and minor version requirement (if it exists).
=head1 SUBROUTINES
=over
=item &init_global_hashes()
Initializes package hashes containing version requirements for
parameters, responsetypes, course types, anonsurvey
parameter, and randomizetry parameter.
=item &get_release_req()
Returns current major version and minor version requirements for a course,
based on: coursetype, parameters in use, responsetypes in use in course
content, and communication blocking features in use in blocks with end dates
in the future, or in blocks triggered by activation of a timer in a timed quiz.
Inputs: 5
=over
=item $cnum - course "number"
=item $cdom - course domain
=item $crstype - course type: Community or Course
=item $readmap - boolean; if true, read course's top level map, and any
included maps recursively.
=item $globals_set - boolean: if false, call init_global_hashes
=back
=item ¶meter_constraints()
Returns major version and minor version requirements for a course,
based on parameters in use in the course. (Parameters which have
version requirements are listed in /home/httpd/lonTabs/releaseslist.xml
Inputs: 2
=over
=item $cnum - course "number"
=item $cdom - course domain
=back
=item &coursetype_constraints()
Returns major version and minor version requirements for a course,
taking into account course type (Community or Course).
Inputs: 5
=over
=item $cnum - course "number"
=item $cdom - course domain
=item $crstype - course type: Community or Course
=item $reqdmajor - major version requirements based on constraints
considered so far (parameters).
=item $reqdminor - minor version requirements based on constraints
considered so far (parameters).
=back
=item &commblock_constraints()
Returns major version and minor version requirements for a course,
taking into account use of communication blocking (blocks for
printouts, specified folders/resources, and/or triggering of block
by a student starting a timed quiz.
Inputs: 4
=over
=item $cnum - course "number"
=item $cdom - course domain
=item $reqdmajor - major version requirements based on constraints
considered so far (parameters and course type).
=item $reqdminor - minor version requirements based on constraints
considered so far (parameters and course type).
=back
=item &coursecontent_constraints()
Returns major version and minor version requirements for a course,
taking into responsetypes in use in published assessment items
imported into a course.
Inputs: 4
=over
=item $cnum - course "number"
=item $cdom - course domain
=item $reqdmajor - major version requirements based on constraints
considered so far (parameters, course type, blocks).
=item $reqdminor - minor version requirements based on constraints
considered so far (parameters, course type, blocks).
=back
=item &update_reqd_loncaparev()
Returns major version and minor version requirements for a course,
taking into account new constraint type.
Inputs: 4
=over
=item $major - major version requirements from new constraint type
=item $minor - minor version requirements from new constraint type
=item $reqdmajor - major version requirements from constraints
considered so far.
=item $reqdminor - minor version requirements from constraints
considered so far.
=back
=item &read_paramdata()
Returns a reference to a hash populated with parameter settings in a
course (set both generally, and for specific students).
Inputs: 2
=over
=item $cnum - course "number"
=item $cdom - course domain
=back
=item &modify_course_relreq()
Updates course's minimum version requirement (internal.releaserequired) in
course's environment.db, and in user's current session, and in course's
record in nohist_courseids.db on course's home server. This can include
deleting an existing version requirement, downgrading to an earlier version,
or updating to a newer version.
Note: if the current server's LON-CAPA version is older than the course's
current version requirement, and a downgrade to an earlier version is being
proposed, the change will NOT be made, because of the possibility that the
current server has not checked for an attribute only available with a more
recent version of LON-CAPA.
Inputs: 9
=over
=item $newmajor - (optional) major version requirements
=item $newminor - (optional) minor version requirements
=item $cnum - course "number"
=item $cdom - course domain
=item $chome - lonHostID of course's home server
=item $crstype - course type: Community or Course
=item $cid - course ID
=item $readmap - boolean; if true, read course's top level map, and any
included maps recursively.
=item $getrelreq - boolean; if true, call &get_release_req() to
return the current major version and minor version requirements.
(needed if optional args: $newmajor and $newminor are not passed).
=back
=back
=cut
#################################################
package Apache::lonrelrequtils;
use strict;
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonuserstate();
use Apache::loncoursedata();
use Apache::lonnavmaps();
use LONCAPA qw(:DEFAULT :match);
sub init_global_hashes {
%Apache::lonrelrequtils::checkparms = ();
%Apache::lonrelrequtils::checkresponsetypes = ();
%Apache::lonrelrequtils::checkcrstypes = ();
%Apache::lonrelrequtils::anonsurvey = ();
%Apache::lonrelrequtils::randomizetry = ();
foreach my $key (keys(%Apache::lonnet::needsrelease)) {
my ($item,$name,$value) = split(/:/,$key);
if ($item eq 'parameter') {
if (ref($Apache::lonrelrequtils::checkparms{$name}) eq 'ARRAY') {
unless(grep(/^\Q$name\E$/,@{$Apache::lonrelrequtils::checkparms{$name}})) {
push(@{$Apache::lonrelrequtils::checkparms{$name}},$value);
}
} else {
push(@{$Apache::lonrelrequtils::checkparms{$name}},$value);
}
} elsif ($item eq 'resourcetag') {
if ($name eq 'responsetype') {
$Apache::lonrelrequtils::checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
}
} elsif ($item eq 'course') {
if ($name eq 'crstype') {
$Apache::lonrelrequtils::checkcrstypes{$value} = $Apache::lonnet::needsrelease{$key};
}
}
}
($Apache::lonrelrequtils::anonsurvey{major},$Apache::lonrelrequtils::anonsurvey{minor}) =
split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
($Apache::lonrelrequtils::randomizetry{major},$Apache::lonrelrequtils::randomizetry{minor}) =
split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
return;
}
sub get_release_req {
my ($cnum,$cdom,$crstype,$readmap,$globals_set) = @_;
if ($readmap) {
&Apache::lonuserstate::readmap($cdom.'/'.$cnum);
}
unless ($globals_set) {
&init_global_hashes();
}
# check all parameters
my ($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);
return ($reqdmajor,$reqdminor);
}
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(%Apache::lonrelrequtils::checkparms)) {
if ($key =~ /(\Q$item\E)$/) {
if (ref($Apache::lonrelrequtils::checkparms{$item}) eq 'ARRAY') {
my $value = $resourcedata->{$key};
if ($item eq 'examcode') {
if (&Apache::lonnet::validCODE($value)) {
$value = 'valid';
} else {
$value = '';
}
}
if (grep(/^\Q$value\E$/,@{$Apache::lonrelrequtils::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($Apache::lonrelrequtils::checkcrstypes{$crstype})) {
my ($major,$minor) = split(/\./,$Apache::lonrelrequtils::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('comm_block',$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;
}
}
if ($comm_blocks{$block}{'blocks'}{'printout'} eq 'on') {
my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course:commblock:printout'});
($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
last;
}
}
}
}
}
return ($reqdmajor,$reqdminor);
}
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($Apache::lonrelrequtils::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(/\./,$Apache::lonrelrequtils::checkresponsetypes{$key});
($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
}
if ($anonsurv_subm) {
($reqdmajor,$reqdminor) = &update_reqd_loncaparev($Apache::lonrelrequtils::anonsurvey{major},
$Apache::lonrelrequtils::anonsurvey{minor},$reqdmajor,$reqdminor);
}
if ($randbytry_subm) {
($reqdmajor,$reqdminor) = &update_reqd_loncaparev($Apache::lonrelrequtils::randomizetry{major},
$Apache::lonrelrequtils::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,$cdom)=@_;
my $resourcedata=&Apache::lonnet::get_courseresdata($cnum,$cdom);
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=~/^\Q$cdom\E_\Q$cnum\E/) {
my $newkey=$userkey;
$newkey=~s/^(\Q$cdom\E_\Q$cnum\E\.)/$1\[useropt\:$tuname\:$tudom\]\./;
$$resourcedata{$newkey}=$$useropt{$userkey};
}
}
}
}
return $resourcedata;
}
sub modify_course_relreq {
my ($newmajor,$newminor,$cnum,$cdom,$chome,$crstype,$cid,$readmap,$getrelreq) = @_;
if ($cnum eq '' || $cdom eq '' || $chome eq '' || $crstype eq '' || $cid eq '') {
$cid = $env{'request.course.id'};
$cdom = $env{'course.'.$cid.'.domain'};
$cnum = $env{'course.'.$cid.'.num'};
$chome = $env{'course.'.$cid.'.home'};
$crstype = $env{'course.'.$cid.'.type'};
if ($crstype eq '') {
$crstype = 'Course';
}
}
if ($getrelreq) {
($newmajor,$newminor) = &get_release_req($cnum,$cdom,$crstype,$readmap);
}
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
my $needsupdate;
if ($curr_reqd_hash{'internal.releaserequired'} eq '') {
if (($newmajor ne '') && ($newminor ne '')) {
$needsupdate = 1;
}
} else {
my ($currmajor,$currminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
my $serverdom = $Apache::lonnet::perlvar{'lonDefDomain'};
my $serverrev = &Apache::lonnet::get_server_loncaparev($serverdom,$lonhost);
my ($servermajor,$serverminor) = split(/\./,$serverrev);
unless (($currmajor > $servermajor) || (($currmajor == $servermajor) && ($currminor > $serverminor))) {
if (($currmajor != $newmajor) || ($currminor != $newminor)) {
$needsupdate = 1;
}
}
}
if ($needsupdate) {
my %crsinfo = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');
my $result;
if (($newmajor eq '') && ($newminor eq '')) {
$result = &Apache::lonnet::del('environment',['internal.releaserequired'],$cdom,$cnum);
if ($result eq 'ok') {
&Apache::lonnet::delenv('course.'.$cid.'.internal.releaserequired');
$crsinfo{$cid}{'releaserequired'} = '';
}
} else {
my %needshash = (
'internal.releaserequired' => $newmajor.'.'.$newminor,
);
$result = &Apache::lonnet::put('environment',\%needshash,$cdom,$cnum);
if ($result eq 'ok') {
&Apache::lonnet::appenv({'course.'.$cid.'.internal.releaserequired' => $newmajor.'.'.$newminor});
if (ref($crsinfo{$cid}) eq 'HASH') {
$crsinfo{$cid}{'releaserequired'} = $newmajor.'.'.$newminor
}
}
}
if ($result eq 'ok') {
&Apache::lonnet::courseidput($cdom,\%crsinfo,$chome,'notime');
}
}
return;
}
1;
More information about the LON-CAPA-cvs
mailing list