File:  [LON-CAPA] / loncom / interface / lonrelrequtils.pm
Revision 1.8: download - view: text, annotated - select for diffs
Wed Oct 19 00:03:10 2022 UTC (19 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, HEAD
- Bug 6975
  Folders and Resources in Supplemental Content area can be hidden using
  Course Editor.

    1: #!/usr/bin/perl
    2: # The LearningOnline Network
    3: #
    4: # $Id: lonrelrequtils.pm,v 1.8 2022/10/19 00:03:10 raeburn Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: #################################################
   29: 
   30: =pod
   31: 
   32: =head1 NAME
   33: 
   34: lonrelrequtils.pm
   35: 
   36: =head1 SYNOPSIS
   37: 
   38: Contains utilities used to determine the LON-CAPA version 
   39: requirement in a course, based on course type, parameters,
   40: responsetypes, and communication blocking events.
   41: 
   42: =head1 DESCRIPTION
   43: 
   44: lonrelrequtilities.pm includes a main subroutine:
   45: get_release_req() which will return the current major
   46: version and minor version requirement (if it exists).
   47: 
   48: =head1 SUBROUTINES
   49: 
   50: =over
   51: 
   52: =item &init_global_hashes()
   53: 
   54: Initializes package hashes containing version requirements for 
   55: parameters, responsetypes, course types, anonsurvey 
   56: parameter, and randomizetry parameter.
   57: 
   58: =item &get_release_req()
   59: 
   60: Returns current major version and minor version requirements for a course,
   61: based on: coursetype, parameters in use, responsetypes in use in course
   62: content, and communication blocking features in use in blocks with end dates
   63: in the future, or in blocks triggered by activation of a timer in a timed quiz.
   64: 
   65: Inputs: 5
   66: 
   67: =over
   68: 
   69: =item $cnum - course "number"
   70: 
   71: =item $cdom - course domain
   72: 
   73: =item $crstype - course type: Community or Course
   74: 
   75: =item $readmap - boolean; if true, read course's top level map, and any
   76:                  included maps recursively.
   77: 
   78: =item $globals_set - boolean: if false, call init_global_hashes
   79: 
   80: =back
   81: 
   82: 
   83: =item &parameter_constraints()
   84: 
   85: Returns major version and minor version requirements for a course,
   86: based on parameters in use in the course. (Parameters which have
   87: version requirements are listed in /home/httpd/lonTabs/releaseslist.xml).
   88: 
   89: Inputs: 2
   90: 
   91: =over
   92: 
   93: =item $cnum - course "number"
   94: 
   95: =item $cdom - course domain
   96: 
   97: =back
   98: 
   99: 
  100: =item &coursetype_constraints()
  101: 
  102: Returns major version and minor version requirements for a course,
  103: taking into account course type (Community or Course).
  104: 
  105: Inputs: 5
  106: 
  107: =over
  108: 
  109: =item $cnum - course "number"
  110: 
  111: =item $cdom - course domain
  112: 
  113: =item $crstype - course type: Community or Course
  114: 
  115: =item $reqdmajor - major version requirements based on constraints 
  116:                    considered so far (parameters).
  117: 
  118: =item $reqdminor - minor version requirements based on constraints 
  119:                    considered so far (parameters).
  120:  
  121: =back
  122: 
  123: 
  124: =item &commblock_constraints()
  125: 
  126: Returns major version and minor version requirements for a course,
  127: taking into account use of communication blocking (blocks for
  128: printouts, specified folders/resources, and/or triggering of block
  129: by a student starting a timed quiz.
  130: 
  131: Inputs: 4
  132: 
  133: =over
  134: 
  135: =item $cnum - course "number"
  136: 
  137: =item $cdom - course domain
  138: 
  139: =item $reqdmajor - major version requirements based on constraints 
  140:                    considered so far (parameters and course type).
  141: 
  142: =item $reqdminor - minor version requirements based on constraints
  143:                    considered so far (parameters and course type).
  144: 
  145: =back
  146: 
  147: 
  148: =item &coursecontent_constraints()
  149: 
  150: Returns major version and minor version requirements for a course,
  151: taking into responsetypes in use in published assessment items
  152: imported into a course.
  153: 
  154: Inputs: 4
  155: 
  156: =over
  157: 
  158: =item $cnum - course "number"
  159: 
  160: =item $cdom - course domain
  161: 
  162: =item $reqdmajor - major version requirements based on constraints
  163:                    considered so far (parameters, course type, blocks).
  164: 
  165: =item $reqdminor - minor version requirements based on constraints
  166:                    considered so far (parameters, course type, blocks).
  167: 
  168: =back
  169: 
  170: 
  171: =item &update_reqd_loncaparev()
  172: 
  173: Returns major version and minor version requirements for a course,
  174: taking into account new constraint type.
  175: 
  176: Inputs: 4
  177: 
  178: =over
  179: 
  180: =item $major - major version requirements from new constraint type
  181: 
  182: =item $minor - minor version requirements from new constraint type
  183: 
  184: =item $reqdmajor - major version requirements from constraints
  185:                    considered so far.
  186: 
  187: =item $reqdminor - minor version requirements from constraints
  188:                    considered so far.
  189: 
  190: =back
  191: 
  192: 
  193: =item &read_paramdata()
  194: 
  195: Returns a reference to a hash populated with parameter settings in a
  196: course (set both generally, and for specific students).
  197: 
  198: Inputs: 2
  199: 
  200: =over
  201: 
  202: =item $cnum - course "number"
  203: 
  204: =item $cdom - course domain
  205: 
  206: =back
  207: 
  208: 
  209: =item &modify_course_relreq()
  210: 
  211: Updates course's minimum version requirement (internal.releaserequired) in 
  212: course's environment.db, and in user's current session, and in course's
  213: record in nohist_courseids.db on course's home server.  This can include
  214: deleting an existing version requirement, downgrading to an earlier version,
  215: or updating to a newer version.
  216: 
  217: Note: if the current server's LON-CAPA version is older than the course's
  218: current version requirement, and a downgrade to an earlier version is being
  219: proposed, the change will NOT be made, because of the possibility that the
  220: current server has not checked for an attribute only available with a more 
  221: recent version of LON-CAPA.
  222: 
  223: Inputs: 9
  224: 
  225: =over
  226: 
  227: =item $newmajor - (optional) major version requirements
  228: 
  229: =item $newminor - (optional) minor version requirements
  230: 
  231: =item $cnum - course "number"
  232: 
  233: =item $cdom - course domain
  234: 
  235: =item $chome - lonHostID of course's home server
  236: 
  237: =item $crstype - course type: Community or Course
  238: 
  239: =item $cid - course ID
  240: 
  241: =item $readmap - boolean; if true, read course's top level map, and any
  242:                  included maps recursively.
  243: 
  244: =item $getrelreq - boolean; if true, call &get_release_req() to 
  245:       return the current major version and minor version requirements.
  246:       (needed if optional args: $newmajor and $newminor are not passed).
  247: 
  248: =back
  249: 
  250: =back
  251: 
  252: =cut
  253: 
  254: #################################################
  255: 
  256: package Apache::lonrelrequtils;
  257: 
  258: use strict;
  259: use Apache::lonnet;
  260: use Apache::loncommon();
  261: use Apache::lonuserstate();
  262: use Apache::loncoursedata();
  263: use Apache::lonnavmaps();
  264: use LONCAPA qw(:DEFAULT :match);
  265: 
  266: sub init_global_hashes {
  267:     %Apache::lonrelrequtils::checkparms = ();
  268:     %Apache::lonrelrequtils::checkparmvalsmatch = ();
  269:     %Apache::lonrelrequtils::checkparmnamesmatch = ();
  270:     %Apache::lonrelrequtils::checkresponsetypes = ();
  271:     %Apache::lonrelrequtils::checkcrstypes = ();
  272:     %Apache::lonrelrequtils::anonsurvey = ();
  273:     %Apache::lonrelrequtils::randomizetry = ();
  274:     %Apache::lonrelrequtils::exttool = ();
  275: 
  276:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
  277:         my ($item,$name,$value,$valuematch,$namematch) = split(/:/,$key);
  278:         if ($item eq 'parameter') {
  279:             if ($namematch ne '') {
  280:                 $Apache::lonrelrequtils::checkparmnamesmatch{$namematch} = 1;
  281:             }
  282:             if ($name ne '') {
  283:                 if ($value ne '') {
  284:                     if (ref($Apache::lonrelrequtils::checkparms{$name}) eq 'ARRAY') {
  285:                         unless(grep(/^\Q$name\E$/,@{$Apache::lonrelrequtils::checkparms{$name}})) {
  286:                             push(@{$Apache::lonrelrequtils::checkparms{$name}},$value);
  287:                        }
  288:                     } else {
  289:                        push(@{$Apache::lonrelrequtils::checkparms{$name}},$value);
  290:                     }
  291:                 } elsif ($valuematch ne '') {
  292:                     if (ref($Apache::lonrelrequtils::checkparmvalsmatch{$name}) eq 'ARRAY') {
  293:                         unless(grep(/^\Q$name\E$/,@{$Apache::lonrelrequtils::checkparmvalsmatch{$name}})) {
  294:                             push(@{$Apache::lonrelrequtils::checkparmvalsmatch{$name}},$valuematch);
  295:                        }
  296:                     } else {
  297:                         push(@{$Apache::lonrelrequtils::checkparmvalsmatch{$name}},$valuematch);
  298:                     }
  299:                 }
  300:             }
  301:         } elsif ($item eq 'resourcetag') {
  302:             if ($name eq 'responsetype') {
  303:                 $Apache::lonrelrequtils::checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
  304:             }
  305:         } elsif ($item eq 'course') {
  306:             if ($name eq 'crstype') {
  307:                 $Apache::lonrelrequtils::checkcrstypes{$value} = $Apache::lonnet::needsrelease{$key};
  308:             } elsif ($name eq 'courserestype') {
  309:                 if ($value eq 'exttool') {
  310:                     ($Apache::lonrelrequtils::exttool{major},$Apache::lonrelrequtils::exttool{minor}) =
  311:                     split(/\./,$Apache::lonnet::needsrelease{$key});
  312:                 }
  313:             }
  314:         }
  315:     }
  316:     ($Apache::lonrelrequtils::anonsurvey{major},$Apache::lonrelrequtils::anonsurvey{minor}) =
  317:         split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey::'});
  318:     ($Apache::lonrelrequtils::randomizetry{major},$Apache::lonrelrequtils::randomizetry{minor}) =
  319:         split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry::'});
  320:     return;
  321: }
  322: 
  323: sub get_release_req {
  324:     my ($cnum,$cdom,$crstype,$readmap,$globals_set) = @_;
  325:     if ($readmap) {
  326:         &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
  327:     }
  328:     unless ($globals_set) {
  329:         &init_global_hashes();
  330:     }
  331:     # check all parameters
  332:     my ($reqdmajor,$reqdminor) = &parameter_constraints($cnum,$cdom);
  333: 
  334:     # check course type
  335:     ($reqdmajor,$reqdminor) = &coursetype_constraints($cnum,$cdom,$crstype,$reqdmajor,
  336:                                                       $reqdminor);
  337:     # check communication blocks
  338:     ($reqdmajor,$reqdminor) = &commblock_constraints($cnum,$cdom,$reqdmajor,$reqdminor);
  339: 
  340:     # check course contents
  341:     ($reqdmajor,$reqdminor) = &coursecontent_constraints($cnum,$cdom,$reqdmajor,$reqdminor);
  342:     return ($reqdmajor,$reqdminor);
  343: }
  344: 
  345: sub parameter_constraints {
  346:     my ($cnum,$cdom) = @_;
  347:     my ($reqdmajor,$reqdminor);
  348:     my $resourcedata=&read_paramdata($cnum,$cdom);
  349:     my $now = time;
  350:     if (ref($resourcedata) eq 'HASH') {
  351:         foreach my $key (keys(%{$resourcedata})) {
  352:             foreach my $item (keys(%Apache::lonrelrequtils::checkparms)) {
  353:                 if ($key =~ /(\Q$item\E)$/) {
  354:                     if (ref($Apache::lonrelrequtils::checkparms{$item}) eq 'ARRAY') {
  355:                         my $value = $resourcedata->{$key};
  356:                         if ($item eq 'examcode') {
  357:                             if (&Apache::lonnet::validCODE($value)) {
  358:                                 $value = 'valid';
  359:                             } else {
  360:                                 $value = '';
  361:                             }
  362:                         } elsif ($item eq 'printstartdate') {
  363:                             if ($value =~ /^\d+$/) {
  364:                                 if ($value > $now) {
  365:                                     $value = 'future';
  366:                                 }
  367:                             }
  368:                         } elsif ($item eq 'printenddate') {
  369:                             if ($value =~ /^\d+$/) {
  370:                                 if ($value < $now) {
  371:                                     $value = 'past';
  372:                                 }
  373:                             }
  374:                         }
  375:                         if (grep(/^\Q$value\E$/,@{$Apache::lonrelrequtils::checkparms{$item}})) {
  376:                             my ($major,$minor) = 
  377:                                 split(/\./,$Apache::lonnet::needsrelease{'parameter:'.$item.':'.$value.'::'});
  378:                             ($reqdmajor,$reqdminor) =
  379:                                 &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
  380:                         }
  381:                     }
  382:                 }
  383:             }
  384:             foreach my $item (keys(%Apache::lonrelrequtils::checkparmvalsmatch)) { 
  385:                 if ($key =~ /(\Q$item\E)$/) {
  386:                     if (ref($Apache::lonrelrequtils::checkparmvalsmatch{$item}) eq 'ARRAY') {
  387:                         my $value = $resourcedata->{$key};
  388:                         foreach my $entry (@{$Apache::lonrelrequtils::checkparmvalsmatch{$item}}) {
  389:                             my $regexp;
  390:                             if (($item eq 'lenient') && ($entry eq 'weighted')) {
  391:                                 $regexp = '^[\-\.\d]+,[\-\.\d]+,[\-\.\d]+,[\-\.\d]+$';      
  392:                             } elsif (($item eq 'acc') && ($entry eq '_denyfrom_')) {
  393:                                 $regexp = '\!';
  394:                             } elsif (($item eq 'interval') && ($entry eq 'done')) {
  395:                                 $regexp = '^\d+_done$';
  396:                             }
  397:                             if ($regexp ne '') {
  398:                                 if ($value =~ /$regexp/) {
  399:                                     my ($major,$minor) =
  400:                                         split(/\./,$Apache::lonnet::needsrelease{'parameter:'.$item.'::'.$entry.':'});
  401:                                     ($reqdmajor,$reqdminor) =
  402:                                         &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
  403:                                     last;
  404:                                 }
  405:                             }
  406:                         }
  407:                     }
  408:                 }
  409:             }
  410:             foreach my $item (keys(%Apache::lonrelrequtils::checkparmnamesmatch)) {
  411:                 my $regexp;
  412:                 if ($item eq 'maplevelrecurse') {
  413:                     $regexp = '\.(?:sequence|page)___\(rec\)\.';
  414:                 }
  415:                 if ($regexp ne '') {
  416:                     if ($key =~ /$regexp/) {
  417:                         my ($major,$minor) =
  418:                           split(/\./,$Apache::lonnet::needsrelease{'parameter::::'.$item});
  419:                           ($reqdmajor,$reqdminor) =
  420:                               &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
  421: 
  422:                     }
  423:                 }
  424:             }
  425:         }
  426:     }
  427:     return ($reqdmajor,$reqdminor);
  428: }
  429: 
  430: sub coursetype_constraints {
  431:     my ($cnum,$cdom,$crstype,$reqdmajor,$reqdminor) = @_;
  432:     if (defined($Apache::lonrelrequtils::checkcrstypes{$crstype})) {
  433:         my ($major,$minor) = split(/\./,$Apache::lonrelrequtils::checkcrstypes{$crstype});
  434:         ($reqdmajor,$reqdminor) =
  435:             &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
  436:     }
  437:     return ($reqdmajor,$reqdminor);
  438: }
  439: 
  440: sub commblock_constraints {
  441:     my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
  442:     my %comm_blocks =  &Apache::lonnet::dump('comm_block',$cdom,$cnum);
  443:     my $now = time;
  444:     if (keys(%comm_blocks) > 0) {
  445:         foreach my $block (keys(%comm_blocks)) {
  446:             if ($block =~ /^firstaccess____(.+)$/) {
  447:                 my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course:commblock:timer'});
  448:                 ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
  449:                 last;
  450:             } elsif ($block =~ /^(\d+)____(\d+)$/) {
  451:                 my ($start,$end) = ($1,$2);
  452:                 next if ($end < $now);
  453:             }
  454:             if (ref($comm_blocks{$block}) eq 'HASH') {
  455:                 if (ref($comm_blocks{$block}{'blocks'}) eq 'HASH') {
  456:                     if (ref($comm_blocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
  457:                         if (keys(%{$comm_blocks{$block}{'blocks'}{'docs'}}) > 0) {
  458:                             my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course:commblock:docs'});
  459:                             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
  460:                             last;
  461:                         }
  462:                     }
  463:                     if ($comm_blocks{$block}{'blocks'}{'printout'} eq 'on') {
  464:                         my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course:commblock:printout'});
  465:                         ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
  466:                         last;
  467:                     }
  468:                 }
  469:             }
  470:         }
  471:     }
  472:     return ($reqdmajor,$reqdminor);
  473: }
  474: 
  475: sub coursecontent_constraints {
  476:     my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
  477:     my $navmap = Apache::lonnavmaps::navmap->new();
  478:     if (defined($navmap)) {
  479:         my %anonsubmissions =  &Apache::lonnet::dump('nohist_anonsurveys',
  480:                                                      $cdom,$cnum);
  481:         my %randomizetrysubm = &Apache::lonnet::dump('nohist_randomizetry',
  482:                                                      $cdom,$cnum);
  483:         my %allresponses;
  484:         my ($anonsurv_subm,$randbytry_subm,$exttool);
  485:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
  486:             if ($res->is_tool()) {
  487:                 $exttool ++;
  488:                 next;
  489:             }
  490:             my %responses = $res->responseTypes();
  491:             foreach my $key (keys(%responses)) {
  492:                 next unless(exists($Apache::lonrelrequtils::checkresponsetypes{$key}));
  493:                 $allresponses{$key} += $responses{$key};
  494:             }
  495:             my @parts = @{$res->parts()};
  496:             my $symb = $res->symb();
  497:             foreach my $part (@parts) {
  498:                 if (exists($anonsubmissions{$symb."\0".$part})) {
  499:                     $anonsurv_subm = 1;
  500:                 }
  501:                 if (exists($randomizetrysubm{$symb."\0".$part})) {
  502:                     $randbytry_subm = 1;
  503:                 }
  504:             }
  505:         }
  506:         foreach my $key (keys(%allresponses)) {
  507:             my ($major,$minor) = split(/\./,$Apache::lonrelrequtils::checkresponsetypes{$key});
  508:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
  509:         }
  510:         if ($exttool) {
  511:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($Apache::lonrelrequtils::exttool{major},
  512:                                                               $Apache::lonrelrequtils::exttool{minor}); 
  513:         }
  514:         if ($anonsurv_subm) {
  515:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($Apache::lonrelrequtils::anonsurvey{major},
  516:                                           $Apache::lonrelrequtils::anonsurvey{minor},$reqdmajor,$reqdminor);
  517:         }
  518:         if ($randbytry_subm) {
  519:             ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($Apache::lonrelrequtils::randomizetry{major},
  520:                                           $Apache::lonrelrequtils::randomizetry{minor},$reqdmajor,$reqdminor);
  521:         }
  522:     }
  523:     if (&Apache::lonnet::count_supptools($cnum,$cdom,1,1)) {
  524:         ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($Apache::lonrelrequtils::exttool{major},
  525:                                                           $Apache::lonrelrequtils::exttool{minor});
  526:     }
  527:     return ($reqdmajor,$reqdminor);
  528: }
  529: 
  530: sub update_reqd_loncaparev {
  531:     my ($major,$minor,$reqdmajor,$reqdminor) = @_;
  532:     if (($major ne '' && $major !~ /\D/) & ($minor ne '' && $minor !~ /\D/)) {
  533:         if ($reqdmajor eq '' || $reqdminor eq '') {
  534:             $reqdmajor = $major;
  535:             $reqdminor = $minor;
  536:         } elsif (($major > $reqdmajor) ||
  537:             ($major == $reqdmajor && $minor > $reqdminor))  {
  538:             $reqdmajor = $major;
  539:             $reqdminor = $minor;
  540:         }
  541:     }
  542:     return ($reqdmajor,$reqdminor);
  543: }
  544: 
  545: sub read_paramdata {
  546:     my ($cnum,$cdom)=@_;
  547:     my $resourcedata=&Apache::lonnet::get_courseresdata($cnum,$cdom);
  548:     my $classlist=&Apache::loncoursedata::get_classlist();
  549:     foreach my $student (keys(%{$classlist})) {
  550:         if ($student =~/^($LONCAPA::match_username)\:($LONCAPA::match_domain)$/) {
  551:             my ($tuname,$tudom)=($1,$2);
  552:             my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
  553:             foreach my $userkey (keys(%{$useropt})) {
  554:                 if ($userkey=~/^\Q$cdom\E_\Q$cnum\E/) {
  555:                     my $newkey=$userkey;
  556:                     $newkey=~s/^(\Q$cdom\E_\Q$cnum\E\.)/$1\[useropt\:$tuname\:$tudom\]\./;
  557:                     $$resourcedata{$newkey}=$$useropt{$userkey};
  558:                 }
  559:             }
  560:         }
  561:     }
  562:     return $resourcedata;
  563: }
  564: 
  565: sub modify_course_relreq {
  566:     my ($newmajor,$newminor,$cnum,$cdom,$chome,$crstype,$cid,$readmap,$getrelreq) = @_;
  567:     if ($cnum eq '' || $cdom eq '' || $chome eq '' || $crstype eq '' || $cid eq '') {
  568:         $cid = $env{'request.course.id'};
  569:         $cdom = $env{'course.'.$cid.'.domain'};
  570:         $cnum = $env{'course.'.$cid.'.num'};
  571:         $chome = $env{'course.'.$cid.'.home'};
  572:         $crstype = $env{'course.'.$cid.'.type'};
  573:         if ($crstype eq '') {
  574:             $crstype = 'Course';
  575:         }
  576:     }
  577:     if ($getrelreq) {
  578:         ($newmajor,$newminor) = &get_release_req($cnum,$cdom,$crstype,$readmap);
  579:     }
  580:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
  581:     my $needsupdate;
  582:     if ($curr_reqd_hash{'internal.releaserequired'} eq '') {
  583:         if (($newmajor ne '') && ($newminor ne '')) { 
  584:             $needsupdate = 1;
  585:         }
  586:     } else {
  587:         my ($currmajor,$currminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
  588:         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
  589:         my $serverdom = $Apache::lonnet::perlvar{'lonDefDomain'};
  590:         my $serverrev = &Apache::lonnet::get_server_loncaparev($serverdom,$lonhost);
  591:         my ($servermajor,$serverminor) = split(/\./,$serverrev);     
  592:         unless (($currmajor > $servermajor) || (($currmajor == $servermajor) && ($currminor > $serverminor))) {
  593:             if (($currmajor != $newmajor) || ($currminor != $newminor)) {
  594:                 $needsupdate = 1;
  595:             }
  596:         }
  597:     }
  598:     if ($needsupdate) {
  599:         my %crsinfo = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');
  600:         my $result;
  601:         if (($newmajor eq '') && ($newminor eq '')) {
  602:             $result = &Apache::lonnet::del('environment',['internal.releaserequired'],$cdom,$cnum);
  603:             if ($result eq 'ok') {
  604:                 &Apache::lonnet::delenv('course.'.$cid.'.internal.releaserequired');
  605:                 $crsinfo{$cid}{'releaserequired'} = '';
  606:             }
  607:         } else {
  608:             my %needshash = (
  609:                               'internal.releaserequired' => $newmajor.'.'.$newminor,
  610:                             );
  611:             $result = &Apache::lonnet::put('environment',\%needshash,$cdom,$cnum);
  612:             if ($result eq 'ok') {
  613:                 &Apache::lonnet::appenv({'course.'.$cid.'.internal.releaserequired' => $newmajor.'.'.$newminor});
  614:                 if (ref($crsinfo{$cid}) eq 'HASH') {
  615:                     $crsinfo{$cid}{'releaserequired'} = $newmajor.'.'.$newminor
  616:                 }
  617:             }
  618:         }
  619:         if ($result eq 'ok') {
  620:             &Apache::lonnet::courseidput($cdom,\%crsinfo,$chome,'notime');
  621:         }
  622:     }
  623:     return;
  624: }
  625: 
  626: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>