--- loncom/interface/lonparmset.pm 2009/03/29 18:25:33 1.438
+++ loncom/interface/lonparmset.pm 2016/10/27 23:17:42 1.522.2.21
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set parameters for assessments
#
-# $Id: lonparmset.pm,v 1.438 2009/03/29 18:25:33 raeburn Exp $
+# $Id: lonparmset.pm,v 1.522.2.21 2016/10/27 23:17:42 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -46,8 +46,6 @@ This module sets coursewide and assessme
=over
-=pod
-
=item parmval()
Figure out a cascading parameter.
@@ -137,33 +135,49 @@ javascript function 'pjump'.
=item extractResourceInformation() :
-Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes.
+ extractResourceInformation extracts lots of information about all of the the course's resources into a variety of hashes.
+
+Input: See list below
+
+=over 4
+
+=item * B : Current username
+
+=item * B : Domain of current user.
-Input: See list below:
+=item * B : Course
-=item * B : An array that will contain all of the ids in the course.
+=back
-=item * B : hash, id->type, where "type" contains the extension of the file, thus, I.
+Outputs: See list below
-=item * B : hash, id->key list, will contain a comma separated list of the meta-data keys available for the given id
+=over 4
-=item * B : hash, name of parameter->display value (what is the display value?)
+=item * B (out) : An array that will contain all of the ids in the course.
-=item * B : hash, part identification->text representation of part, where the text representation is "[Part $part]"
+=item * B(out) : hash, id->type, where "type" contains the extension of the file, thus, I.
-=item * B : hash, full key to part->display value (what's display value?)
+=item * B (out) : hash, id->key list, will contain a comma separated list of the meta-data keys available for the given id
-=item * B : hash, ???
+=item * B (out) : hash, name of parameter->display value (what is the display value?)
-=item * B : ???
+=item * B (out) : hash, part identification->text representation of part, where the text representation is "[Part $part]"
-=item * B : hash, ???
+=item * B (out) : hash, ???
=item * B : ??
=item * B : hash, id->full sym?
+=item * B
+
+=item * B
+
+=item * B
+=item * B
+
+=back
=item isdateparm()
@@ -196,12 +210,14 @@ Input: See list below:
Show assessment data and parameters. This is a large routine that should
be simplified and shortened... someday.
-Inputs: $r
-
+Inputs: $r - the Apache request object.
+
Returns: nothing
Variables used (guessed by Jeremy):
+=over
+
=item * B: ParameterS CATegories? ends up a list of the types of parameters that exist, e.g., tol, weight, acc, opendate, duedate, answerdate, sig, maxtries, type.
=item * B: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
@@ -214,18 +230,7 @@ Variables used (guessed by Jeremy):
When storing information, store as part 0
When requesting information, request from full part
-=item crsenv()
-
-Show and set course data and parameters. This is a large routine that should
-be simplified and shortened... someday.
-
-Inputs: $r
-
-Returns: nothing
-
-=item can_modify_catsettings()
-
-=item assign_course_categories()
+=back
=item tablestart()
@@ -261,37 +266,6 @@ Returns: nothing
=item parse_key()
-=item check_cloners() :
-
-Checks if new users included in list of allowed cloners
-are valid users. Replaces supplied list with
-cleaned list containing only users with valid usernames
-and domains.
-
-Inputs: $clonelist, $oldcloner
-where $clonelist is ref to array of requested cloners,
-and $oldcloner is ref to array of currently allowed
-cloners.
-
-Returns: string - comma separated list of requested
-cloners (username:domain) who do not exist in system.
-
-=item change_clone() :
-
-Modifies the list of courses a user can clone (stored
-in the user's environment.db file), called when a
-change is made to the list of users allowed to clone
-a course.
-
-Inputs: $action,$cloner
-where $action is add or drop, and $cloner is identity of
-user for whom cloning ability is to be changed in course.
-
-
-=item check_cloners()
-
-=item change_clone()
-
=item header()
Output html header for page
@@ -322,8 +296,7 @@ Set portfolio metadata
=item handler() :
-Main handler. Calls &assessparms and &crsenv subroutines.
-
+Main handler. Calls &assessparms subroutine.
=back
@@ -346,6 +319,7 @@ use Apache::lonlocal;
use Apache::lonnavmaps;
use Apache::longroup;
use Apache::lonrss;
+use HTML::Entities;
use LONCAPA qw(:DEFAULT :match);
@@ -360,13 +334,13 @@ sub parmval_by_symb {
my $useropt;
if ($uname ne '' && $udom ne '') {
- $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
+ $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
}
my $result='';
my @outpar=();
# ----------------------------------------------------- Cascading lookup scheme
- my $map=(&Apache::lonnet::decode_symb($symb))[0];
+ my $map=(&Apache::lonnet::decode_symb($symb))[0];
$map = &Apache::lonnet::deversion($map);
my $symbparm=$symb.'.'.$what;
@@ -388,13 +362,13 @@ sub parmval_by_symb {
# --------------------------------------------------------- first, check course
if (defined($$courseopt{$courselevel})) {
- $outpar[14]=$$courseopt{$courselevel};
- $result=14;
+ $outpar[14]=$$courseopt{$courselevel};
+ $result=14;
}
if (defined($$courseopt{$courselevelm})) {
- $outpar[13]=$$courseopt{$courselevelm};
- $result=13;
+ $outpar[13]=$$courseopt{$courselevelm};
+ $result=13;
}
# ------------------------------------------------------- second, check default
@@ -407,25 +381,25 @@ sub parmval_by_symb {
if (defined($thisparm)) { $outpar[11]=$thisparm; $result=11; }
if (defined($$courseopt{$courselevelr})) {
- $outpar[10]=$$courseopt{$courselevelr};
- $result=10;
+ $outpar[10]=$$courseopt{$courselevelr};
+ $result=10;
}
# ------------------------------------------------------ fourth, back to course
if ($csec ne '') {
if (defined($$courseopt{$seclevel})) {
- $outpar[9]=$$courseopt{$seclevel};
- $result=9;
- }
+ $outpar[9]=$$courseopt{$seclevel};
+ $result=9;
+ }
if (defined($$courseopt{$seclevelm})) {
- $outpar[8]=$$courseopt{$seclevelm};
- $result=8;
- }
+ $outpar[8]=$$courseopt{$seclevelm};
+ $result=8;
+ }
if (defined($$courseopt{$seclevelr})) {
- $outpar[7]=$$courseopt{$seclevelr};
- $result=7;
- }
+ $outpar[7]=$$courseopt{$seclevelr};
+ $result=7;
+ }
}
# ------------------------------------------------------ fifth, check course group
if ($cgroup ne '') {
@@ -446,20 +420,20 @@ sub parmval_by_symb {
# ---------------------------------------------------------- fifth, check user
if ($uname ne '') {
- if (defined($$useropt{$courselevel})) {
- $outpar[3]=$$useropt{$courselevel};
- $result=3;
- }
-
- if (defined($$useropt{$courselevelm})) {
- $outpar[2]=$$useropt{$courselevelm};
- $result=2;
- }
-
- if (defined($$useropt{$courselevelr})) {
- $outpar[1]=$$useropt{$courselevelr};
- $result=1;
- }
+ if (defined($$useropt{$courselevel})) {
+ $outpar[3]=$$useropt{$courselevel};
+ $result=3;
+ }
+
+ if (defined($$useropt{$courselevelm})) {
+ $outpar[2]=$$useropt{$courselevelm};
+ $result=2;
+ }
+
+ if (defined($$useropt{$courselevelr})) {
+ $outpar[1]=$$useropt{$courselevelr};
+ $result=1;
+ }
}
return ($result,@outpar);
}
@@ -468,7 +442,7 @@ sub parmval_by_symb {
# --- Caches local to lonparmset
-
+
sub reset_caches {
&resetparmhash();
&resetsymbcache();
@@ -479,74 +453,74 @@ sub reset_caches {
my $parmhashid;
my %parmhash;
sub resetparmhash {
- undef($parmhashid);
- undef(%parmhash);
+ undef($parmhashid);
+ undef(%parmhash);
}
-
+
sub cacheparmhash {
- if ($parmhashid eq $env{'request.course.fn'}) { return; }
- my %parmhashfile;
- if (tie(%parmhashfile,'GDBM_File',
- $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
- %parmhash=%parmhashfile;
- untie(%parmhashfile);
- $parmhashid=$env{'request.course.fn'};
- }
+ if ($parmhashid eq $env{'request.course.fn'}) { return; }
+ my %parmhashfile;
+ if (tie(%parmhashfile,'GDBM_File',
+ $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
+ %parmhash=%parmhashfile;
+ untie(%parmhashfile);
+ $parmhashid=$env{'request.course.fn'};
}
-
+ }
+
sub parmhash {
- my ($id) = @_;
- &cacheparmhash();
- return $parmhash{$id};
+ my ($id) = @_;
+ &cacheparmhash();
+ return $parmhash{$id};
}
}
-{
+{
my $symbsid;
my %symbs;
sub resetsymbcache {
- undef($symbsid);
- undef(%symbs);
+ undef($symbsid);
+ undef(%symbs);
}
-
+
sub symbcache {
- my $id=shift;
- if ($symbsid ne $env{'request.course.id'}) {
- undef(%symbs);
- }
- if (!$symbs{$id}) {
- my $navmap = Apache::lonnavmaps::navmap->new();
- if ($id=~/\./) {
- my $resource=$navmap->getById($id);
- $symbs{$id}=$resource->symb();
- } else {
- my $resource=$navmap->getByMapPc($id);
- $symbs{$id}=&Apache::lonnet::declutter($resource->src());
- }
- $symbsid=$env{'request.course.id'};
- }
- return $symbs{$id};
+ my $id=shift;
+ if ($symbsid ne $env{'request.course.id'}) {
+ undef(%symbs);
+ }
+ if (!$symbs{$id}) {
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if ($id=~/\./) {
+ my $resource=$navmap->getById($id);
+ $symbs{$id}=$resource->symb();
+ } else {
+ my $resource=$navmap->getByMapPc($id);
+ $symbs{$id}=&Apache::lonnet::declutter($resource->src());
+ }
+ $symbsid=$env{'request.course.id'};
+ }
+ return $symbs{$id};
}
}
-{
+{
my $rulesid;
my %rules;
sub resetrulescache {
- undef($rulesid);
- undef(%rules);
+ undef($rulesid);
+ undef(%rules);
}
-
+
sub rulescache {
- my $id=shift;
- if ($rulesid ne $env{'request.course.id'}
- && !defined($rules{$id})) {
- my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
- my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
- %rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
- $rulesid=$env{'request.course.id'};
- }
- return $rules{$id};
+ my $id=shift;
+ if ($rulesid ne $env{'request.course.id'}
+ && !defined($rules{$id})) {
+ my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
+ %rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
+ $rulesid=$env{'request.course.id'};
+ }
+ return $rules{$id};
}
}
@@ -556,13 +530,13 @@ sub preset_defaults {
my $type=shift;
if (&rulescache($type.'_action') eq 'default') {
# yes, there is something
- return (&rulescache($type.'_hours'),
- &rulescache($type.'_min'),
- &rulescache($type.'_sec'),
- &rulescache($type.'_value'));
+ return (&rulescache($type.'_hours'),
+ &rulescache($type.'_min'),
+ &rulescache($type.'_sec'),
+ &rulescache($type.'_value'));
} else {
# nothing there or something else
- return ('','','','','');
+ return ('','','','','');
}
}
@@ -627,12 +601,12 @@ sub storeparm_by_symb {
my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
unless ($recflag) {
# first time call
- %recstack=();
- $recflag=1;
+ %recstack=();
+ $recflag=1;
}
# store parameter
&storeparm_by_symb_inner
- ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
+ ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
# don't do anything if parameter was reset
unless ($nval) { return; }
my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/);
@@ -642,40 +616,40 @@ sub storeparm_by_symb {
foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) {
# don't backfire
unless ((!$triggered) || ($recstack{$triggered})) {
- my $action=&rulescache($triggered.'_action');
- my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
+ my $action=&rulescache($triggered.'_action');
+ my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
# set triggered parameter on same level
- my $newspnam=$prefix.$triggered;
- my $newvalue='';
- my $active=1;
- if ($action=~/^when\_setting/) {
+ my $newspnam=$prefix.$triggered;
+ my $newvalue='';
+ my $active=1;
+ if ($action=~/^when\_setting/) {
# are there restrictions?
- if (&rulescache($triggered.'_triggervalue')=~/\w/) {
- $active=0;
- foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
- if (lc($possiblevalue) eq lc($nval)) { $active=1; }
- }
- }
- $newvalue=&rulescache($triggered.'_value');
- } else {
- my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
- if ($action=~/^later\_than/) {
- $newvalue=$nval+$totalsecs;
- } else {
- $newvalue=$nval-$totalsecs;
- }
- }
- if ($active) {
- &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
- $uname,$udom,$csec,$recflag,$cgroup);
- }
+ if (&rulescache($triggered.'_triggervalue')=~/\w/) {
+ $active=0;
+ foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
+ if (lc($possiblevalue) eq lc($nval)) { $active=1; }
+ }
+ }
+ $newvalue=&rulescache($triggered.'_value');
+ } else {
+ my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
+ if ($action=~/^later\_than/) {
+ $newvalue=$nval+$totalsecs;
+ } else {
+ $newvalue=$nval-$totalsecs;
+ }
+ }
+ if ($active) {
+ &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
+ $uname,$udom,$csec,$recflag,$cgroup);
+ }
}
}
return '';
}
sub log_parmset {
- return &Apache::lonnet::instructor_log('parameterlog',@_);
+ return &Apache::lonnet::write_log('course','parameterlog',@_);
}
sub storeparm_by_symb_inner {
@@ -683,7 +657,7 @@ sub storeparm_by_symb_inner {
my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
# ---------------------------------------------------------- Construct prefixes
$spnam=~s/\_([^\_]+)$/\.$1/;
- my $map=(&Apache::lonnet::decode_symb($symb))[0];
+ my $map=(&Apache::lonnet::decode_symb($symb))[0];
$map = &Apache::lonnet::deversion($map);
my $symbparm=$symb.'.'.$spnam;
@@ -696,11 +670,11 @@ sub storeparm_by_symb_inner {
my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
-
+
my $courselevel=$env{'request.course.id'}.'.'.$spnam;
my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
-
+
my $storeunder='';
if (($snum==14) || ($snum==3)) { $storeunder=$courselevel; }
if (($snum==13) || ($snum==2)) { $storeunder=$courselevelm; }
@@ -712,66 +686,66 @@ sub storeparm_by_symb_inner {
if ($snum==5) { $storeunder=$grplevelm; }
if ($snum==4) { $storeunder=$grplevelr; }
-
+
my $delete;
if ($nval eq '') { $delete=1;}
my %storecontent = ($storeunder => $nval,
- $storeunder.'.type' => $ntype);
+ $storeunder.'.type' => $ntype);
my $reply='';
if ($snum>3) {
# ---------------------------------------------------------------- Store Course
#
- my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
- my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
# Expire sheets
- &Apache::lonnet::expirespread('','','studentcalc');
- if (($snum==10) || ($snum==7) || ($snum==4)) {
- &Apache::lonnet::expirespread('','','assesscalc',$symb);
- } elsif (($snum==11) || ($snum==8) || ($snum==5)) {
- &Apache::lonnet::expirespread('','','assesscalc',$map);
- } else {
- &Apache::lonnet::expirespread('','','assesscalc');
- }
+ &Apache::lonnet::expirespread('','','studentcalc');
+ if (($snum==10) || ($snum==7) || ($snum==4)) {
+ &Apache::lonnet::expirespread('','','assesscalc',$symb);
+ } elsif (($snum==11) || ($snum==8) || ($snum==5)) {
+ &Apache::lonnet::expirespread('','','assesscalc',$map);
+ } else {
+ &Apache::lonnet::expirespread('','','assesscalc');
+ }
# Store parameter
- if ($delete) {
- $reply=&Apache::lonnet::del
- ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
+ if ($delete) {
+ $reply=&Apache::lonnet::del
+ ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
&log_parmset(\%storecontent,1);
- } else {
- $reply=&Apache::lonnet::cput
- ('resourcedata',\%storecontent,$cdom,$cnum);
- &log_parmset(\%storecontent);
- }
- &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
+ } else {
+ $reply=&Apache::lonnet::cput
+ ('resourcedata',\%storecontent,$cdom,$cnum);
+ &log_parmset(\%storecontent);
+ }
+ &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
} else {
# ------------------------------------------------------------------ Store User
#
# Expire sheets
- &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
- if ($snum==1) {
- &Apache::lonnet::expirespread
- ($uname,$udom,'assesscalc',$symb);
- } elsif ($snum==2) {
- &Apache::lonnet::expirespread
- ($uname,$udom,'assesscalc',$map);
- } else {
- &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
- }
+ &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
+ if ($snum==1) {
+ &Apache::lonnet::expirespread
+ ($uname,$udom,'assesscalc',$symb);
+ } elsif ($snum==2) {
+ &Apache::lonnet::expirespread
+ ($uname,$udom,'assesscalc',$map);
+ } else {
+ &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
+ }
# Store parameter
- if ($delete) {
- $reply=&Apache::lonnet::del
- ('resourcedata',[keys(%storecontent)],$udom,$uname);
- &log_parmset(\%storecontent,1,$uname,$udom);
- } else {
- $reply=&Apache::lonnet::cput
- ('resourcedata',\%storecontent,$udom,$uname);
- &log_parmset(\%storecontent,0,$uname,$udom);
- }
- &Apache::lonnet::devalidateuserresdata($uname,$udom);
+ if ($delete) {
+ $reply=&Apache::lonnet::del
+ ('resourcedata',[keys(%storecontent)],$udom,$uname);
+ &log_parmset(\%storecontent,1,$uname,$udom);
+ } else {
+ $reply=&Apache::lonnet::cput
+ ('resourcedata',\%storecontent,$udom,$uname);
+ &log_parmset(\%storecontent,0,$uname,$udom);
}
-
+ &Apache::lonnet::devalidateuserresdata($uname,$udom);
+ }
+
if ($reply=~/^error\:(.*)/) {
- return "Write Error: $1";
+ return "Write Error: $1";
}
return '';
}
@@ -782,11 +756,14 @@ sub valout {
my $result = '';
# Values of zero are valid.
if (! $value && $value ne '0') {
- if ($editable) {
- $result = '*';
- } else {
- $result=' ';
- }
+ if ($editable) {
+ $result =
+ '';
+ } else {
+ $result=' ';
+ }
} else {
if ($type eq 'date_interval') {
my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($value);
@@ -824,10 +801,11 @@ sub valout {
$result.=join(", ",@timer);
} elsif (&isdateparm($type)) {
$result = &Apache::lonlocal::locallocaltime($value).
- &date_sanity_info($value);
+ &date_sanity_info($value);
} else {
$result = $value;
- $result = &HTML::Entities::encode($result,'"<>&');
+ $result=~s/\,/\, /gs;
+ $result = &HTML::Entities::encode($result,'"<>&');
}
}
return $result;
@@ -838,7 +816,7 @@ sub plink {
my ($type,$dis,$value,$marker,$return,$call)=@_;
my $winvalue=$value;
unless ($winvalue) {
- if (&isdateparm($type)) {
+ if (&isdateparm($type)) {
$winvalue=$env{'form.recent_'.$type};
} else {
$winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
@@ -850,14 +828,14 @@ sub plink {
my $valout = &valout($value,$type,1);
my $unencmarker = $marker;
foreach my $item (\$type, \$dis, \$winvalue, \$marker, \$return, \$call,
- \$hour, \$min, \$sec) {
- $$item = &HTML::Entities::encode($$item,'"<>&');
- $$item =~ s/\'/\\\'/g;
+ \$hour, \$min, \$sec) {
+ $$item = &HTML::Entities::encode($$item,'"<>&');
+ $$item =~ s/\'/\\\'/g;
}
return '
');
@@ -1073,15 +1082,23 @@ sub print_row {
}
sub print_td {
- my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display)=@_;
+ my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,$noeditgrp,$readonly)=@_;
$r->print('
');
my $nolink = 0;
- if ($which == 11 || $which == 12) {
+ if ($readonly) {
$nolink = 1;
- } elsif ($mprefix =~ /availablestudent\&$/) {
- if ($which > 3) {
+ } else {
+ if ($which == 11 || $which == 12) {
$nolink = 1;
+ } elsif ($mprefix =~ /availablestudent\&$/) {
+ if ($which > 3) {
+ $nolink = 1;
+ }
+ } elsif ($mprefix =~ /examcode\&$/) {
+ unless ($which == 2) {
+ $nolink = 1;
+ }
}
}
if ($nolink) {
@@ -1107,7 +1124,7 @@ sub print_usergroups {
$courseopt);
my $bgcolor = $defbg;
my $grp_parm;
- if (($coursereply) && ($cgroup ne $resultgroup)) {
+ if (($coursereply) && ($cgroup ne $resultgroup)) {
if ($result > 3) {
$bgcolor = '#AAFFAA';
$grp_parm = &valout($coursereply,$resulttype);
@@ -1171,81 +1188,81 @@ sub extractResourceInformation {
my $navmap = Apache::lonnavmaps::navmap->new();
my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
foreach my $resource (@allres) {
- my $id=$resource->id();
+ my $id=$resource->id();
my ($mapid,$resid)=split(/\./,$id);
- if ($mapid eq '0') { next; }
- $$ids[$#$ids+1]=$id;
- my $srcf=$resource->src();
- $srcf=~/\.(\w+)$/;
- $$typep{$id}=$1;
- $$keyp{$id}='';
+ if ($mapid eq '0') { next; }
+ $$ids[$#$ids+1]=$id;
+ my $srcf=$resource->src();
+ $srcf=~/\.(\w+)$/;
+ $$typep{$id}=$1;
+ $$keyp{$id}='';
$$uris{$id}=$srcf;
- foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
- next if ($key!~/^parameter_/);
+
+ foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
+ next if ($key!~/^parameter_/);
# Hidden parameters
- next if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm');
+ next if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm');
#
# allparms is a hash of parameter names
#
- my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
- if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
- my ($display,$parmdis);
- $display = &standard_parameter_names($name);
- if ($display eq '') {
- $display= &Apache::lonnet::metadata($srcf,$key.'.display');
- $parmdis = $display;
- $parmdis =~ s/\s*\[Part.*$//g;
- } else {
- $parmdis = $display;
- }
- $$allparms{$name}=$parmdis;
- if (ref($defkeytype)) {
- $$defkeytype{$name}=
- &Apache::lonnet::metadata($srcf,$key.'.type');
- }
- }
+ my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
+ if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
+ my ($display,$parmdis);
+ $display = &standard_parameter_names($name);
+ if ($display eq '') {
+ $display= &Apache::lonnet::metadata($srcf,$key.'.display');
+ $parmdis = $display;
+ $parmdis =~ s/\s*\[Part.*$//g;
+ } else {
+ $parmdis = &mt($display);
+ }
+ $$allparms{$name}=$parmdis;
+ if (ref($defkeytype)) {
+ $$defkeytype{$name}=
+ &Apache::lonnet::metadata($srcf,$key.'.type');
+ }
+ }
#
# allparts is a hash of all parts
#
- my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
- $$allparts{$part} = &mt('Part: [_1]',$part);
+ my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
+ $$allparts{$part} = &mt('Part: [_1]',$part);
#
# Remember all keys going with this resource
#
- if ($$keyp{$id}) {
- $$keyp{$id}.=','.$key;
- } else {
- $$keyp{$id}=$key;
- }
+ if ($$keyp{$id}) {
+ $$keyp{$id}.=','.$key;
+ } else {
+ $$keyp{$id}=$key;
+ }
#
# Put in order
-#
- unless ($$keyorder{$key}) {
- $$keyorder{$key}=$keyordercnt;
- $keyordercnt++;
- }
- }
-
-
- if (!exists($$mapp{$mapid})) {
- $$mapp{$id}=
- &Apache::lonnet::declutter($resource->enclosing_map_src());
- $$mapp{$mapid}=$$mapp{$id};
- $$allmaps{$mapid}=$$mapp{$id};
- if ($mapid eq '1') {
- $$maptitles{$mapid}=&mt('Main Course Documents');
- } else {
- $$maptitles{$mapid}=
- &Apache::lonnet::gettitle($$mapp{$id});
- }
- $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
- $$symbp{$mapid}=$$mapp{$id}.'___(all)';
- } else {
- $$mapp{$id} = $$mapp{$mapid};
- }
- $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
+#
+ unless ($$keyorder{$key}) {
+ $$keyorder{$key}=$keyordercnt;
+ $keyordercnt++;
+ }
+ }
+
+
+ if (!exists($$mapp{$mapid})) {
+ $$mapp{$id}=
+ &Apache::lonnet::declutter($resource->enclosing_map_src());
+ $$mapp{$mapid}=$$mapp{$id};
+ $$allmaps{$mapid}=$$mapp{$id};
+ if ($mapid eq '1') {
+ $$maptitles{$mapid}=&mt('Main Content');
+ } else {
+ $$maptitles{$mapid}=&Apache::lonnet::gettitle($$mapp{$id});
+ }
+ $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
+ $$symbp{$mapid}=$$mapp{$id}.'___(all)';
+ } else {
+ $$mapp{$id} = $$mapp{$mapid};
+ }
+ $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
}
}
@@ -1256,13 +1273,27 @@ sub isdateparm {
return (($type=~/^date/) && (!($type eq 'date_interval')));
}
+#
+# parmmenu displays a list of the selected parameters.
+# It also offers a link to show/hide the complete parameter list
+# from which you can select all desired parameters.
+#
sub parmmenu {
my ($r,$allparms,$pscat,$keyorder)=@_;
my $tempkey;
$r->print(<
+//
ENDSCRIPT
- $r->print();
- $r->print("\n".'
');
- $r->print(' ');
my @temp_pscat;
map {
@@ -1899,93 +2367,104 @@ sub assessparms {
my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
my $csuname=$env{'user.name'};
my $csudom=$env{'user.domain'};
+ my $readonly = 1;
+ if ($parm_permission->{'edit'}) {
+ undef($readonly);
+ }
if ($parmlev eq 'full') {
- my $coursespan=$csec?8:5;
- my $userspan=3;
- if ($cgroup ne '') {
- $coursespan += 3;
- }
-
- $r->print('
');
- $r->print('
');
- $r->print('
'.&mt('Any User').'
');
- if ($uname) {
- if (@usersgroups > 1) {
- $userspan ++;
+#
+# This produces the cascading table output of parameters
+#
+ my $coursespan=$csec?8:5;
+ my $userspan=3;
+ if ($cgroup ne '') {
+ $coursespan += 3;
}
- $r->print('
'.
- &Apache::loncommon::end_data_table_row()."\n";
- }
- my %lt=&Apache::lonlocal::texthash(
- 'par' => 'Parameter',
- 'val' => 'Value',
- 'set' => 'Set?',
- 'sav' => 'Save'
- );
-
- my $Parameter=&mt('Parameter');
- my $Value=&mt('Value');
- my $Set=&mt('Set');
- my ($jscript,$categorize_js);
- my $browse_js = &Apache::loncommon::browser_and_searcher_javascript('parmset');
- if ($can_categorize) {
- $categorize_js = <'."\n".
- $browse_js."\n".$categorize_js."\n".'';
- my $start_page =
- &Apache::loncommon::start_page('Set Course Environment',
- $jscript);
- my $end_page =
- &Apache::loncommon::end_page();
- my $end_table=&Apache::loncommon::end_data_table();
- $r->print(<
-$setoutput
-
-$start_table
-$start_header_row
-
$lt{'par'}
$lt{'val'}
$lt{'set'}
-$end_header_row
-$output
-$end_table
-
-
-$end_page
-ENDENV
-}
-
-sub can_modify_catsettings {
- my ($dom) = @_;
- my %domconf = &Apache::lonnet::get_dom('configuration',['coursecategories'],$dom);
- my ($can_toggle_cat,$can_categorize);
- if (ref($domconf{'coursecategories'}) eq 'HASH') {
- if ($domconf{'coursecategories'}{'togglecats'} eq 'crs') {
- $can_toggle_cat = 1;
- }
- if ($domconf{'coursecategories'}{'categorize'} eq 'crs') {
- $can_categorize = 1;
- }
- }
- return ($can_toggle_cat,$can_categorize);
-}
-
-sub assign_course_categories {
- my ($r) = @_;
- my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
- my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
- my $hascats = 0;
- my $cathash;
- my %domconf = &Apache::lonnet::get_dom('configuration',['coursecategories'],$cdom);
- if (ref($domconf{'coursecategories'}) eq 'HASH') {
- $cathash = $domconf{'coursecategories'}{'cats'};
- if (ref($cathash) eq 'HASH') {
- $hascats = 1;
- }
- }
- my $catwin_js;
- if ($hascats) {
- my $alert = &mt('Use \"Save\" in the main window to save course categories');
- $catwin_js = <
-
-function updateCategories() {
- var newcategories = '';
- var unescapedcats = '';
- if (document.chgcats.usecategory.length) {
- for (var i=0; i 0) {
- newcategories = newcategories.slice(0,-1);
- }
- if (unescapedcats.length > 0) {
- unescapedcats = unescapedcats.slice(0,-3);
- }
- } else {
- if (document.chgcats.usecategory.checked == true) {
- newcategories = document.chgcats.usecategory.value;
- unescapedcats = document.chgcats.catname.value;
- }
- }
- opener.document.envform.categories_value.value = newcategories;
- opener.document.envform.categories_display.value = unescapedcats;
- opener.document.envform.categories_setparmval.checked = true;
- alert("$alert");
- self.close();
- return;
-}
-
-
-ENDSCRIPT
- } else {
- my $onload;
- }
- my $start_page =
- &Apache::loncommon::start_page('Course Categories',$catwin_js,
- {'only_body' => 1,});
- my $end_page = &Apache::loncommon::end_page();
- my $categoriesform = '
'.&mt('Categorize Course').'
';
- if ($hascats) {
- my %currsettings =
- &Apache::lonnet::get('environment',['hidefromcat','categories'],$cdom,$cnum);
- $categoriesform .= &mt('Assign one or more categories to this course.').'
'.
- ' ';
- } else {
- $categoriesform .= &mt('No categories defined for this domain');
- }
- $r->print($start_page.$categoriesform.$end_page);
- return;
-}
-
##################################################
# Overview mode
##################################################
my $tableopen;
sub tablestart {
+ my ($readonly) = @_;
if ($tableopen) {
- return '';
+ return '';
} else {
- $tableopen=1;
- return &Apache::loncommon::start_data_table().'
'.&mt('Parameter').'
'.
- &mt('Delete').'
'.&mt('Set to ...').'
';
+ $tableopen=1;
+ my $output = &Apache::loncommon::start_data_table().'
'.&mt('Parameter').'
';
+ if ($readonly) {
+ $output .= '
'.&mt('Current value').'
';
+ } else {
+ $output .= '
'.&mt('Delete').'
'.&mt('Set to ...').'
';
+ }
+ $output .= '
';
+ return $output;
}
}
sub tableend {
if ($tableopen) {
- $tableopen=0;
- return &Apache::loncommon::end_data_table();
+ $tableopen=0;
+ return &Apache::loncommon::end_data_table();
} else {
- return'';
+ return'';
}
}
@@ -2986,18 +2824,22 @@ sub readdata {
my $classlist=&Apache::loncoursedata::get_classlist();
foreach (keys %$classlist) {
if ($_=~/^($match_username)\:($match_domain)$/) {
- my ($tuname,$tudom)=($1,$2);
- my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
+ my ($tuname,$tudom)=($1,$2);
+ my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
foreach my $userkey (keys %{$useropt}) {
- if ($userkey=~/^$env{'request.course.id'}/) {
+ if ($userkey=~/^$env{'request.course.id'}/) {
my $newkey=$userkey;
- $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
- $$resourcedata{$newkey}=$$useropt{$userkey};
- }
- }
- }
+ $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
+ $$resourcedata{$newkey}=$$useropt{$userkey};
+ }
+ }
+ }
+ }
+ if (wantarray) {
+ return ($resourcedata,$classlist);
+ } else {
+ return $resourcedata;
}
- return $resourcedata;
}
@@ -3012,88 +2854,141 @@ sub storedata {
undef %newdata;
my @deldata=();
undef @deldata;
- foreach (keys %env) {
- if ($_=~/^form\.([a-z]+)\_(.+)$/) {
- my $cmd=$1;
- my $thiskey=$2;
- my ($tuname,$tudom)=&extractuser($thiskey);
- my $tkey=$thiskey;
+ my ($got_chostname,$chostname,$cmajor,$cminor);
+ my $now = time;
+ foreach my $key (keys(%env)) {
+ if ($key =~ /^form\.([a-z]+)\_(.+)$/) {
+ my $cmd=$1;
+ my $thiskey=$2;
+ my ($tuname,$tudom)=&extractuser($thiskey);
+ my $tkey=$thiskey;
+ if ($tuname) {
+ $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
+ }
+ if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
+ my ($data, $typeof, $text, $name, $valchk);
+ if ($cmd eq 'set') {
+ $data=$env{$key};
+ $valchk = $data;
+ $typeof=$env{'form.typeof_'.$thiskey};
+ $text = &mt('Saved modified parameter for');
+ if ($typeof eq 'string_questiontype') {
+ $name = 'type';
+ } elsif ($typeof eq 'string_lenient') {
+ $name = 'lenient';
+ } elsif ($typeof eq 'string_discussvote') {
+ $name = 'discussvote';
+ } elsif ($typeof eq 'string_examcode') {
+ $name = 'examcode';
+ if (&Apache::lonnet::validCODE($data)) {
+ $valchk = 'valid';
+ }
+ } elsif ($typeof eq 'string_yesno') {
+ if ($thiskey =~ /\.retrypartial$/) {
+ $name = 'retrypartial';
+ }
+ }
+ } elsif ($cmd eq 'datepointer') {
+ $data=&Apache::lonhtmlcommon::get_date_from_form($env{$key});
+ $typeof=$env{'form.typeof_'.$thiskey};
+ $text = &mt('Saved modified date for');
+ if ($typeof eq 'date_start') {
+ if ($thiskey =~ /\.printstartdate$/) {
+ $name = 'printstartdate';
+ if (($data) && ($data > $now)) {
+ $valchk = 'future';
+ }
+ }
+ } elsif ($typeof eq 'date_end') {
+ if ($thiskey =~ /\.printenddate$/) {
+ $name = 'printenddate';
+ if (($data) && ($data < $now)) {
+ $valchk = 'past';
+ }
+ }
+ }
+ } elsif ($cmd eq 'dateinterval') {
+ $data=&get_date_interval_from_form($thiskey);
+ $typeof=$env{'form.typeof_'.$thiskey};
+ $text = &mt('Saved modified date for');
+ }
+ if ($name ne '') {
+ my ($needsrelease,$needsnewer);
+ $needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk"};
+ if ($needsrelease) {
+ unless ($got_chostname) {
+ ($chostname,$cmajor,$cminor)=¶meter_release_vars();
+ $got_chostname = 1;
+ }
+ $needsnewer = ¶meter_releasecheck($name,$valchk,
+ $needsrelease,
+ $cmajor,$cminor);
+ if ($needsnewer) {
+ $r->print(' '.&oldversion_warning($name,$data,
+ $chostname,$cmajor,
+ $cminor,$needsrelease));
+ next;
+ }
+ }
+ }
+ if (defined($data) and $$olddata{$thiskey} ne $data) {
if ($tuname) {
- $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
- }
- if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
- my ($data, $typeof, $text);
- if ($cmd eq 'set') {
- $data=$env{$_};
- $typeof=$env{'form.typeof_'.$thiskey};
- $text = &mt('Saved modified parameter for');
- } elsif ($cmd eq 'datepointer') {
- $data=&Apache::lonhtmlcommon::get_date_from_form($env{$_});
- $typeof=$env{'form.typeof_'.$thiskey};
- $text = &mt('Saved modified date for');
- } elsif ($cmd eq 'dateinterval') {
- $data=&get_date_interval_from_form($thiskey);
- $typeof=$env{'form.typeof_'.$thiskey};
- $text = &mt('Saved modified date for');
- }
- if (defined($data) and $$olddata{$thiskey} ne $data) {
- if ($tuname) {
- if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
- $tkey.'.type' => $typeof},
- $tudom,$tuname) eq 'ok') {
- &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom);
- $r->print(' '.$text.' '.
- &Apache::loncommon::plainname($tuname,$tudom));
- } else {
- $r->print('