Annotation of loncom/interface/lonrelrequtils.pm, revision 1.1
1.1 ! raeburn 1: #!/usr/bin/perl
! 2: # The LearningOnline Network
! 3: #
! 4: # $Id: lonrelrequtils.pm,v 1.1 2014/06/04 16:10:51 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 ¶meter_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::checkresponsetypes = ();
! 269: %Apache::lonrelrequtils::checkcrstypes = ();
! 270: %Apache::lonrelrequtils::anonsurvey = ();
! 271: %Apache::lonrelrequtils::randomizetry = ();
! 272:
! 273: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
! 274: my ($item,$name,$value) = split(/:/,$key);
! 275: if ($item eq 'parameter') {
! 276: if (ref($Apache::lonrelrequtils::checkparms{$name}) eq 'ARRAY') {
! 277: unless(grep(/^\Q$name\E$/,@{$Apache::lonrelrequtils::checkparms{$name}})) {
! 278: push(@{$Apache::lonrelrequtils::checkparms{$name}},$value);
! 279: }
! 280: } else {
! 281: push(@{$Apache::lonrelrequtils::checkparms{$name}},$value);
! 282: }
! 283: } elsif ($item eq 'resourcetag') {
! 284: if ($name eq 'responsetype') {
! 285: $Apache::lonrelrequtils::checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
! 286: }
! 287: } elsif ($item eq 'course') {
! 288: if ($name eq 'crstype') {
! 289: $Apache::lonrelrequtils::checkcrstypes{$value} = $Apache::lonnet::needsrelease{$key};
! 290: }
! 291: }
! 292: }
! 293: ($Apache::lonrelrequtils::anonsurvey{major},$Apache::lonrelrequtils::anonsurvey{minor}) =
! 294: split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
! 295: ($Apache::lonrelrequtils::randomizetry{major},$Apache::lonrelrequtils::randomizetry{minor}) =
! 296: split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
! 297: return;
! 298: }
! 299:
! 300: sub get_release_req {
! 301: my ($cnum,$cdom,$crstype,$readmap,$globals_set) = @_;
! 302: if ($readmap) {
! 303: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
! 304: }
! 305: unless ($globals_set) {
! 306: &init_global_hashes();
! 307: }
! 308: # check all parameters
! 309: my ($reqdmajor,$reqdminor) = ¶meter_constraints($cnum,$cdom);
! 310:
! 311: # check course type
! 312: ($reqdmajor,$reqdminor) = &coursetype_constraints($cnum,$cdom,$crstype,$reqdmajor,
! 313: $reqdminor);
! 314: # check communication blocks
! 315: ($reqdmajor,$reqdminor) = &commblock_constraints($cnum,$cdom,$reqdmajor,$reqdminor);
! 316:
! 317: # check course contents
! 318: ($reqdmajor,$reqdminor) = &coursecontent_constraints($cnum,$cdom,$reqdmajor,$reqdminor);
! 319: return ($reqdmajor,$reqdminor);
! 320: }
! 321:
! 322: sub parameter_constraints {
! 323: my ($cnum,$cdom) = @_;
! 324: my ($reqdmajor,$reqdminor);
! 325: my $resourcedata=&read_paramdata($cnum,$cdom);
! 326: if (ref($resourcedata) eq 'HASH') {
! 327: foreach my $key (keys(%{$resourcedata})) {
! 328: foreach my $item (keys(%Apache::lonrelrequtils::checkparms)) {
! 329: if ($key =~ /(\Q$item\E)$/) {
! 330: if (ref($Apache::lonrelrequtils::checkparms{$item}) eq 'ARRAY') {
! 331: my $value = $resourcedata->{$key};
! 332: if ($item eq 'examcode') {
! 333: if (&Apache::lonnet::validCODE($value)) {
! 334: $value = 'valid';
! 335: } else {
! 336: $value = '';
! 337: }
! 338: }
! 339: if (grep(/^\Q$value\E$/,@{$Apache::lonrelrequtils::checkparms{$item}})) {
! 340: my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'parameter:'.$item.':'.$value});
! 341: ($reqdmajor,$reqdminor) =
! 342: &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
! 343: }
! 344: }
! 345: }
! 346: }
! 347: }
! 348: }
! 349: return ($reqdmajor,$reqdminor);
! 350: }
! 351:
! 352: sub coursetype_constraints {
! 353: my ($cnum,$cdom,$crstype,$reqdmajor,$reqdminor) = @_;
! 354: if (defined($Apache::lonrelrequtils::checkcrstypes{$crstype})) {
! 355: my ($major,$minor) = split(/\./,$Apache::lonrelrequtils::checkcrstypes{$crstype});
! 356: ($reqdmajor,$reqdminor) =
! 357: &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
! 358: }
! 359: return ($reqdmajor,$reqdminor);
! 360: }
! 361:
! 362: sub commblock_constraints {
! 363: my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
! 364: my %comm_blocks = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
! 365: my $now = time;
! 366: if (keys(%comm_blocks) > 0) {
! 367: foreach my $block (keys(%comm_blocks)) {
! 368: if ($block =~ /^firstaccess____(.+)$/) {
! 369: my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course:commblock:timer'});
! 370: ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
! 371: last;
! 372: } elsif ($block =~ /^(\d+)____(\d+)$/) {
! 373: my ($start,$end) = ($1,$2);
! 374: next if ($end < $now);
! 375: }
! 376: if (ref($comm_blocks{$block}) eq 'HASH') {
! 377: if (ref($comm_blocks{$block}{'blocks'}) eq 'HASH') {
! 378: if (ref($comm_blocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
! 379: if (keys(%{$comm_blocks{$block}{'blocks'}{'docs'}}) > 0) {
! 380: my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course:commblock:docs'});
! 381: ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
! 382: last;
! 383: }
! 384: }
! 385: if ($comm_blocks{$block}{'blocks'}{'printout'} eq 'on') {
! 386: my ($major,$minor) = split(/\./,$Apache::lonnet::needsrelease{'course:commblock:printout'});
! 387: ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
! 388: last;
! 389: }
! 390: }
! 391: }
! 392: }
! 393: }
! 394: return ($reqdmajor,$reqdminor);
! 395: }
! 396:
! 397: sub coursecontent_constraints {
! 398: my ($cnum,$cdom,$reqdmajor,$reqdminor) = @_;
! 399: my $navmap = Apache::lonnavmaps::navmap->new();
! 400: if (defined($navmap)) {
! 401: my %anonsubmissions = &Apache::lonnet::dump('nohist_anonsurveys',
! 402: $cdom,$cnum);
! 403: my %randomizetrysubm = &Apache::lonnet::dump('nohist_randomizetry',
! 404: $cdom,$cnum);
! 405: my %allresponses;
! 406: my ($anonsurv_subm,$randbytry_subm);
! 407: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
! 408: my %responses = $res->responseTypes();
! 409: foreach my $key (keys(%responses)) {
! 410: next unless(exists($Apache::lonrelrequtils::checkresponsetypes{$key}));
! 411: $allresponses{$key} += $responses{$key};
! 412: }
! 413: my @parts = @{$res->parts()};
! 414: my $symb = $res->symb();
! 415: foreach my $part (@parts) {
! 416: if (exists($anonsubmissions{$symb."\0".$part})) {
! 417: $anonsurv_subm = 1;
! 418: }
! 419: if (exists($randomizetrysubm{$symb."\0".$part})) {
! 420: $randbytry_subm = 1;
! 421: }
! 422: }
! 423: }
! 424: foreach my $key (keys(%allresponses)) {
! 425: my ($major,$minor) = split(/\./,$Apache::lonrelrequtils::checkresponsetypes{$key});
! 426: ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($major,$minor,$reqdmajor,$reqdminor);
! 427: }
! 428: if ($anonsurv_subm) {
! 429: ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($Apache::lonrelrequtils::anonsurvey{major},
! 430: $Apache::lonrelrequtils::anonsurvey{minor},$reqdmajor,$reqdminor);
! 431: }
! 432: if ($randbytry_subm) {
! 433: ($reqdmajor,$reqdminor) = &update_reqd_loncaparev($Apache::lonrelrequtils::randomizetry{major},
! 434: $Apache::lonrelrequtils::randomizetry{minor},$reqdmajor,$reqdminor);
! 435: }
! 436: }
! 437: return ($reqdmajor,$reqdminor);
! 438: }
! 439:
! 440: sub update_reqd_loncaparev {
! 441: my ($major,$minor,$reqdmajor,$reqdminor) = @_;
! 442: if (($major ne '' && $major !~ /\D/) & ($minor ne '' && $minor !~ /\D/)) {
! 443: if ($reqdmajor eq '' || $reqdminor eq '') {
! 444: $reqdmajor = $major;
! 445: $reqdminor = $minor;
! 446: } elsif (($major > $reqdmajor) ||
! 447: ($major == $reqdmajor && $minor > $reqdminor)) {
! 448: $reqdmajor = $major;
! 449: $reqdminor = $minor;
! 450: }
! 451: }
! 452: return ($reqdmajor,$reqdminor);
! 453: }
! 454:
! 455: sub read_paramdata {
! 456: my ($cnum,$cdom)=@_;
! 457: my $resourcedata=&Apache::lonnet::get_courseresdata($cnum,$cdom);
! 458: my $classlist=&Apache::loncoursedata::get_classlist();
! 459: foreach my $student (keys(%{$classlist})) {
! 460: if ($student =~/^($LONCAPA::match_username)\:($LONCAPA::match_domain)$/) {
! 461: my ($tuname,$tudom)=($1,$2);
! 462: my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
! 463: foreach my $userkey (keys(%{$useropt})) {
! 464: if ($userkey=~/^\Q$cdom\E_\Q$cnum\E/) {
! 465: my $newkey=$userkey;
! 466: $newkey=~s/^(\Q$cdom\E_\Q$cnum\E\.)/$1\[useropt\:$tuname\:$tudom\]\./;
! 467: $$resourcedata{$newkey}=$$useropt{$userkey};
! 468: }
! 469: }
! 470: }
! 471: }
! 472: return $resourcedata;
! 473: }
! 474:
! 475: sub modify_course_relreq {
! 476: my ($newmajor,$newminor,$cnum,$cdom,$chome,$crstype,$cid,$readmap,$getrelreq) = @_;
! 477: if ($cnum eq '' || $cdom eq '' || $chome eq '' || $crstype eq '' || $cid eq '') {
! 478: $cid = $env{'request.course.id'};
! 479: $cdom = $env{'course.'.$cid.'.domain'};
! 480: $cnum = $env{'course.'.$cid.'.num'};
! 481: $chome = $env{'course.'.$cid.'.home'};
! 482: $crstype = $env{'course.'.$cid.'.type'};
! 483: if ($crstype eq '') {
! 484: $crstype = 'Course';
! 485: }
! 486: }
! 487: if ($getrelreq) {
! 488: ($newmajor,$newminor) = &get_release_req($cnum,$cdom,$crstype,$readmap);
! 489: }
! 490: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
! 491: my $needsupdate;
! 492: if ($curr_reqd_hash{'internal.releaserequired'} eq '') {
! 493: if (($newmajor ne '') && ($newminor ne '')) {
! 494: $needsupdate = 1;
! 495: }
! 496: } else {
! 497: my ($currmajor,$currminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
! 498: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
! 499: my $serverdom = $Apache::lonnet::perlvar{'lonDefDomain'};
! 500: my $serverrev = &Apache::lonnet::get_server_loncaparev($serverdom,$lonhost);
! 501: my ($servermajor,$serverminor) = split(/\./,$serverrev);
! 502: unless (($currmajor > $servermajor) || (($currmajor == $servermajor) && ($currminor > $serverminor))) {
! 503: if (($currmajor != $newmajor) || ($currminor != $newminor)) {
! 504: $needsupdate = 1;
! 505: }
! 506: }
! 507: }
! 508: if ($needsupdate) {
! 509: my %crsinfo = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');
! 510: my $result;
! 511: if (($newmajor eq '') && ($newminor eq '')) {
! 512: $result = &Apache::lonnet::del('environment',['internal.releaserequired'],$cdom,$cnum);
! 513: if ($result eq 'ok') {
! 514: &Apache::lonnet::delenv('course.'.$cid.'.internal.releaserequired');
! 515: $crsinfo{$cid}{'releaserequired'} = '';
! 516: }
! 517: } else {
! 518: my %needshash = (
! 519: 'internal.releaserequired' => $newmajor.'.'.$newminor,
! 520: );
! 521: $result = &Apache::lonnet::put('environment',\%needshash,$cdom,$cnum);
! 522: if ($result eq 'ok') {
! 523: &Apache::lonnet::appenv({'course.'.$cid.'.internal.releaserequired' => $newmajor.'.'.$newminor});
! 524: if (ref($crsinfo{$cid}) eq 'HASH') {
! 525: $crsinfo{$cid}{'releaserequired'} = $newmajor.'.'.$newminor
! 526: }
! 527: }
! 528: }
! 529: if ($result eq 'ok') {
! 530: &Apache::lonnet::courseidput($cdom,\%crsinfo,$chome,'notime');
! 531: }
! 532: }
! 533: return;
! 534: }
! 535:
! 536: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonrelrequtils.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface