version 1.562, 2016/07/15 22:24:37
|
version 1.566, 2016/08/10 21:05:42
|
Line 367 sub endSettingsScreen {
|
Line 367 sub endSettingsScreen {
|
|
|
|
|
################################################## |
################################################## |
# TABLE MODE |
# (mostly) TABLE MODE |
# (parmval is also used for the log of parameter changes) |
# (parmval is also used for the log of parameter changes) |
################################################## |
################################################## |
|
|
# Calls parmval_by_symb, getting the symb from $id (the big hash resource id) with &symbcache. |
# Calls parmval_by_symb, getting the symb from $id with &symbcache. |
# |
# |
# @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight' |
# @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight' |
# @param {string} $id - big hash resource id |
# @param {string} $id - resource id or map pc |
# @param {string} $def - the resource's default value for this parameter |
# @param {string} $def - the resource's default value for this parameter |
# @param {string} $uname - user name |
# @param {string} $uname - user name |
# @param {string} $udom - user domain |
# @param {string} $udom - user domain |
Line 394 sub parmval {
|
Line 394 sub parmval {
|
# (level 1 is the most specific and will have precedence) |
# (level 1 is the most specific and will have precedence) |
# |
# |
# @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight' |
# @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight' |
# @param {string} $symb - resource symb |
# @param {string} $symb - resource symb or map src |
# @param {string} $def - the resource's default value for this parameter |
# @param {string} $def - the resource's default value for this parameter |
# @param {string} $uname - user name |
# @param {string} $uname - user name |
# @param {string} $udom - user domain |
# @param {string} $udom - user domain |
Line 597 sub reset_caches {
|
Line 597 sub reset_caches {
|
} |
} |
} |
} |
|
|
# cache big hash id -> symb, using lonnavmaps to find association |
# cache resource id or map pc -> resource symb or map src, using lonnavmaps to find association |
{ |
{ |
my $symbsid; # course identifier, to initialize the cache only once for a course |
my $symbsid; # course identifier, to initialize the cache only once for a course |
my %symbs; # hash id->symb |
my %symbs; # hash id->symb |
Line 607 sub reset_caches {
|
Line 607 sub reset_caches {
|
undef(%symbs); |
undef(%symbs); |
} |
} |
|
|
# returns the symb corresponding to a big hash id (using lonnavmaps and a cache) |
# returns the resource symb or map src corresponding to a resource id or map pc |
|
# (using lonnavmaps and a cache) |
sub symbcache { |
sub symbcache { |
my $id=shift; |
my $id=shift; |
if ($symbsid ne $env{'request.course.id'}) { |
if ($symbsid ne $env{'request.course.id'}) { |
Line 718 sub date_sanity_info {
|
Line 719 sub date_sanity_info {
|
|
|
# Store a parameter value and type by ID, also triggering more parameter changes based on parameter default actions. |
# Store a parameter value and type by ID, also triggering more parameter changes based on parameter default actions. |
# |
# |
# @param {string} $sresid - resource big hash id |
# @param {string} $sresid - resource id or map pc |
# @param {string} $spnam - part info and parameter name separated by a dot, e.g. '0.weight' |
# @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight' |
# @param {integer} $snum - level |
# @param {integer} $snum - level |
# @param {string} $nval - new value |
# @param {string} $nval - new value |
# @param {string} $ntype - new type |
# @param {string} $ntype - new type |
Line 737 my %recstack; # hash parameter name -> 1
|
Line 738 my %recstack; # hash parameter name -> 1
|
# Store a parameter value and type by symb, also triggering more parameter changes based on parameter default actions. |
# Store a parameter value and type by symb, also triggering more parameter changes based on parameter default actions. |
# Uses storeparm_by_symb_inner to actually store the parameter, ignoring any returned error. |
# Uses storeparm_by_symb_inner to actually store the parameter, ignoring any returned error. |
# |
# |
# @param {string} $symb - resource symb |
# @param {string} $symb - resource symb or map src |
# @param {string} $spnam - part info and parameter name separated by a dot, e.g. '0.weight' |
# @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight' |
# @param {integer} $snum - level |
# @param {integer} $snum - level |
# @param {string} $nval - new value |
# @param {string} $nval - new value |
# @param {string} $ntype - new type |
# @param {string} $ntype - new type |
Line 776 sub storeparm_by_symb {
|
Line 777 sub storeparm_by_symb {
|
# are there restrictions? |
# are there restrictions? |
if (&rulescache($triggered.'_triggervalue')=~/\w/) { |
if (&rulescache($triggered.'_triggervalue')=~/\w/) { |
$active=0; |
$active=0; |
foreach my $possiblevalue (split(/\s*\, |
foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) { |
\s*/,&rulescache($triggered.'_triggervalue'))) { |
|
if (lc($possiblevalue) eq lc($nval)) { $active=1; } |
if (lc($possiblevalue) eq lc($nval)) { $active=1; } |
} |
} |
} |
} |
Line 808 sub log_parmset {
|
Line 808 sub log_parmset {
|
# Store a parameter value and type by symb, without using the parameter default actions. |
# Store a parameter value and type by symb, without using the parameter default actions. |
# Expire related sheets. |
# Expire related sheets. |
# |
# |
# @param {string} $symb - resource symb |
# @param {string} $symb - resource symb or map src |
# @param {string} $spnam - part info and parameter name separated by a dot, e.g. '0.weight' |
# @param {string} $spnam - part info and parameter name separated by a dot, e.g. '0.weight' |
# @param {integer} $snum - level |
# @param {integer} $snum - level |
# @param {string} $nval - new value |
# @param {string} $nval - new value |
Line 1365 ENDHEAD
|
Line 1365 ENDHEAD
|
# @param {string} $which - parameter key ('parameter_'.part.'_'.name) |
# @param {string} $which - parameter key ('parameter_'.part.'_'.name) |
# @param {hash reference} $part - parameter key -> parameter part (can be problem part.'_'.response id for response parameters) |
# @param {hash reference} $part - parameter key -> parameter part (can be problem part.'_'.response id for response parameters) |
# @param {hash reference} $name - parameter key -> parameter name |
# @param {hash reference} $name - parameter key -> parameter name |
# @param {hash reference} $symbp - resource id -> symb |
# @param {hash reference} $symbp - map pc or resource/map id -> map src.'___(all)' or resource symb |
# @param {string} $rid - resource id |
# @param {string} $rid - resource id |
# @param {hash reference} $default - parameter key -> resource parameter default value |
# @param {hash reference} $default - parameter key -> resource parameter default value |
# @param {hash reference} $defaulttype - parameter key -> resource parameter default type |
# @param {hash reference} $defaulttype - parameter key -> resource parameter default type |
Line 1651 sub parm_control_group {
|
Line 1651 sub parm_control_group {
|
# Extracts lots of information about all of the the course's resources into a variety of hashes, using lonnavmaps and lonnet::metadata. |
# Extracts lots of information about all of the the course's resources into a variety of hashes, using lonnavmaps and lonnet::metadata. |
# All the parameters are references and are filled by the sub. |
# All the parameters are references and are filled by the sub. |
# |
# |
# @param {array reference} $ids - resource ids |
# @param {array reference} $ids - resource and map ids |
# @param {hash reference} $typep - hash resource id (from big hash) -> resource type (file extension) |
# @param {hash reference} $typep - hash resource/map id -> resource type (file extension) |
# @param {hash reference} $keyp - hash resource id -> comma-separated list of parameter keys from lonnet::metadata |
# @param {hash reference} $keyp - hash resource/map id -> comma-separated list of parameter keys from lonnet::metadata |
# @param {hash reference} $allparms - hash parameter name -> parameter title |
# @param {hash reference} $allparms - hash parameter name -> parameter title |
# @param {hash reference} $allparts - hash parameter part -> part title (a parameter part can be problem part.'_'.response id for response parameters) |
# @param {hash reference} $allparts - hash parameter part -> part title (a parameter part can be problem part.'_'.response id for response parameters) |
# @param {hash reference} $allmaps - hash map id (from big hash) -> map src |
# @param {hash reference} $allmaps - hash map pc -> map src |
# @param {hash reference} $mapp - hash resource id -> enclosing map src |
# @param {hash reference} $mapp - hash map pc or resource/map id -> enclosing map src |
# @param {hash reference} $symbp - hash map id or resource id -> map src.'___(all)' for a map or resource symb for a resource |
# @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' for a map or resource symb for a resource |
# @param {hash reference} $maptitles - hash map id or src -> map title (this should really be two separate hashes) |
# @param {hash reference} $maptitles - hash map pc or src -> map title (this should really be two separate hashes) |
# @param {hash reference} $uris - hash resource id -> resource src |
# @param {hash reference} $uris - hash resource/map id -> resource src |
# @param {hash reference} $keyorder - hash parameter key -> appearance rank for this parameter when looking through every resource and every parameter, starting at 100 (integer) |
# @param {hash reference} $keyorder - hash parameter key -> appearance rank for this parameter when looking through every resource and every parameter, starting at 100 (integer) |
# @param {hash reference} $defkeytype - hash parameter name -> parameter type |
# @param {hash reference} $defkeytype - hash parameter name -> parameter type |
sub extractResourceInformation { |
sub extractResourceInformation { |
Line 2261 sub displaymenu {
|
Line 2261 sub displaymenu {
|
# Used by table mode and overview mode. |
# Used by table mode and overview mode. |
# |
# |
# @param {Apache2::RequestRec} $r - the Apache request |
# @param {Apache2::RequestRec} $r - the Apache request |
# @param {hash reference} $allmaps - hash map id -> map src |
# @param {hash reference} $allmaps - hash map pc -> map src |
# @param {string} $pschp - selected map id, or 'all' |
# @param {string} $pschp - selected map pc, or 'all' |
# @param {hash reference} $maptitles - hash map id or src -> map title |
# @param {hash reference} $maptitles - hash map id or src -> map title |
# @param {hash reference} $symbp - hash map id or resource id -> map src.'___(all)' for a map or resource symb for a resource |
# @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb |
sub mapmenu { |
sub mapmenu { |
my ($r,$allmaps,$pschp,$maptitles,$symbp)=@_; |
my ($r,$allmaps,$pschp,$maptitles,$symbp)=@_; |
my %allmaps_inverted = reverse %$allmaps; |
my %allmaps_inverted = reverse %$allmaps; |
Line 2416 sub mapmenu {
|
Line 2416 sub mapmenu {
|
} |
} |
} |
} |
|
|
# Build up the select Box to choose if your parameter specification should work for the resource, map/folder or the course level |
# Prints HTML to select the parameter level (resource, map/folder or course). |
# The value of default selection in the select box is set by the value that is given by the argument in $parmlev. |
# Used by table and overview modes. |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
|
# @param {hash reference} $alllevs - all parameter levels, hash English title -> value |
|
# @param {string} $parmlev - selected level value (full|map|general), or '' |
sub levelmenu { |
sub levelmenu { |
my ($r,$alllevs,$parmlev)=@_; |
my ($r,$alllevs,$parmlev)=@_; |
|
|
Line 2435 sub levelmenu {
|
Line 2439 sub levelmenu {
|
} |
} |
|
|
|
|
|
# Returns HTML to select a section (with a select HTML element). |
|
# Used by overview mode. |
|
# |
|
# @param {array reference} $selectedsections - list of selected section ids |
|
# @returns {string} |
sub sectionmenu { |
sub sectionmenu { |
my ($selectedsections)=@_; |
my ($selectedsections)=@_; |
my %sectionhash = &Apache::loncommon::get_sections(); |
my %sectionhash = &Apache::loncommon::get_sections(); |
Line 2460 sub sectionmenu {
|
Line 2469 sub sectionmenu {
|
return $output; |
return $output; |
} |
} |
|
|
|
# Returns HTML to select a group (with a select HTML element). |
|
# Used by overview mode. |
|
# |
|
# @param {array reference} $selectedgroups - list of selected group names |
|
# @returns {string} |
sub groupmenu { |
sub groupmenu { |
my ($selectedgroups)=@_; |
my ($selectedgroups)=@_; |
my %grouphash; |
my %grouphash; |
Line 2482 sub groupmenu {
|
Line 2496 sub groupmenu {
|
return $output; |
return $output; |
} |
} |
|
|
|
# Returns an array with the given parameter split by comma. |
|
# Used by assessparms (table mode). |
|
# |
|
# @param {string} $keyp - the string to split |
|
# @returns {Array<string>} |
sub keysplit { |
sub keysplit { |
my $keyp=shift; |
my $keyp=shift; |
return (split(/\,/,$keyp)); |
return (split(/\,/,$keyp)); |
} |
} |
|
|
|
# Returns the keys in $name, sorted using $keyorder. |
|
# Parameters are sorted by key, which means they are sorted by part first, then by name. |
|
# Used by assessparms (table mode) for resource level. |
|
# |
|
# @param {hash reference} $name - parameter key -> parameter name |
|
# @param {hash reference} $keyorder - hash parameter key -> appearance rank |
|
# @returns {Array<string>} |
sub keysinorder { |
sub keysinorder { |
my ($name,$keyorder)=@_; |
my ($name,$keyorder)=@_; |
return sort { |
return sort { |
Line 2494 sub keysinorder {
|
Line 2520 sub keysinorder {
|
} (keys(%{$name})); |
} (keys(%{$name})); |
} |
} |
|
|
|
# Returns the keys in $name, sorted using $keyorder to sort parameters by name first, then by part. |
|
# Used by assessparms (table mode) for map and general levels. |
|
# |
|
# @param {hash reference} $name - parameter key -> parameter name |
|
# @param {hash reference} $keyorder - hash parameter key -> appearance rank |
|
# @returns {Array<string>} |
sub keysinorder_bytype { |
sub keysinorder_bytype { |
my ($name,$keyorder)=@_; |
my ($name,$keyorder)=@_; |
return sort { |
return sort { |
my $ta=(split('_',$a))[-1]; |
my $ta=(split('_',$a))[-1]; # parameter name |
my $tb=(split('_',$b))[-1]; |
my $tb=(split('_',$b))[-1]; |
if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) { |
if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) { |
return ($a cmp $b); |
return ($a cmp $b); |
Line 2506 sub keysinorder_bytype {
|
Line 2538 sub keysinorder_bytype {
|
} (keys(%{$name})); |
} (keys(%{$name})); |
} |
} |
|
|
|
# Returns the keys in $name, sorted using $keyorder to sort parameters by name. |
|
# Used by defaultsetter (parameter settings default actions). |
|
# |
|
# @param {hash reference} $name - hash parameter name -> parameter title |
|
# @param {hash reference} $keyorder - hash parameter key -> appearance rank |
|
# @returns {Array<string>} |
sub keysindisplayorder { |
sub keysindisplayorder { |
my ($name,$keyorder)=@_; |
my ($name,$keyorder)=@_; |
return sort { |
return sort { |
Line 2513 sub keysindisplayorder {
|
Line 2551 sub keysindisplayorder {
|
} (keys(%{$name})); |
} (keys(%{$name})); |
} |
} |
|
|
|
# Prints HTML with a choice to sort results by realm or student first. |
|
# Used by overview mode. |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
|
# @param {string} $sortorder - realmstudent|studentrealm |
sub sortmenu { |
sub sortmenu { |
my ($r,$sortorder)=@_; |
my ($r,$sortorder)=@_; |
$r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"'); |
$r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"'); |
Line 2528 sub sortmenu {
|
Line 2571 sub sortmenu {
|
'</label>'); |
'</label>'); |
} |
} |
|
|
|
# Returns a hash parameter key -> order (integer) giving the order for some parameters. |
|
# |
|
# @returns {hash} |
sub standardkeyorder { |
sub standardkeyorder { |
return ('parameter_0_opendate' => 1, |
return ('parameter_0_opendate' => 1, |
'parameter_0_duedate' => 2, |
'parameter_0_duedate' => 2, |
Line 2556 sub standardkeyorder {
|
Line 2602 sub standardkeyorder {
|
|
|
|
|
# Table mode UI. |
# Table mode UI. |
|
# If nothing is selected, prints HTML forms to select resources, parts, parameters, user, group and section. |
|
# Otherwise, prints the parameter table, with a link to change the selection unless a single resource is selected. |
|
# |
|
# Parameters used from the request: |
|
# action - handler action (see handler), usermenu is checking for value 'settable' |
|
# cgroup - selected group |
|
# command - 'set': direct access to table mode for a resource |
|
# csec - selected section |
|
# dis - set when the "Update Display" button was used, used only to discard command 'set' |
|
# hideparmsel - can be 'hidden' to hide the parameter selection div initially and display the "Change Parameter Selection" link instead (which displays the div) |
|
# id - student/employee ID |
|
# parmlev - selected level (full|map|general) |
|
# part - selected part (unused ?) |
|
# pres_marker - &&&-separated parameter identifiers, "resource id&part_parameter name&level" |
|
# pres_type - &&&-separated parameter types |
|
# pres_value - &&&-separated parameter values |
|
# prevvisit - '1' if the user has submitted the form before |
|
# pscat (multiple values) - selected parameter names |
|
# pschp - selected map pc, or 'all' |
|
# psprt (multiple values) - list of selected parameter parts |
|
# filter - part of or whole parameter name, to be filtered out when parameters are displayed (unused ?) |
|
# recent_* (* = parameter type) - recent values entered by the user for parameter types |
|
# symb - resource symb (when a single resource is selected) |
|
# udom - selected user domain |
|
# uname - selected user name |
|
# url - used only with command 'set', the resource url |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
sub assessparms { |
sub assessparms { |
|
|
my $r=shift; |
my $r=shift; |
|
|
|
|
# -------------------------------------------------------- Variable declaration |
# -------------------------------------------------------- Variable declaration |
my @ids=(); |
my @ids=(); # resource and map ids |
my %symbp=(); |
my %symbp=(); # hash map pc or resource/map id -> map src.'___(all)' or resource symb |
my %mapp=(); |
my %mapp=(); # hash map pc or resource/map id -> enclosing map src |
my %typep=(); |
my %typep=(); # hash resource/map id -> resource type (file extension) |
my %keyp=(); |
my %keyp=(); # hash resource/map id -> comma-separated list of parameter keys |
my %uris=(); |
my %uris=(); # hash resource/map id -> resource src |
my %maptitles=(); |
my %maptitles=(); # hash map pc or src -> map title |
my %allmaps=(); |
my %allmaps=(); # hash map pc -> map src |
my %alllevs=(); |
my %alllevs=(); # hash English level title -> value |
|
|
my $uname; |
my $uname; # selected user name |
my $udom; |
my $udom; # selected user domain |
my $uhome; |
my $uhome; # server with the user's files, or 'no_host' |
my $csec; |
my $csec; # selected section name |
my $cgroup; |
my $cgroup; # selected group name |
my @usersgroups = (); |
my @usersgroups = (); # list of the user groups |
|
|
my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'}; |
my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'}; |
|
|
Line 2585 sub assessparms {
|
Line 2659 sub assessparms {
|
$alllevs{'Map/Folder Level'}='map'; |
$alllevs{'Map/Folder Level'}='map'; |
$alllevs{'Course Level'}='general'; |
$alllevs{'Course Level'}='general'; |
|
|
my %allparms; |
my %allparms; # hash parameter name -> parameter title |
my %allparts; |
my %allparts; # hash parameter part -> part title |
# ------------------------------------------------------------------------------ |
# ------------------------------------------------------------------------------ |
|
|
# |
# |
Line 2890 sub assessparms {
|
Line 2964 sub assessparms {
|
} |
} |
} |
} |
#----------------------------------------------- if all selected, fill in array |
#----------------------------------------------- if all selected, fill in array |
if ($pscat[0] eq "all") {@pscat = (keys(%allparms));} |
if ($pscat[0] eq "all") { |
if (!@pscat) { @pscat=('duedate','opendate','answerdate','weight','maxtries','type','problemstatus') }; |
@pscat = (keys(%allparms)); |
if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys(%allparts));} |
} |
|
if (!@pscat) { |
|
@pscat=('duedate','opendate','answerdate','weight','maxtries','type','problemstatus') |
|
}; |
|
if ($psprt[0] eq "all" || !@psprt) { |
|
@psprt = (keys(%allparts)); |
|
} |
# ------------------------------------------------------------------ Start page |
# ------------------------------------------------------------------ Start page |
|
|
my $crstype = &Apache::loncommon::course_type(); |
my $crstype = &Apache::loncommon::course_type(); |
&startpage($r,$pssymb,$crstype); |
&startpage($r,$pssymb,$crstype); |
|
|
foreach my $item ('tolerance','date_default','date_start','date_end', |
foreach my $item ('tolerance','date_default','date_start','date_end', |
'date_interval','int','float','string') { |
'date_interval','int','float','string') { |
$r->print('<input type="hidden" value="'. |
$r->print('<input type="hidden" value="'. |
&HTML::Entities::encode($env{'form.recent_'.$item},'"&<>'). |
&HTML::Entities::encode($env{'form.recent_'.$item},'"&<>'). |
'" name="recent_'.$item.'" />'); |
'" name="recent_'.$item.'" />'); |
} |
} |
|
|
# ----- Start Parameter Selection |
# ----- Start Parameter Selection |
Line 2920 function parmsel_show() {
|
Line 3000 function parmsel_show() {
|
ENDPARMSELSCRIPT |
ENDPARMSELSCRIPT |
|
|
if (!$pssymb) { |
if (!$pssymb) { |
|
# No single resource selected, print forms to select things (hidden after first selection) |
my $parmselhiddenstyle=' style="display:none"'; |
my $parmselhiddenstyle=' style="display:none"'; |
if($env{'form.hideparmsel'} eq 'hidden') { |
if($env{'form.hideparmsel'} eq 'hidden') { |
$r->print('<div id="parmsel"'.$parmselhiddenstyle.'>'); |
$r->print('<div id="parmsel"'.$parmselhiddenstyle.'>'); |
Line 3429 ENDMAPONE
|
Line 3510 ENDMAPONE
|
################################################## |
################################################## |
# OVERVIEW MODE |
# OVERVIEW MODE |
################################################## |
################################################## |
my $tableopen; |
|
|
|
|
my $tableopen; # boolean, true if HTML table is already opened |
|
|
|
# Returns HTML with the HTML table start tag and header, unless the table is already opened. |
|
# @param {boolean} $readonly - true if values cannot be edited (otherwise more columns are added) |
|
# @returns {string} |
sub tablestart { |
sub tablestart { |
my ($readonly) = @_; |
my ($readonly) = @_; |
if ($tableopen) { |
if ($tableopen) { |
Line 3448 sub tablestart {
|
Line 3533 sub tablestart {
|
} |
} |
} |
} |
|
|
|
# Returns HTML with the HTML table end tag, unless the table is not opened. |
|
# @returns {string} |
sub tableend { |
sub tableend { |
if ($tableopen) { |
if ($tableopen) { |
$tableopen=0; |
$tableopen=0; |
Line 3457 sub tableend {
|
Line 3544 sub tableend {
|
} |
} |
} |
} |
|
|
|
# Reads course and user information. |
|
# If the context is looking for a scalar, returns the course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db) with added student data from lonnet::get_userresdata (which reads the user's resourcedata.db). |
|
# The key for student data is modified with '[useropt:'.username.':'.userdomain.'].'. |
|
# If the context is looking for a list, returns a list with the scalar data and the class list. |
|
# @param {string} $crs - course number |
|
# @param {string} $dom - course domain |
|
# @returns {hash reference|Array} |
sub readdata { |
sub readdata { |
my ($crs,$dom)=@_; |
my ($crs,$dom)=@_; |
# Read coursedata |
# Read coursedata |
Line 3485 sub readdata {
|
Line 3579 sub readdata {
|
} |
} |
|
|
|
|
# Setting |
# Stores parameter data, using form parameters directly. |
|
# |
|
# Uses the following form parameters. The variable part in the names is a resourcedata key (except for a modification for user data). |
|
# set_* (except settext, setipallow, setipdeny) - set a parameter value |
|
# del_* - remove a parameter |
|
# datepointer_* - set a date parameter (value is key_* refering to a set of other form parameters) |
|
# dateinterval_* - set a date interval parameter (value refers to more form parameters) |
|
# key_* - date values |
|
# days_* - for date intervals |
|
# hours_* - for date intervals |
|
# minutes_* - for date intervals |
|
# seconds_* - for date intervals |
|
# done_* - for date intervals |
|
# typeof_* - parameter type |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
|
# @param {string} $crs - course number |
|
# @param {string} $dom - course domain |
sub storedata { |
sub storedata { |
my ($r,$crs,$dom)=@_; |
my ($r,$crs,$dom)=@_; |
# Set userlevel immediately |
# Set userlevel immediately |
Line 3509 sub storedata {
|
Line 3619 sub storedata {
|
$tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./; |
$tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./; |
} |
} |
if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') { |
if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') { |
my ($data, $typeof, $text, $name, $valchk, $valmatch, $namematch); |
my ($data, $typeof, $text, $name, $valchk, $valmatch, $namematch); |
if ($cmd eq 'set') { |
if ($cmd eq 'set') { |
$data=$env{$key}; |
$data=$env{$key}; |
$valmatch = ''; |
$valmatch = ''; |
$valchk = $data; |
$valchk = $data; |
$typeof=$env{'form.typeof_'.$thiskey}; |
$typeof=$env{'form.typeof_'.$thiskey}; |
$text = &mt('Saved modified parameter for'); |
$text = &mt('Saved modified parameter for'); |
if ($typeof eq 'string_questiontype') { |
if ($typeof eq 'string_questiontype') { |
$name = 'type'; |
$name = 'type'; |
} elsif ($typeof eq 'string_lenient') { |
} elsif ($typeof eq 'string_lenient') { |
$name = 'lenient'; |
$name = 'lenient'; |
my $stringmatch = &standard_string_matches($typeof); |
my $stringmatch = &standard_string_matches($typeof); |
if (ref($stringmatch) eq 'ARRAY') { |
if (ref($stringmatch) eq 'ARRAY') { |
foreach my $item (@{$stringmatch}) { |
foreach my $item (@{$stringmatch}) { |
if (ref($item) eq 'ARRAY') { |
if (ref($item) eq 'ARRAY') { |
my ($regexpname,$pattern) = @{$item}; |
my ($regexpname,$pattern) = @{$item}; |
if ($pattern ne '') { |
if ($pattern ne '') { |
if ($data =~ /$pattern/) { |
if ($data =~ /$pattern/) { |
$valmatch = $regexpname; |
$valmatch = $regexpname; |
$valchk = ''; |
$valchk = ''; |
last; |
last; |
|
} |
} |
} |
} |
} |
} |
} |
} |
} |
} |
} elsif ($typeof eq 'string_discussvote') { |
} elsif ($typeof eq 'string_discussvote') { |
$name = 'discussvote'; |
$name = 'discussvote'; |
} elsif ($typeof eq 'string_examcode') { |
} elsif ($typeof eq 'string_examcode') { |
$name = 'examcode'; |
$name = 'examcode'; |
if (&Apache::lonnet::validCODE($data)) { |
if (&Apache::lonnet::validCODE($data)) { |
$valchk = 'valid'; |
$valchk = 'valid'; |
} |
} |
} elsif ($typeof eq 'string_yesno') { |
} elsif ($typeof eq 'string_yesno') { |
if ($thiskey =~ /\.retrypartial$/) { |
if ($thiskey =~ /\.retrypartial$/) { |
$name = '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') { |
} elsif ($cmd eq 'datepointer') { |
if ($thiskey =~ /\.printenddate$/) { |
$data=&Apache::lonhtmlcommon::get_date_from_form($env{$key}); |
$name = 'printenddate'; |
$typeof=$env{'form.typeof_'.$thiskey}; |
if (($data) && ($data < $now)) { |
$text = &mt('Saved modified date for'); |
$valchk = 'past'; |
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') { |
} elsif ($cmd eq 'dateinterval') { |
$data=&get_date_interval_from_form($thiskey); |
$data=&get_date_interval_from_form($thiskey); |
if ($thiskey =~ /\.interval$/) { |
if ($thiskey =~ /\.interval$/) { |
$name = 'interval'; |
$name = 'interval'; |
my $intervaltype = &get_intervaltype($name); |
my $intervaltype = &get_intervaltype($name); |
my $intervalmatch = &standard_interval_matches($intervaltype); |
my $intervalmatch = &standard_interval_matches($intervaltype); |
if (ref($intervalmatch) eq 'ARRAY') { |
if (ref($intervalmatch) eq 'ARRAY') { |
foreach my $item (@{$intervalmatch}) { |
foreach my $item (@{$intervalmatch}) { |
if (ref($item) eq 'ARRAY') { |
if (ref($item) eq 'ARRAY') { |
my ($regexpname,$pattern) = @{$item}; |
my ($regexpname,$pattern) = @{$item}; |
if ($pattern ne '') { |
if ($pattern ne '') { |
if ($data =~ /$pattern/) { |
if ($data =~ /$pattern/) { |
$valmatch = $regexpname; |
$valmatch = $regexpname; |
$valchk = ''; |
$valchk = ''; |
last; |
last; |
} |
} |
} |
} |
} |
} |
} |
} |
} |
} |
} |
|
$typeof=$env{'form.typeof_'.$thiskey}; |
|
$text = &mt('Saved modified date for'); |
} |
} |
$typeof=$env{'form.typeof_'.$thiskey}; |
if ($thiskey =~ m{\.(?:sequence|page)___\(rec\)}) { |
$text = &mt('Saved modified date for'); |
$namematch = 'maplevelrecurse'; |
} |
|
if ($thiskey =~ m{\.(?:sequence|page)___\(rec\)}) { |
|
$namematch = 'maplevelrecurse'; |
|
} |
|
if (($name ne '') || ($namematch ne '')) { |
|
my ($needsrelease,$needsnewer); |
|
if ($name ne '') { |
|
$needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk:$valmatch:"}; |
|
if ($needsrelease) { |
|
unless ($got_chostname) { |
|
($chostname,$cmajor,$cminor)=¶meter_release_vars(); |
|
$got_chostname = 1; |
|
} |
|
$needsnewer = ¶meter_releasecheck($name,$valchk,$valmatch,undef, |
|
$needsrelease, |
|
$cmajor,$cminor); |
|
} |
|
} |
} |
if ($namematch ne '') { |
if (($name ne '') || ($namematch ne '')) { |
if ($needsnewer) { |
my ($needsrelease,$needsnewer); |
undef($namematch); |
if ($name ne '') { |
} else { |
$needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk:$valmatch:"}; |
my $currneeded; |
|
if ($needsrelease) { |
if ($needsrelease) { |
$currneeded = $needsrelease; |
|
} |
|
$needsrelease = |
|
$Apache::lonnet::needsrelease{"parameter::::$namematch"}; |
|
if (($needsrelease) && (($currneeded eq '') || ($needsrelease < $currneeded))) { |
|
unless ($got_chostname) { |
unless ($got_chostname) { |
($chostname,$cmajor,$cminor) = ¶meter_release_vars(); |
($chostname,$cmajor,$cminor)=¶meter_release_vars(); |
$got_chostname = 1; |
$got_chostname = 1; |
} |
} |
$needsnewer = ¶meter_releasecheck(undef,$valchk,$valmatch,$namematch, |
$needsnewer = ¶meter_releasecheck($name,$valchk,$valmatch,undef, |
$needsrelease,$cmajor,$cminor); |
$needsrelease, |
} else { |
$cmajor,$cminor); |
|
} |
|
} |
|
if ($namematch ne '') { |
|
if ($needsnewer) { |
undef($namematch); |
undef($namematch); |
|
} else { |
|
my $currneeded; |
|
if ($needsrelease) { |
|
$currneeded = $needsrelease; |
|
} |
|
$needsrelease = |
|
$Apache::lonnet::needsrelease{"parameter::::$namematch"}; |
|
if (($needsrelease) && |
|
(($currneeded eq '') || ($needsrelease < $currneeded))) { |
|
unless ($got_chostname) { |
|
($chostname,$cmajor,$cminor) = ¶meter_release_vars(); |
|
$got_chostname = 1; |
|
} |
|
$needsnewer = ¶meter_releasecheck(undef,$valchk,$valmatch, |
|
$namematch, $needsrelease,$cmajor,$cminor); |
|
} else { |
|
undef($namematch); |
|
} |
} |
} |
} |
} |
|
if ($needsnewer) { |
|
$r->print('<br />'.&oldversion_warning($name,$namematch,$data, |
|
$chostname,$cmajor, |
|
$cminor,$needsrelease)); |
|
next; |
|
} |
} |
} |
if ($needsnewer) { |
if (defined($data) and $$olddata{$thiskey} ne $data) { |
$r->print('<br />'.&oldversion_warning($name,$namematch,$data, |
if ($tuname) { |
$chostname,$cmajor, |
if (&Apache::lonnet::put('resourcedata',{$tkey=>$data, |
$cminor,$needsrelease)); |
$tkey.'.type' => $typeof}, |
next; |
$tudom,$tuname) eq 'ok') { |
} |
&log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom); |
} |
$r->print('<br />'.$text.' '. |
if (defined($data) and $$olddata{$thiskey} ne $data) { |
&Apache::loncommon::plainname($tuname,$tudom)); |
if ($tuname) { |
} else { |
if (&Apache::lonnet::put('resourcedata',{$tkey=>$data, |
$r->print('<div class="LC_error">'. |
$tkey.'.type' => $typeof}, |
&mt('Error saving parameters').'</div>'); |
$tudom,$tuname) eq 'ok') { |
} |
&log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom); |
&Apache::lonnet::devalidateuserresdata($tuname,$tudom); |
$r->print('<br />'.$text.' '. |
|
&Apache::loncommon::plainname($tuname,$tudom)); |
|
} else { |
} else { |
$r->print('<div class="LC_error">'. |
$newdata{$thiskey}=$data; |
&mt('Error saving parameters').'</div>'); |
$newdata{$thiskey.'.type'}=$typeof; |
} |
} |
&Apache::lonnet::devalidateuserresdata($tuname,$tudom); |
|
} else { |
|
$newdata{$thiskey}=$data; |
|
$newdata{$thiskey.'.type'}=$typeof; |
|
} |
} |
} |
|
} elsif ($cmd eq 'del') { |
} elsif ($cmd eq 'del') { |
if ($tuname) { |
if ($tuname) { |
if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') { |
if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') { |
Line 3697 sub storedata {
|
Line 3808 sub storedata {
|
} |
} |
} |
} |
|
|
|
# Returns the username and domain from a key created in readdata from a resourcedata key. |
|
# |
|
# @param {string} $key - the key |
|
# @returns {Array} |
sub extractuser { |
sub extractuser { |
my $key=shift; |
my $key=shift; |
return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./); |
return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./); |
} |
} |
|
|
|
# Parses a parameter key and returns the components. |
|
# |
|
# @param {string} $key - |
|
# @param {hash reference} $listdata - |
|
# @return {Array} - (student, resource, part, parameter) |
sub parse_listdata_key { |
sub parse_listdata_key { |
my ($key,$listdata) = @_; |
my ($key,$listdata) = @_; |
# split into student/section affected, and |
# split into student/section affected, and |
Line 3722 sub parse_listdata_key {
|
Line 3842 sub parse_listdata_key {
|
return ($student,$res,$part,$parm); |
return ($student,$res,$part,$parm); |
} |
} |
|
|
# Displays forms for the given data in overview mode (newoverview or overview). |
# Prints HTML with forms for the given parameter data in overview mode (newoverview or overview). |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
|
# @param {hash reference} $resourcedata - parameter data returned by readdata |
|
# @param {hash reference} $listdata - data created in secgroup_lister, course id.[section id].part.name -> 1 or course id.[section id].part.name.type -> parameter type |
|
# @param {string} $sortorder - realmstudent|studentrealm |
|
# @param {string} $caller - name of the calling sub (overview|newoverview) |
|
# @param {hash reference} $classlist - from loncoursedata::get_classlist |
|
# @returns{integer} - number of $listdata parameters processed |
sub listdata { |
sub listdata { |
my ($r,$resourcedata,$listdata,$sortorder,$caller,$classlist)=@_; |
my ($r,$resourcedata,$listdata,$sortorder,$caller,$classlist)=@_; |
|
|
Line 3925 sub listdata {
|
Line 4053 sub listdata {
|
return $foundkeys; |
return $foundkeys; |
} |
} |
|
|
|
# Returns a string representing the interval, directly using form data matching the given key. |
|
# The returned string may also include information related to proctored exams. |
|
# Format: seconds['_done'[':'done button title':']['_proctor'['_'proctor key]]] |
|
# |
|
# @param {string} $key - suffix for form fields related to the interval |
|
# @returns {string} |
sub get_date_interval_from_form { |
sub get_date_interval_from_form { |
my ($key) = @_; |
my ($key) = @_; |
my $seconds = 0; |
my $seconds = 0; |
Line 3957 sub get_date_interval_from_form {
|
Line 4091 sub get_date_interval_from_form {
|
} |
} |
|
|
|
|
|
# Returns HTML to enter a text value for a parameter. |
|
# |
|
# @param {string} $thiskey - parameter key |
|
# @param {string} $showval - the current value |
|
# @param {boolean} $readonly - true if the field should not be made editable |
|
# @returns {string} |
sub default_selector { |
sub default_selector { |
my ($thiskey, $showval, $readonly) = @_; |
my ($thiskey, $showval, $readonly) = @_; |
my $disabled; |
my $disabled; |
Line 3966 sub default_selector {
|
Line 4106 sub default_selector {
|
return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'"'.$disabled.' />'; |
return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'"'.$disabled.' />'; |
} |
} |
|
|
|
# Returns HTML to enter allow/deny rules related to IP addresses. |
|
# |
|
# @param {string} $thiskey - parameter key |
|
# @param {string} $showval - the current value |
|
# @param {boolean} $readonly - true if the fields should not be made editable |
|
# @returns {string} |
sub string_ip_selector { |
sub string_ip_selector { |
my ($thiskey, $showval, $readonly) = @_; |
my ($thiskey, $showval, $readonly) = @_; |
my %access = ( |
my %access = ( |
Line 4079 my %stringtypes = (
|
Line 4225 my %stringtypes = (
|
acc => 'string_ip', |
acc => 'string_ip', |
); |
); |
|
|
|
# Returns the possible values and titles for a given string type, or undef if there are none. |
|
# Used by courseprefs. |
|
# |
|
# @param {string} $string_type - a parameter type for strings |
|
# @returns {array reference} - 2D array, containing values and English titles |
sub standard_string_options { |
sub standard_string_options { |
my ($string_type) = @_; |
my ($string_type) = @_; |
if (ref($strings{$string_type}) eq 'ARRAY') { |
if (ref($strings{$string_type}) eq 'ARRAY') { |
Line 4087 sub standard_string_options {
|
Line 4238 sub standard_string_options {
|
return; |
return; |
} |
} |
|
|
|
# Returns regular expressions to match kinds of string types, or undef if there are none. |
|
# |
|
# @param {string} $string_type - a parameter type for strings |
|
# @returns {array reference} - 2D array, containing regular expression names and regular expressions |
sub standard_string_matches { |
sub standard_string_matches { |
my ($string_type) = @_; |
my ($string_type) = @_; |
if (ref($stringmatches{$string_type}) eq 'ARRAY') { |
if (ref($stringmatches{$string_type}) eq 'ARRAY') { |
Line 4095 sub standard_string_matches {
|
Line 4250 sub standard_string_matches {
|
return; |
return; |
} |
} |
|
|
|
# Returns a parameter type for a given parameter with a string type, or undef if not known. |
|
# |
|
# @param {string} $name - parameter name |
|
# @returns {string} |
sub get_stringtype { |
sub get_stringtype { |
my ($name) = @_; |
my ($name) = @_; |
if (exists($stringtypes{$name})) { |
if (exists($stringtypes{$name})) { |
Line 4103 sub get_stringtype {
|
Line 4262 sub get_stringtype {
|
return; |
return; |
} |
} |
|
|
|
# Returns HTML to edit a string parameter. |
|
# |
|
# @param {string} $thistype - parameter type |
|
# @param {string} $thiskey - parameter key |
|
# @param {string} $showval - parameter current value |
|
# @param {string} $name - parameter name |
|
# @param {boolean} $readonly - true if the values should not be made editable |
|
# @returns {string} |
sub string_selector { |
sub string_selector { |
my ($thistype, $thiskey, $showval, $name, $readonly) = @_; |
my ($thistype, $thiskey, $showval, $name, $readonly) = @_; |
|
|
Line 4268 my %intervaltypes = (
|
Line 4435 my %intervaltypes = (
|
interval => 'date_interval', |
interval => 'date_interval', |
); |
); |
|
|
|
# Returns regular expressions to match kinds of interval type, or undef if there are none. |
|
# |
|
# @param {string} $interval_type - a parameter type for intervals |
|
# @returns {array reference} - 2D array, containing regular expression names and regular expressions |
sub standard_interval_matches { |
sub standard_interval_matches { |
my ($interval_type) = @_; |
my ($interval_type) = @_; |
if (ref($intervalmatches{$interval_type}) eq 'ARRAY') { |
if (ref($intervalmatches{$interval_type}) eq 'ARRAY') { |
Line 4276 sub standard_interval_matches {
|
Line 4447 sub standard_interval_matches {
|
return; |
return; |
} |
} |
|
|
|
# Returns a parameter type for a given parameter with an interval type, or undef if not known. |
|
# |
|
# @param {string} $name - parameter name |
|
# @returns {string} |
sub get_intervaltype { |
sub get_intervaltype { |
my ($name) = @_; |
my ($name) = @_; |
if (exists($intervaltypes{$name})) { |
if (exists($intervaltypes{$name})) { |
Line 4284 sub get_intervaltype {
|
Line 4459 sub get_intervaltype {
|
return; |
return; |
} |
} |
|
|
|
# Returns the possible values and titles for a given interval type, or undef if there are none. |
|
# Used by courseprefs. |
|
# |
|
# @param {string} $interval_type - a parameter type for intervals |
|
# @returns {array reference} - 2D array, containing values and English titles |
sub standard_interval_options { |
sub standard_interval_options { |
my ($interval_type) = @_; |
my ($interval_type) = @_; |
if (ref($intervals{$interval_type}) eq 'ARRAY') { |
if (ref($intervals{$interval_type}) eq 'ARRAY') { |
Line 4292 sub standard_interval_options {
|
Line 4472 sub standard_interval_options {
|
return; |
return; |
} |
} |
|
|
|
# Returns HTML to edit a date interval parameter. |
|
# |
|
# @param {string} $thiskey - parameter key |
|
# @param {string} $name - parameter name |
|
# @param {string} $showval - parameter current value |
|
# @param {boolean} $readonly - true if the values should not be made editable |
|
# @returns {string} |
sub date_interval_selector { |
sub date_interval_selector { |
my ($thiskey, $name, $showval, $readonly) = @_; |
my ($thiskey, $name, $showval, $readonly) = @_; |
my ($result,%skipval); |
my ($result,%skipval); |
Line 4393 sub date_interval_selector {
|
Line 4580 sub date_interval_selector {
|
return $result; |
return $result; |
} |
} |
|
|
|
# Returns HTML with a warning if a parameter requires a more recent version of LON-CAPA. |
|
# |
|
# @param {string} $name - parameter name |
|
# @param {string} $namematch - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel) |
|
# @param {string} $value - parameter value |
|
# @param {string} $chostname - course server name |
|
# @param {integer} $cmajor - major version number |
|
# @param {integer} $cminor - minor version number |
|
# @param {string} $needsrelease - release version needed (major.minor) |
|
# @returns {string} |
sub oldversion_warning { |
sub oldversion_warning { |
my ($name,$namematch,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_; |
my ($name,$namematch,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_; |
my $standard_name = &standard_parameter_names($name); |
my $standard_name = &standard_parameter_names($name); |
Line 4468 sub oldversion_warning {
|
Line 4665 sub oldversion_warning {
|
} # end of block using some constants related to parameter types |
} # end of block using some constants related to parameter types |
|
|
|
|
# |
|
# Shift all start and end dates by $shift |
|
# |
|
|
|
|
# Shifts all start and end dates in the current course by $shift. |
|
# |
|
# @param {integer} $shift - time to shift, in seconds |
|
# @returns {string} - error name or 'ok' |
sub dateshift { |
sub dateshift { |
my ($shift)=@_; |
my ($shift)=@_; |
my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
Line 4503 sub dateshift {
|
Line 4701 sub dateshift {
|
return $reply; |
return $reply; |
} |
} |
|
|
|
# Overview mode UI to edit course parameters. |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
sub newoverview { |
sub newoverview { |
my ($r) = @_; |
my ($r) = @_; |
|
|
Line 4676 ENDOVER
|
Line 4877 ENDOVER
|
$r->print(&Apache::loncommon::end_page()); |
$r->print(&Apache::loncommon::end_page()); |
} |
} |
|
|
|
# Fills $listdata with parameter information. |
|
# Keys use the format course id.[section id].part.name and course id.[section id].part.name.type. |
|
# The non-type value is always 1. |
|
# |
|
# @param {string} $cat - parameter name |
|
# @param {string} $pschp - selected map pc, or 'all' |
|
# @param {string} $parmlev - selected level value (full|map|general), or '' |
|
# @param {hash reference} $listdata - the parameter data that will be modified |
|
# @param {array reference} $psprt - selected parts |
|
# @param {array reference} $selections - selected sections |
|
# @param {hash reference} $defkeytype - hash parameter name -> parameter type |
|
# @param {hash reference} $allmaps - hash map pc -> map src |
|
# @param {array reference} $ids - resource and map ids |
|
# @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb |
sub secgroup_lister { |
sub secgroup_lister { |
my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_; |
my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_; |
foreach my $item (@{$selections}) { |
foreach my $item (@{$selections}) { |
Line 4714 sub secgroup_lister {
|
Line 4929 sub secgroup_lister {
|
} |
} |
} |
} |
|
|
# Display all existing parameter settings. |
# UI to edit parameter settings starting with a list of all existing parameters. |
|
# (called by setoverview action) |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
sub overview { |
sub overview { |
my ($r) = @_; |
my ($r) = @_; |
my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
Line 4762 sub overview {
|
Line 4980 sub overview {
|
} |
} |
|
|
# Unused sub. |
# Unused sub. |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
sub clean_parameters { |
sub clean_parameters { |
my ($r) = @_; |
my ($r) = @_; |
my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
Line 4850 ENDOVER
|
Line 5070 ENDOVER
|
$r->print(&Apache::loncommon::end_page()); |
$r->print(&Apache::loncommon::end_page()); |
} |
} |
|
|
# Overview mode, UI to shift all dates. |
# UI to shift all dates (called by dateshift1 action). |
|
# Used by overview mode. |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
sub date_shift_one { |
sub date_shift_one { |
my ($r) = @_; |
my ($r) = @_; |
my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
Line 4879 sub date_shift_one {
|
Line 5102 sub date_shift_one {
|
$r->print(&Apache::loncommon::end_page()); |
$r->print(&Apache::loncommon::end_page()); |
} |
} |
|
|
# Overview mode, UI to shift all dates (second form). |
# UI to shift all dates (second form). |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
sub date_shift_two { |
sub date_shift_two { |
my ($r) = @_; |
my ($r) = @_; |
my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
Line 4907 sub date_shift_two {
|
Line 5132 sub date_shift_two {
|
$r->print(&Apache::loncommon::end_page()); |
$r->print(&Apache::loncommon::end_page()); |
} |
} |
|
|
|
# Returns the different components of a resourcedata key. |
|
# Keys: scope_type, scope, realm_type, realm, realm_title, |
|
# realm_exists, parameter_part, parameter_name. |
|
# Was used by clean_parameters (which is unused). |
|
# |
|
# @param {string} $key - the parameter key |
|
# @returns {hash} |
sub parse_key { |
sub parse_key { |
my ($key) = @_; |
my ($key) = @_; |
my %data; |
my %data; |
Line 4947 sub parse_key {
|
Line 5179 sub parse_key {
|
} |
} |
|
|
|
|
|
# Calls loncommon::start_page with the "Settings" title. |
sub header { |
sub header { |
return &Apache::loncommon::start_page('Settings'); |
return &Apache::loncommon::start_page('Settings'); |
} |
} |
Line 4957 sub header {
|
Line 5190 sub header {
|
# MAIN MENU |
# MAIN MENU |
################################################## |
################################################## |
|
|
|
# Content and problem settings main menu. |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
|
# @param {boolean} $parm_permission - true if the user has permission to edit the current course or section |
sub print_main_menu { |
sub print_main_menu { |
my ($r,$parm_permission)=@_; |
my ($r,$parm_permission)=@_; |
# |
# |
Line 5060 ENDMAINFORMHEAD
|
Line 5297 ENDMAINFORMHEAD
|
# PORTFOLIO METADATA |
# PORTFOLIO METADATA |
################################################## |
################################################## |
|
|
|
# Prints HTML to edit an item of portfolio metadata. The HTML contains several td elements (no tr). |
|
# It looks like field titles are not localized. |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
|
# @param {string} $field_name - metadata field name |
|
# @param {string} $field_text - metadata field title, in English unless manually added |
|
# @param {boolean} $added_flag - true if the field was manually added |
sub output_row { |
sub output_row { |
my ($r, $field_name, $field_text, $added_flag) = @_; |
my ($r, $field_name, $field_text, $added_flag) = @_; |
my $output; |
my $output; |
Line 5117 sub output_row {
|
Line 5361 sub output_row {
|
|
|
|
|
# UI to order portfolio metadata fields. |
# UI to order portfolio metadata fields. |
|
# Currently useless because addmetafield does not work. |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
sub order_meta_fields { |
sub order_meta_fields { |
my ($r)=@_; |
my ($r)=@_; |
my $idx = 1; |
my $idx = 1; |
Line 5207 sub order_meta_fields {
|
Line 5454 sub order_meta_fields {
|
} |
} |
|
|
|
|
|
# Returns HTML with a Continue button redirecting to the initial portfolio metadata screen. |
|
# @returns {string} |
sub continue { |
sub continue { |
my $output; |
my $output; |
$output .= '<form action="" method="post">'; |
$output .= '<form action="" method="post">'; |
Line 5216 sub continue {
|
Line 5465 sub continue {
|
} |
} |
|
|
|
|
|
# UI to add a metadata field. |
|
# Currenly does not work because of an HTML error (the field is not visible). |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
sub addmetafield { |
sub addmetafield { |
my ($r)=@_; |
my ($r)=@_; |
&Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata', |
&Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata', |
Line 5260 sub addmetafield {
|
Line 5513 sub addmetafield {
|
$r->print('<input type="submit" name="undelete" value="Undelete" />'); |
$r->print('<input type="submit" name="undelete" value="Undelete" />'); |
$r->print('</form>'); |
$r->print('</form>'); |
} |
} |
$r->print('<hr /><strong>Or</strong> you may enter a new metadata field name.<form method="post" action="/adm/parmset?action=addmetadata"'); |
$r->print('<hr /><strong>Or</strong> you may enter a new metadata field name.<form method="post" action="/adm/parmset?action=addmetadata"'); # FIXME: HTML error, input will not be displayed ! |
$r->print('<input type="text" name="fieldname" /><br />'); |
$r->print('<input type="text" name="fieldname" /><br />'); |
$r->print('<input type="submit" value="Add Metadata Field" />'); |
$r->print('<input type="submit" value="Add Metadata Field" />'); |
} |
} |
Line 5271 sub addmetafield {
|
Line 5524 sub addmetafield {
|
|
|
|
|
# Display or save portfolio metadata. |
# Display or save portfolio metadata. |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
sub setrestrictmeta { |
sub setrestrictmeta { |
my ($r)=@_; |
my ($r)=@_; |
my $next_meta; |
my $next_meta; |
Line 5346 ENDButtons
|
Line 5601 ENDButtons
|
my $added_flag = 1; |
my $added_flag = 1; |
foreach my $field (sort(keys(%$added_metadata_fields))) { |
foreach my $field (sort(keys(%$added_metadata_fields))) { |
$row_alt = $row_alt ? 0 : 1; |
$row_alt = $row_alt ? 0 : 1; |
$output.= &output_row($r, $field, $$added_metadata_fields{$field},$added_flag, $row_alt); |
$output.= &output_row($r, $field, $$added_metadata_fields{$field},$added_flag, $row_alt); # FIXME: wrong parameters |
} |
} |
$output .= &Apache::loncommon::end_data_table(); |
$output .= &Apache::loncommon::end_data_table(); |
$r->print(<<ENDenv); |
$r->print(<<ENDenv); |
Line 5361 ENDenv
|
Line 5616 ENDenv
|
} |
} |
|
|
|
|
|
# Returns metadata fields that have been manually added. |
|
# |
|
# @param {string} $cid - course id |
|
# @returns {hash reference} - hash field name -> field title (not localized) |
sub get_added_meta_fieldnames { |
sub get_added_meta_fieldnames { |
my ($cid) = @_; |
my ($cid) = @_; |
my %fields; |
my %fields; |
Line 5375 sub get_added_meta_fieldnames {
|
Line 5634 sub get_added_meta_fieldnames {
|
} |
} |
|
|
|
|
|
# Returns metadata fields that have been manually added and deleted. |
|
# |
|
# @param {string} $cid - course id |
|
# @returns {hash reference} - hash field name -> field title (not localized) |
sub get_deleted_meta_fieldnames { |
sub get_deleted_meta_fieldnames { |
my ($cid) = @_; |
my ($cid) = @_; |
my %fields; |
my %fields; |
Line 5396 sub get_deleted_meta_fieldnames {
|
Line 5659 sub get_deleted_meta_fieldnames {
|
################################################## |
################################################## |
|
|
# UI to change parameter setting default actions |
# UI to change parameter setting default actions |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
sub defaultsetter { |
sub defaultsetter { |
my ($r) = @_; |
my ($r) = @_; |
|
|
Line 5489 sub defaultsetter {
|
Line 5754 sub defaultsetter {
|
push @datedisplay,&mt('Automatically set earlier than ').$tempkey; |
push @datedisplay,&mt('Automatically set earlier than ').$tempkey; |
} |
} |
} |
} |
$r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'. |
$r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'. |
&mt('Automatic setting rules apply to table mode interfaces only.')); |
&mt('Automatic setting rules apply to table mode interfaces only.')); |
$r->print("\n".&Apache::loncommon::start_data_table(). |
$r->print("\n".&Apache::loncommon::start_data_table(). |
&Apache::loncommon::start_data_table_header_row(). |
&Apache::loncommon::start_data_table_header_row(). |
"<th>".&mt('Rule for parameter').'</th><th>'. |
"<th>".&mt('Rule for parameter').'</th><th>'. |
Line 5534 $r->print(&mt('Manual setting rules appl
|
Line 5799 $r->print(&mt('Manual setting rules appl
|
<input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br /> |
<input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br /> |
<input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br /> |
<input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br /> |
<input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'} |
<input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'} |
ENDINPUTDATE |
ENDINPUTDATE |
} elsif ($defkeytype{$tempkey} eq 'string_yesno') { |
} elsif ($defkeytype{$tempkey} eq 'string_yesno') { |
my $yeschecked=''; |
my $yeschecked=''; |
my $nochecked=''; |
my $nochecked=''; |
Line 5544 $r->print(&mt('Manual setting rules appl
|
Line 5809 $r->print(&mt('Manual setting rules appl
|
$r->print(<<ENDYESNO); |
$r->print(<<ENDYESNO); |
<label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br /> |
<label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br /> |
<label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label> |
<label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label> |
ENDYESNO |
ENDYESNO |
} else { |
} else { |
$r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />'); |
$r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />'); |
} |
} |
Line 5562 $r->print(&mt('Manual setting rules appl
|
Line 5827 $r->print(&mt('Manual setting rules appl
|
# PARAMETER CHANGES LOG |
# PARAMETER CHANGES LOG |
################################################## |
################################################## |
|
|
|
# Returns some info for a parameter log entry. |
|
# Returned entries: |
|
# $realm - HTML title for the parameter level and resource |
|
# $section - parameter section |
|
# $name - parameter name |
|
# $part - parameter part |
|
# $what - $part.'.'.$name |
|
# $middle - resource symb ? |
|
# $uname - user name (same as given) |
|
# $udom - user domain (same as given) |
|
# $issection - section or group name |
|
# $realmdescription - title for the parameter level and resource (without using HTML) |
|
# |
|
# FIXME: remove unused fields. |
|
# |
|
# @param {string} $key - parameter log key |
|
# @param {string} $uname - user name |
|
# @param {string} $udom - user domain |
|
# @param {string} $exeuser - unused |
|
# @param {string} $exedomain - unused |
|
# @param {boolean} $typeflag - .type log entry |
|
# @returns {Array} |
sub components { |
sub components { |
my ($key,$uname,$udom,$exeuser,$exedomain,$typeflag)=@_; |
my ($key,$uname,$udom,$exeuser,$exedomain,$typeflag)=@_; |
|
|
Line 5610 sub components {
|
Line 5897 sub components {
|
$what,$middle,$uname,$udom,$issection,$realmdescription); |
$what,$middle,$uname,$udom,$issection,$realmdescription); |
} |
} |
|
|
my %standard_parms; |
my %standard_parms; # hash parameter name -> parameter title (not localized) |
my %standard_parms_types; |
my %standard_parms_types; # hash parameter name -> parameter type |
|
|
|
# Reads parameter info from packages.tab into %standard_parms. |
sub load_parameter_names { |
sub load_parameter_names { |
open(my $config,"<$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab"); |
open(my $config,"<$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab"); |
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
Line 5631 sub load_parameter_names {
|
Line 5919 sub load_parameter_names {
|
$standard_parms{'int_zero_pos'} = 'Positive Integer or Zero'; |
$standard_parms{'int_zero_pos'} = 'Positive Integer or Zero'; |
} |
} |
|
|
|
# Returns a parameter title for standard parameters, the name for others. |
|
# |
|
# @param {string} $name - parameter name |
|
# @returns {string} |
sub standard_parameter_names { |
sub standard_parameter_names { |
my ($name)=@_; |
my ($name)=@_; |
if (!%standard_parms) { |
if (!%standard_parms) { |
Line 5643 sub standard_parameter_names {
|
Line 5935 sub standard_parameter_names {
|
} |
} |
} |
} |
|
|
|
# Returns a parameter type for standard parameters, undef for others. |
|
# |
|
# @param {string} $name - parameter name |
|
# @returns {string} |
sub standard_parameter_types { |
sub standard_parameter_types { |
my ($name)=@_; |
my ($name)=@_; |
if (!%standard_parms_types) { |
if (!%standard_parms_types) { |
Line 5654 sub standard_parameter_types {
|
Line 5950 sub standard_parameter_types {
|
return; |
return; |
} |
} |
|
|
|
# Returns a parameter level title (not localized) from the parameter level name. |
|
# |
|
# @param {string} $name - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel) |
|
# @returns {string} |
sub standard_parameter_levels { |
sub standard_parameter_levels { |
my ($name)=@_; |
my ($name)=@_; |
my %levels = ( |
my %levels = ( |
Line 5669 sub standard_parameter_levels {
|
Line 5969 sub standard_parameter_levels {
|
} |
} |
|
|
# Display log for parameter changes, blog postings, user notification changes. |
# Display log for parameter changes, blog postings, user notification changes. |
|
# |
|
# @param {Apache2::RequestRec} $r - the Apache request |
sub parm_change_log { |
sub parm_change_log { |
my ($r)=@_; |
my ($r)=@_; |
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
Line 5863 sub parm_change_log {
|
Line 6165 sub parm_change_log {
|
# MISC ! |
# MISC ! |
################################################## |
################################################## |
|
|
|
# Stores slot information. |
# Used by table UI |
# Used by table UI |
|
# FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected) |
|
# |
|
# @param {string} $slot_name - slot name |
|
# @param {string} $cdom - course domain |
|
# @param {string} $cnum - course number |
|
# @param {string} $symb - resource symb |
|
# @param {string} $uname - user name |
|
# @param {string} $udom - user domain |
|
# @returns {string} - 'ok' or error name |
sub update_slots { |
sub update_slots { |
my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_; |
my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_; |
my %slot=&Apache::lonnet::get_slot($slot_name); |
my %slot=&Apache::lonnet::get_slot($slot_name); |
Line 5917 sub update_slots {
|
Line 6229 sub update_slots {
|
return $success; |
return $success; |
} |
} |
|
|
|
# Deletes a slot reservation. |
# Used by table UI |
# Used by table UI |
|
# FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected) |
|
# |
|
# @param {string} $slot_name - slot name |
|
# @param {string} $cdom - course domain |
|
# @param {string} $cnum - course number |
|
# @param {string} $uname - user name |
|
# @param {string} $udom - user domain |
|
# @param {string} $symb - resource symb |
|
# @returns {string} - 'ok' or error name |
sub delete_slots { |
sub delete_slots { |
my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_; |
my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_; |
my $delresult; |
my $delresult; |
Line 5953 sub delete_slots {
|
Line 6275 sub delete_slots {
|
return $delresult; |
return $delresult; |
} |
} |
|
|
|
# Returns true if there is a current course. |
# Used by handler |
# Used by handler |
|
# |
|
# @returns {boolean} |
sub check_for_course_info { |
sub check_for_course_info { |
my $navmap = Apache::lonnavmaps::navmap->new(); |
my $navmap = Apache::lonnavmaps::navmap->new(); |
return 1 if ($navmap); |
return 1 if ($navmap); |
return 0; |
return 0; |
} |
} |
|
|
|
# Returns the current course host and host LON-CAPA version. |
|
# |
|
# @returns {Array} - (course hostname, major version number, minor version number) |
sub parameter_release_vars { |
sub parameter_release_vars { |
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $chome = $env{'course.'.$env{'request.course.id'}.'.home'}; |
my $chome = $env{'course.'.$env{'request.course.id'}.'.home'}; |
Line 5969 sub parameter_release_vars {
|
Line 6297 sub parameter_release_vars {
|
return ($chostname,$cmajor,$cminor); |
return ($chostname,$cmajor,$cminor); |
} |
} |
|
|
|
# Checks if the course host version can handle a parameter required version, |
|
# and if it does, stores the release needed for the course. |
|
# |
|
# @param {string} $name - parameter name |
|
# @param {string} $value - parameter value |
|
# @param {string} $valmatch - name of the test used for checking the value |
|
# @param {string} $namematch - name of the test used for checking the name |
|
# @param {string} $needsrelease - version needed by the parameter, major.minor |
|
# @param {integer} $cmajor - course major version number |
|
# @param {integer} $cminor - course minor version number |
|
# @returns {boolean} - true if a newer version is needed |
sub parameter_releasecheck { |
sub parameter_releasecheck { |
my ($name,$value,$valmatch,$namematch,$needsrelease,$cmajor,$cminor) = @_; |
my ($name,$value,$valmatch,$namematch,$needsrelease,$cmajor,$cminor) = @_; |
my $needsnewer; |
my $needsnewer; |