Diff for /loncom/interface/lonparmset.pm between versions 1.560 and 1.577

version 1.560, 2016/07/12 20:30:20 version 1.577, 2017/07/13 13:57:48
Line 336  use LONCAPA qw(:DEFAULT :match); Line 336  use LONCAPA qw(:DEFAULT :match);
 ##################################################  ##################################################
   
 # Page header  # Page header
   #
   # @param {Apache2::RequestRec} $r - Apache request object
   # @param {string} $mode - selected tab, 'parmset' for course and problem settings, or 'coursepref' for course settings
   # @param {string} $crstype - course type ('Community' for community settings)
 sub startSettingsScreen {  sub startSettingsScreen {
     my ($r,$mode,$crstype)=@_;      my ($r,$mode,$crstype)=@_;
   
Line 363  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 with &symbcache.
   #
   # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
   # @param {string} $id - resource id or map pc
   # @param {string} $def - the resource's default value for this parameter
   # @param {string} $uname - user name
   # @param {string} $udom - user domain
   # @param {string} $csec - section name
   # @param {string} $cgroup - group name
   # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
   # @returns {Array}
 sub parmval {  sub parmval {
     my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;      my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
     return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,      return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,
                                                            $cgroup,$courseopt);                                                             $cgroup,$courseopt);
 }  }
   
   # Returns an array containing
   # - the most specific level that is defined for that parameter (integer)
   # - an array with the level as index and the parameter value as value (when defined)
   #   (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} $symb - resource symb or map src
   # @param {string} $def - the resource's default value for this parameter
   # @param {string} $uname - user name
   # @param {string} $udom - user domain
   # @param {string} $csec - section name
   # @param {string} $cgroup - group name
   # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
   # @returns {Array}
 sub parmval_by_symb {  sub parmval_by_symb {
     my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;      my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
   
     my $useropt;      my $useropt;
     if ($uname ne '' && $udom ne '') {      if ($uname ne '' && $udom ne '') {
     $useropt = &Apache::lonnet::get_userresdata($uname,$udom);          $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
     }      }
   
     my $result='';      my $result='';
Line 386  sub parmval_by_symb { Line 415  sub parmval_by_symb {
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
     my $map=(&Apache::lonnet::decode_symb($symb))[0];      my $map=(&Apache::lonnet::decode_symb($symb))[0];
     $map = &Apache::lonnet::deversion($map);      $map = &Apache::lonnet::deversion($map);
       
       # NOTE: some of that code looks redondant with code in lonnavmaps::parmval_real,
       # any change should be reflected there.
       
     my $symbparm=$symb.'.'.$what;      my $symbparm=$symb.'.'.$what;
     my $recurseparm=$map.'___(rec).'.$what;       my $recurseparm=$map.'___(rec).'.$what; 
     my $mapparm=$map.'___(all).'.$what;      my $mapparm=$map.'___(all).'.$what;
Line 409  sub parmval_by_symb { Line 441  sub parmval_by_symb {
   
 # --------------------------------------------------------- first, check course  # --------------------------------------------------------- first, check course
   
   # 18 - General Course
     if (defined($$courseopt{$courselevel})) {      if (defined($$courseopt{$courselevel})) {
         $outpar[18]=$$courseopt{$courselevel};          $outpar[18]=$$courseopt{$courselevel};
         $result=18;          $result=18;
     }      }
   
   # 17 - Map or Folder level in course (recursive) 
     if (defined($$courseopt{$courseleveli})) {      if (defined($$courseopt{$courseleveli})) {
         $outpar[17]=$$courseopt{$courseleveli};          $outpar[17]=$$courseopt{$courseleveli};
         $result=17;          $result=17;
     }      }
   
   # 16 - Map or Folder level in course (non-recursive)
     if (defined($$courseopt{$courselevelm})) {      if (defined($$courseopt{$courselevelm})) {
         $outpar[16]=$$courseopt{$courselevelm};          $outpar[16]=$$courseopt{$courselevelm};
         $result=16;          $result=16;
Line 426  sub parmval_by_symb { Line 461  sub parmval_by_symb {
   
 # ------------------------------------------------------- second, check default  # ------------------------------------------------------- second, check default
   
   # 15 - resource default
     if (defined($def)) { $outpar[15]=$def; $result=15; }      if (defined($def)) { $outpar[15]=$def; $result=15; }
   
 # ------------------------------------------------------ third, check map parms  # ------------------------------------------------------ third, check map parms
   
           
   # 14 - map default
     my $thisparm=&parmhash($symbparm);      my $thisparm=&parmhash($symbparm);
     if (defined($thisparm)) { $outpar[14]=$thisparm; $result=14; }      if (defined($thisparm)) { $outpar[14]=$thisparm; $result=14; }
   
   # 13 - resource level in course
     if (defined($$courseopt{$courselevelr})) {      if (defined($$courseopt{$courselevelr})) {
         $outpar[13]=$$courseopt{$courselevelr};          $outpar[13]=$$courseopt{$courselevelr};
         $result=13;          $result=13;
Line 441  sub parmval_by_symb { Line 479  sub parmval_by_symb {
   
 # ------------------------------------------------------ fourth, back to course  # ------------------------------------------------------ fourth, back to course
     if ($csec ne '') {      if ($csec ne '') {
   # 12 - General for section
         if (defined($$courseopt{$seclevel})) {          if (defined($$courseopt{$seclevel})) {
             $outpar[12]=$$courseopt{$seclevel};              $outpar[12]=$$courseopt{$seclevel};
             $result=12;              $result=12;
         }          }
   # 11 - Map or Folder level for section (recursive)
         if (defined($$courseopt{$secleveli})) {          if (defined($$courseopt{$secleveli})) {
             $outpar[11]=$$courseopt{$secleveli};              $outpar[11]=$$courseopt{$secleveli};
             $result=11;              $result=11;
         }          }
   # 10 - Map or Folder level for section (non-recursive)
         if (defined($$courseopt{$seclevelm})) {          if (defined($$courseopt{$seclevelm})) {
             $outpar[10]=$$courseopt{$seclevelm};              $outpar[10]=$$courseopt{$seclevelm};
             $result=10;              $result=10;
         }          }
   # 9 - resource level in section
         if (defined($$courseopt{$seclevelr})) {          if (defined($$courseopt{$seclevelr})) {
             $outpar[9]=$$courseopt{$seclevelr};              $outpar[9]=$$courseopt{$seclevelr};
             $result=9;              $result=9;
Line 460  sub parmval_by_symb { Line 502  sub parmval_by_symb {
     }      }
 # ------------------------------------------------------ fifth, check course group  # ------------------------------------------------------ fifth, check course group
     if ($cgroup ne '') {      if ($cgroup ne '') {
   # 8 - General for group
         if (defined($$courseopt{$grplevel})) {          if (defined($$courseopt{$grplevel})) {
             $outpar[8]=$$courseopt{$grplevel};              $outpar[8]=$$courseopt{$grplevel};
             $result=8;              $result=8;
         }          }
   # 7 - Map or Folder level for group (recursive)
         if (defined($$courseopt{$grpleveli})) {          if (defined($$courseopt{$grpleveli})) {
             $outpar[7]=$$courseopt{$grpleveli};              $outpar[7]=$$courseopt{$grpleveli};
             $result=7;              $result=7;
         }          }
   # 6 - Map or Folder level for group (non-recursive)
         if (defined($$courseopt{$grplevelm})) {          if (defined($$courseopt{$grplevelm})) {
             $outpar[6]=$$courseopt{$grplevelm};              $outpar[6]=$$courseopt{$grplevelm};
             $result=6;              $result=6;
         }          }
   # 5 - resource level in group
         if (defined($$courseopt{$grplevelr})) {          if (defined($$courseopt{$grplevelr})) {
             $outpar[5]=$$courseopt{$grplevelr};              $outpar[5]=$$courseopt{$grplevelr};
             $result=5;              $result=5;
Line 481  sub parmval_by_symb { Line 527  sub parmval_by_symb {
 # ---------------------------------------------------------- sixth, check user  # ---------------------------------------------------------- sixth, check user
   
     if ($uname ne '') {      if ($uname ne '') {
     if (defined($$useropt{$courselevel})) {  # 4 - General for specific student
         $outpar[4]=$$useropt{$courselevel};          if (defined($$useropt{$courselevel})) {
         $result=4;              $outpar[4]=$$useropt{$courselevel};
     }              $result=4;
           }
   
     if (defined($$useropt{$courseleveli})) {  # 3 - Map or Folder level for specific student (recursive)
         $outpar[3]=$$useropt{$courseleveli};          if (defined($$useropt{$courseleveli})) {
         $result=3;              $outpar[3]=$$useropt{$courseleveli};
     }              $result=3;
           }
   
     if (defined($$useropt{$courselevelm})) {  # 2 - Map or Folder level for specific student (non-recursive)
         $outpar[2]=$$useropt{$courselevelm};          if (defined($$useropt{$courselevelm})) {
         $result=2;              $outpar[2]=$$useropt{$courselevelm};
     }              $result=2;
           }
   
     if (defined($$useropt{$courselevelr})) {  # 1 - resource level for specific student
         $outpar[1]=$$useropt{$courselevelr};          if (defined($$useropt{$courselevelr})) {
         $result=1;              $outpar[1]=$$useropt{$courselevelr};
     }              $result=1;
           }
     }      }
     return ($result,@outpar);      return ($result,@outpar);
 }  }
Line 509  sub parmval_by_symb { Line 559  sub parmval_by_symb {
 # --- Caches local to lonparmset  # --- Caches local to lonparmset
   
   
   # Reset lonparmset caches (called at the beginning and end of the handler).
 sub reset_caches {  sub reset_caches {
     &resetparmhash();      &resetparmhash();
     &resetsymbcache();      &resetsymbcache();
     &resetrulescache();      &resetrulescache();
 }  }
   
   # cache for map parameters, stored temporarily in $env{'request.course.fn'}_parms.db
   # (these parameters come from param elements in .sequence files created with the advanced RAT)
 {  {
     my $parmhashid;      my $parmhashid; # course identifier, to initialize the cache only once for a course
     my %parmhash;      my %parmhash; # the parameter cache
       # reset map parameter hash
     sub resetparmhash {      sub resetparmhash {
         undef($parmhashid);          undef($parmhashid);
         undef(%parmhash);          undef(%parmhash);
     }      }
   
       # dump the _parms.db database into %parmhash
     sub cacheparmhash {      sub cacheparmhash {
         if ($parmhashid eq  $env{'request.course.fn'}) { return; }          if ($parmhashid eq  $env{'request.course.fn'}) { return; }
         my %parmhashfile;          my %parmhashfile;
Line 534  sub reset_caches { Line 589  sub reset_caches {
         }          }
     }      }
   
       # returns a parameter value for an identifier symb.parts.parameter, using the map parameter cache
     sub parmhash {      sub parmhash {
         my ($id) = @_;          my ($id) = @_;
         &cacheparmhash();          &cacheparmhash();
Line 541  sub reset_caches { Line 597  sub reset_caches {
     }      }
 }  }
   
   # cache resource id or map pc -> resource symb or map src, using lonnavmaps to find association
 {  {
     my $symbsid;      my $symbsid; # course identifier, to initialize the cache only once for a course
     my %symbs;      my %symbs; # hash id->symb
       # reset the id->symb cache
     sub resetsymbcache {      sub resetsymbcache {
         undef($symbsid);          undef($symbsid);
         undef(%symbs);          undef(%symbs);
     }      }
   
       # 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 569  sub reset_caches { Line 629  sub reset_caches {
     }      }
 }  }
   
   # cache for parameter default actions (stored in parmdefactions.db)
 {  {
     my $rulesid;      my $rulesid; # course identifier, to initialize the cache only once for a course
     my %rules;      my %rules; # parameter default actions hash
     sub resetrulescache {      sub resetrulescache {
         undef($rulesid);          undef($rulesid);
         undef(%rules);          undef(%rules);
     }      }
   
       # returns the value for a given key in the parameter default action hash
     sub rulescache {      sub rulescache {
         my $id=shift;          my $id=shift;
         if ($rulesid ne $env{'request.course.id'}          if ($rulesid ne $env{'request.course.id'}
Line 591  sub reset_caches { Line 653  sub reset_caches {
 }  }
   
   
   # Returns the values of the parameter type default action
   # "default value when manually setting".
   # If none is defined, ('','','','','') is returned.
   #
   # @param {string} $type - parameter type
   # @returns {Array<string>} - (hours, min, sec, value)
 sub preset_defaults {  sub preset_defaults {
     my $type=shift;      my $type=shift;
     if (&rulescache($type.'_action') eq 'default') {      if (&rulescache($type.'_action') eq 'default') {
Line 607  sub preset_defaults { Line 674  sub preset_defaults {
 }  }
   
   
   # Checks that a date is after enrollment start date and before
   # enrollment end date.
   # Returns HTML with a warning if it is not, or the empty string otherwise.
   # This is used by both overview and table modes.
   #
   # @param {integer} $checkdate - the date to check.
   # @returns {string} - HTML possibly containing a localized warning message.
 sub date_sanity_info {  sub date_sanity_info {
    my $checkdate=shift;     my $checkdate=shift;
    unless ($checkdate) { return ''; }     unless ($checkdate) { return ''; }
Line 643  sub date_sanity_info { Line 715  sub date_sanity_info {
 #      }  #      }
    return $result;     return $result;
 }  }
 ##################################################  
 ##################################################  
 #  
 # Store a parameter by ID  
 #  
 # Takes  
 # - resource id  
 # - name of parameter  
 # - level  
 # - new value  
 # - new type  
 # - username  
 # - userdomain  
   
   
   # Store a parameter value and type by ID, also triggering more parameter changes based on parameter default actions.
   #
   # @param {string} $sresid - resource id or map pc
   # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
   # @param {integer} $snum - level
   # @param {string} $nval - new value
   # @param {string} $ntype - new type
   # @param {string} $uname - username
   # @param {string} $udom - userdomain
   # @param {string} $csec - section name
   # @param {string} $cgroup - group name
 sub storeparm {  sub storeparm {
     my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;      my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
     &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);      &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);
 }  }
   
 my %recstack;  my %recstack; # hash parameter name -> 1 when a parameter was used before in a recursive call to storeparm_by_symb
   
   # 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.
   #
   # @param {string} $symb - resource symb or map src
   # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
   # @param {integer} $snum - level
   # @param {string} $nval - new value
   # @param {string} $ntype - new type
   # @param {string} $uname - username
   # @param {string} $udom - userdomain
   # @param {string} $csec - section name
   # @param {boolean} $recflag - should be true for recursive calls to storeparm_by_symb, false otherwise
   # @param {string} $cgroup - group name
 sub storeparm_by_symb {  sub storeparm_by_symb {
     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;      my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
     unless ($recflag) {      unless ($recflag) {
Line 692  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 715  sub storeparm_by_symb { Line 799  sub storeparm_by_symb {
     return '';      return '';
 }  }
   
   # Adds all given arguments to the course parameter log.
   # @returns {string} - the answer to the lonnet query.
 sub log_parmset {  sub log_parmset {
     return &Apache::lonnet::write_log('course','parameterlog',@_);      return &Apache::lonnet::write_log('course','parameterlog',@_);
 }  }
   
   # Store a parameter value and type by symb, without using the parameter default actions.
   # Expire related sheets.
   #
   # @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 {integer} $snum - level
   # @param {string} $nval - new value
   # @param {string} $ntype - new type
   # @param {string} $uname - username
   # @param {string} $udom - userdomain
   # @param {string} $csec - section name
   # @param {string} $cgroup - group name
   # @returns {string} - HTML code with an error message if the parameter could not be stored.
 sub storeparm_by_symb_inner {  sub storeparm_by_symb_inner {
 # ---------------------------------------------------------- Get symb, map, etc  # ---------------------------------------------------------- Get symb, map, etc
     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;      my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
Line 826  sub storeparm_by_symb_inner { Line 925  sub storeparm_by_symb_inner {
 }  }
   
   
   # Returns HTML with the value of the given parameter,
   # using a readable format for dates, and
   # a warning if there is a problem with a date.
   # Used by table mode.
   # Returns HTML for the editmap.png image if no value is defined and $editable is true.
   #
   # @param {string} $value - the parameter value
   # @param {string} $type - the parameter type
   # @param {string} $name - the parameter name (unused)
   # @param {boolean} $editable - Set to true to get an icon when no value is defined.
 sub valout {  sub valout {
     my ($value,$type,$name,$editable)=@_;      my ($value,$type,$name,$editable)=@_;
     my $result = '';      my $result = '';
Line 904  sub valout { Line 1013  sub valout {
 }  }
   
   
   # Returns HTML containing a link on a parameter value, for table mode.
   # The link uses the javascript function 'pjump'.
   #
   # @param {string} $type - parameter type
   # @param {string} $dis - dialog title for editing the parameter value and type
   # @param {string} $value - parameter value
   # @param {string} $marker - identifier for the parameter, "resource id&part_parameter name&level", will be passed as pres_marker when the user submits a change.
   # @param {string} $return - prefix for the name of the form and field names that will be used to submit the form ('parmform.pres')
   # @param {string} $call - javascript function to call to submit the form ('psub')
 sub plink {  sub plink {
     my ($type,$dis,$value,$marker,$return,$call)=@_;      my ($type,$dis,$value,$marker,$return,$call)=@_;
     my $winvalue=$value;      my $winvalue=$value;
Line 930  sub plink { Line 1048  sub plink {
         $valout.'</a></td></tr></table>';          $valout.'</a></td></tr></table>';
 }  }
   
   # Javascript for table mode.
 sub page_js {  sub page_js {
   
     my $selscript=&Apache::loncommon::studentbrowser_javascript();      my $selscript=&Apache::loncommon::studentbrowser_javascript();
Line 946  sub page_js { Line 1065  sub page_js {
             document.parmform.action+='#'+document.parmform.pres_marker.value;              document.parmform.action+='#'+document.parmform.pres_marker.value;
             var typedef=new Array();              var typedef=new Array();
             typedef=document.parmform.pres_type.value.split('_');              typedef=document.parmform.pres_type.value.split('_');
            if (document.parmform.pres_type.value!='') {              if (document.parmform.pres_type.value!='') {
             if (typedef[0]=='date') {                  if (typedef[0]=='date') {
                 eval('document.parmform.recent_'+                      eval('document.parmform.recent_'+
                      document.parmform.pres_type.value+                          document.parmform.pres_type.value+
              '.value=document.parmform.pres_value.value;');                          '.value=document.parmform.pres_value.value;');
             } else {                  } else {
                 eval('document.parmform.recent_'+typedef[0]+                      eval('document.parmform.recent_'+typedef[0]+
              '.value=document.parmform.pres_value.value;');                          '.value=document.parmform.pres_value.value;');
                   }
             }              }
        }  
             document.parmform.submit();              document.parmform.submit();
         } else {          } else {
             document.parmform.pres_value.value='';              document.parmform.pres_value.value='';
Line 979  ENDJS Line 1098  ENDJS
   
 }  }
   
   # Javascript to show or hide the map selection (function showHide_courseContent),
   # for table and overview modes.
 sub showhide_js {  sub showhide_js {
     return <<"COURSECONTENTSCRIPT";      return <<"COURSECONTENTSCRIPT";
   
Line 999  function showHide_courseContent() { Line 1120  function showHide_courseContent() {
 COURSECONTENTSCRIPT  COURSECONTENTSCRIPT
 }  }
   
   # Javascript functions showHideLenient and toggleParmTextbox, for overview mode
 sub toggleparmtextbox_js {  sub toggleparmtextbox_js {
     return <<"ENDSCRIPT";      return <<"ENDSCRIPT";
   
Line 1058  function toggleParmTextbox(form,key) { Line 1180  function toggleParmTextbox(form,key) {
 ENDSCRIPT  ENDSCRIPT
 }  }
   
   # Javascript function validateParms, for overview mode
 sub validateparms_js {  sub validateparms_js {
     return <<'ENDSCRIPT';      return <<'ENDSCRIPT';
   
Line 1131  function validateParms() { Line 1254  function validateParms() {
 ENDSCRIPT  ENDSCRIPT
 }  }
   
   # Javascript initialization, for overview mode
 sub ipacc_boxes_js  {  sub ipacc_boxes_js  {
     my $remove = &mt('Remove');      my $remove = &mt('Remove');
     return <<"END";      return <<"END";
Line 1155  sub ipacc_boxes_js  { Line 1279  sub ipacc_boxes_js  {
 END  END
 }  }
   
   # Javascript function toggleSecret, for overview mode.
 sub done_proctor_js {  sub done_proctor_js {
     return <<"END";      return <<"END";
 function toggleSecret(form,radio,key) {  function toggleSecret(form,radio,key) {
Line 1180  END Line 1305  END
   
 }  }
   
   # Prints HTML page start for table mode.
   # @param {Apache2::RequestRec} $r - the Apache request
   # @param {string} $psymb - resource symb
   # @param {string} $crstype - course type (Community / Course / Placement Test)
 sub startpage {  sub startpage {
     my ($r,$psymb,$crstype) = @_;      my ($r,$psymb,$crstype) = @_;
   
Line 1228  ENDHEAD Line 1357  ENDHEAD
 }  }
   
   
   # Prints a row for table mode (except for the tr start).
   # Every time a hash reference is passed, a single entry is used, so print_row
   # could just use these values, but why make it simple when it can be complicated ?
   #
   # @param {Apache2::RequestRec} $r - the Apache request
   # @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} $name - parameter key -> parameter name
   # @param {hash reference} $symbp - map pc or resource/map id -> map src.'___(all)' or resource symb
   # @param {string} $rid - resource id
   # @param {hash reference} $default - parameter key -> resource parameter default value
   # @param {hash reference} $defaulttype - parameter key -> resource parameter default type
   # @param {hash reference} $display - parameter key -> full title for the parameter
   # @param {string} $defbgone - user level and other levels background color
   # @param {string} $defbgtwo - section level background color, also used for part number
   # @param {string} $defbgthree - group level background color
   # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
   # @param {string} $uname - user name
   # @param {string} $udom - user domain
   # @param {string} $csec - section name
   # @param {string} $cgroup - group name
   # @param {array reference} $usersgroups - list of groups the user belongs to, if any
   # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
   # @param {boolean} $readonly - true if no editing allowed. 
 sub print_row {  sub print_row {
     my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,      my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
     $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups,$noeditgrp)=@_;      $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups,$noeditgrp,
       $readonly)=@_;
     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};      my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);      my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
Line 1275  sub print_row { Line 1429  sub print_row {
   
     if ($parmlev eq 'general') {      if ($parmlev eq 'general') {
         if ($uname) {          if ($uname) {
             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
         } elsif ($cgroup) {          } elsif ($cgroup) {
             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);              &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly);
         } elsif ($csec) {          } elsif ($csec) {
             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
         } else {          } else {
             &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
         }          }
     } elsif ($parmlev eq 'map') {      } elsif ($parmlev eq 'map') {
         if ($uname) {          if ($uname) {
             &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);               &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly); 
         } elsif ($cgroup) {          } elsif ($cgroup) {
             &print_td($r,7,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);              &print_td($r,7,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly);
             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);              &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly);
         } elsif ($csec) {          } elsif ($csec) {
             &print_td($r,11,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,11,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
         } else {          } else {
             &print_td($r,17,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,17,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
             &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
         }          }
     } else {      } else {
         if ($uname) {          if ($uname) {
Line 1315  sub print_row { Line 1469  sub print_row {
             }              }
         }          }
   
         &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);          &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
         &print_td($r,17,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);          &print_td($r,17,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
         &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);          &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
         &print_td($r,15,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);          &print_td($r,15,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
         &print_td($r,14,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);          &print_td($r,14,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
         &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);          &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
   
         if ($csec) {          if ($csec) {
             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
             &print_td($r,11,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,11,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
             &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
         }          }
   
         if ($cgroup) {          if ($cgroup) {
             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);              &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly);
             &print_td($r,7,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);              &print_td($r,7,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly);
             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);              &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly);
             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);              &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp.$readonly);
         }          }
   
         if ($uname) {          if ($uname) {
             if ($othergrp) {              if ($othergrp) {
                 $r->print($othergrp);                  $r->print($othergrp);
             }              }
             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
             &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
             &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);              &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
         }          }
   
     } # end of $parmlev if/else      } # end of $parmlev if/else
Line 1364  sub print_row { Line 1518  sub print_row {
     $r->print("\n");      $r->print("\n");
 }  }
   
   # Prints a cell for table mode.
   #
   # FIXME: some of these parameter names are uninspired ($which and $value)
   # Also, it would make more sense to pass the display for this cell rather
   # than the full display hash and the key to use.
   #
   # @param {Apache2::RequestRec} $r - the Apache request
   # @param {integer} $which - level
   # @param {string} $defbg - cell background color
   # @param {integer} $result - the most specific level that is defined for that parameter
   # @param {array reference} $outpar - array level -> parameter value (when defined)
   # @param {string} $mprefix - resource id.'&'.part.'_'.parameter name.'&'
   # @param {string} $value - parameter key ('parameter_'.part.'_'.name)
   # @param {array reference} $typeoutpar - array level -> parameter type (when defined)
   # @param {hash reference} $display - parameter key -> full title for the parameter
   # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
   # @param {boolean} $readonly -true if editing not allowed.
 sub print_td {  sub print_td {
     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,$noeditgrp)=@_;      my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,$noeditgrp,$readonly)=@_;
     $r->print('<td style="background-color:'.(($result==$which)?'#AAFFAA':$defbg).      $r->print('<td style="background-color:'.(($result==$which)?'#AAFFAA':$defbg).
               ';" align="center">');                ';" align="center">');
     my $nolink = 0;      my $nolink = 0;
     if ($which == 14 || $which == 15) {      if ($readonly) {
         $nolink = 1;  
     } elsif (($env{'request.course.sec'} ne '') && ($which > 12)) {  
         $nolink = 1;          $nolink = 1;
     } elsif ($which == 5 || $which ==  6 || $which == 7 || $which == 8) {      } else { 
         if ($noeditgrp) {          if ($which == 14 || $which == 15 || $mprefix =~ /mapalias\&/) {
             $nolink = 1;              $nolink = 1;
         }          } elsif (($env{'request.course.sec'} ne '') && ($which > 12)) {
     } elsif ($mprefix =~ /availablestudent\&$/) {  
         if ($which > 4) {  
             $nolink = 1;  
         }  
     } elsif ($mprefix =~ /examcode\&$/) {  
         unless ($which == 2) {  
             $nolink = 1;              $nolink = 1;
           } elsif ($which == 5 || $which ==  6 || $which == 7 || $which == 8) {
               if ($noeditgrp) {
                   $nolink = 1;
               }
           } elsif ($mprefix =~ /availablestudent\&$/) {
               if ($which > 4) {
                   $nolink = 1;
               }
           } elsif ($mprefix =~ /examcode\&$/) {
               unless ($which == 2) {
                   $nolink = 1;
               }
           } elsif ($mprefix =~ /(encrypturl|hiddenresource)/) {
               if ($which == 16 || $which == 10 || $which == 6 || $which == 2) {
                   $nolink = 1;
               }
         }          }
     }      }
     if ($nolink) {      if ($nolink) {
         $r->print(&valout($$outpar[$which],$$typeoutpar[$which],$mprefix));          my ($parmname)=((split(/\&/,$mprefix))[1]=~/\_([^\_]+)$/);
           $r->print(&valout($$outpar[$which],$$typeoutpar[$which],$parmname));
     } else {      } else {
         $r->print(&plink($$typeoutpar[$which],          $r->print(&plink($$typeoutpar[$which],
                          $$display{$value},$$outpar[$which],                           $$display{$value},$$outpar[$which],
Line 1396  sub print_td { Line 1576  sub print_td {
     $r->print('</td>'."\n");      $r->print('</td>'."\n");
 }  }
   
   # FIXME: Despite the name, this does not print anything, the $r parameter is unused.
   # Returns HTML and other info for the cell added when a user is selected
   # and that user is in several groups. This is the cell with the title "Control by other group".
   #
   # @param {Apache2::RequestRec} $r - the Apache request (unused)
   # @param {string} $what - parameter part.'.'.parameter name
   # @param {string} $rid - resource id
   # @param {string} $cgroup - group name
   # @param {string} $defbg - cell background color
   # @param {array reference} $usersgroups - list of groups the user belongs to, if any
   # @param {integer} $result - level
   # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
   # @returns {Array} - array (parameter value for the other group, HTML for the cell, HTML with the value, name of the other group)
 sub print_usergroups {  sub print_usergroups {
     my ($r,$what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;      my ($r,$what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
     my $courseid = $env{'request.course.id'};      my $courseid = $env{'request.course.id'};
Line 1429  sub print_usergroups { Line 1622  sub print_usergroups {
     return ($coursereply,$output,$grp_parm,$resultgroup);      return ($coursereply,$output,$grp_parm,$resultgroup);
 }  }
   
   # Looks for a group with a defined parameter for given user and parameter.
   # Used by print_usergroups.
   #
   # @param {string} $courseid - the course id
   # @param {array reference} $usersgroups - list of groups the user belongs to, if any
   # @param {string} $symbparm - end of the course parameter hash key for the group resource level
   # @param {string} $mapparm - end of the course parameter hash key for the group map/folder level
   # @param {string} $recurseparm - end of the course parameter hash key for the group recursive level
   # @param {string} $what - parameter part.'.'.parameter name
   # @param {hash reference} $courseopt - course parameters hash
   # @returns {Array} - (parameter value for the group, course parameter hash key for the parameter, name of the group, level name, parameter type)
 sub parm_control_group {  sub parm_control_group {
     my ($courseid,$usersgroups,$symbparm,$mapparm,$recurseparm,$what,$courseopt) = @_;      my ($courseid,$usersgroups,$symbparm,$mapparm,$recurseparm,$what,$courseopt) = @_;
     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);      my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
Line 1455  sub parm_control_group { Line 1659  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.
   # All the parameters are references and are filled by the sub.
   #
   # @param {array reference} $ids - resource and map ids
   # @param {hash reference} $typep - hash resource/map id -> resource type (file extension)
   # @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} $allparts - hash parameter part -> part title (a parameter part can be problem part.'_'.response id for response parameters)
   # @param {hash reference} $allmaps - hash map pc -> map src
   # @param {hash reference} $mapp - hash map pc or resource/map id -> enclosing map src
   # @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 pc or src -> map title (this should really be two separate hashes)
   # @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} $defkeytype - hash parameter name -> parameter type
 sub extractResourceInformation {  sub extractResourceInformation {
     my $ids = shift;      my $ids = shift;
     my $typep = shift;      my $typep = shift;
Line 1555  sub extractResourceInformation { Line 1774  sub extractResourceInformation {
 }  }
   
   
   # Tells if a parameter type is a date.
   #
   # @param {string} type - parameter type
   # @returns{boolean} - true if it is a date
 sub isdateparm {  sub isdateparm {
     my $type=shift;      my $type=shift;
     return (($type=~/^date/) && (!($type eq 'date_interval')));      return (($type=~/^date/) && (!($type eq 'date_interval')));
 }  }
   
   # Prints the HTML and Javascript to select parameters, with various shortcuts.
   # FIXME: remove unused parameters
 #  #
 # parmmenu displays a list of the selected parameters.  # @param {Apache2::RequestRec} $r - the Apache request (unused)
 # It also offers a link to show/hide the complete parameter list  # @param {hash reference} $allparms - hash parameter name -> parameter title
 # from which you can select all desired parameters.  # @param {array reference} $pscat - list of selected parameter names (unused)
 #  # @param {hash reference} $keyorder - hash parameter key -> appearance rank (unused)
 sub parmmenu {  sub parmmenu {
     my ($r,$allparms,$pscat,$keyorder)=@_;      my ($r,$allparms,$pscat,$keyorder)=@_;
     my $tempkey;      my $tempkey;
Line 1581  sub parmmenu { Line 1805  sub parmmenu {
             displayOverview = "none"              displayOverview = "none"
         }          }
   
     for (i=0; i<document.forms.parmform.elements.length; i++) {          for (i=0; i<document.forms.parmform.elements.length; i++) {
             ele = document.forms.parmform.elements[i];              ele = document.forms.parmform.elements[i];
             if (ele.name == checkName) {              if (ele.name == checkName) {
                 document.forms.parmform.elements[i].checked=value;                  document.forms.parmform.elements[i].checked=value;
Line 1590  sub parmmenu { Line 1814  sub parmmenu {
     }      }
   
     function checkthis(thisvalue, checkName) {      function checkthis(thisvalue, checkName) {
           for (i=0; i<document.forms.parmform.elements.length; i++) {
   
     for (i=0; i<document.forms.parmform.elements.length; i++) {  
             ele = document.forms.parmform.elements[i];              ele = document.forms.parmform.elements[i];
             if (ele.name == checkName) {              if (ele.name == checkName) {
         if (ele.value == thisvalue) {                  if (ele.value == thisvalue) {
             document.forms.parmform.elements[i].checked=true;                      document.forms.parmform.elements[i].checked=true;
         }                  }
             }              }
         }          }
     }      }
   
     function checkdates() {      function checkdates() {
     checkthis('duedate','pscat');          checkthis('duedate','pscat');
      checkthis('opendate','pscat');          checkthis('opendate','pscat');
     checkthis('answerdate','pscat');          checkthis('answerdate','pscat');
     }      }
   
     function checkdisset() {      function checkdisset() {
      checkthis('discussend','pscat');          checkthis('discussend','pscat');
      checkthis('discusshide','pscat');          checkthis('discusshide','pscat');
      checkthis('discussvote','pscat');          checkthis('discussvote','pscat');
     }      }
   
     function checkcontdates() {      function checkcontdates() {
     checkthis('contentopen','pscat');          checkthis('contentopen','pscat');
      checkthis('contentclose','pscat');          checkthis('contentclose','pscat');
     }      }
   
     function checkvisi() {      function checkvisi() {
     checkthis('hiddenresource','pscat');          checkthis('hiddenresource','pscat');
      checkthis('encrypturl','pscat');          checkthis('encrypturl','pscat');
     checkthis('problemstatus','pscat');          checkthis('problemstatus','pscat');
     checkthis('contentopen','pscat');          checkthis('contentopen','pscat');
     checkthis('opendate','pscat');          checkthis('opendate','pscat');
     }      }
   
     function checkparts() {      function checkparts() {
     checkthis('hiddenparts','pscat');          checkthis('hiddenparts','pscat');
     checkthis('display','pscat');          checkthis('display','pscat');
     checkthis('ordered','pscat');          checkthis('ordered','pscat');
     }      }
   
     function checkstandard() {      function checkstandard() {
         checkall(false,'pscat');          checkall(false,'pscat');
     checkdates();          checkdates();
     checkthis('weight','pscat');          checkthis('weight','pscat');
     checkthis('maxtries','pscat');          checkthis('maxtries','pscat');
     checkthis('type','pscat');          checkthis('type','pscat');
     checkthis('problemstatus','pscat');          checkthis('problemstatus','pscat');
     }      }
   
 // ]]>  // ]]>
Line 1650  ENDSCRIPT Line 1872  ENDSCRIPT
     &shortCuts($r,$allparms,$pscat,$keyorder);      &shortCuts($r,$allparms,$pscat,$keyorder);
     $r->print('<hr />');      $r->print('<hr />');
 }  }
 # return a hash  
   # Returns parameter categories.
   #
   # @returns {hash} - category name -> title in English
 sub categories {  sub categories {
     return ('time_settings' => 'Time Settings',      return ('time_settings' => 'Time Settings',
     'grading' => 'Grading',      'grading' => 'Grading',
Line 1664  sub categories { Line 1889  sub categories {
     'misc' => 'Miscellaneous' );       'misc' => 'Miscellaneous' ); 
 }  }
   
 # return a hash. Like a look-up table  # Returns the category for each parameter.
   #
   # @returns {hash} - parameter name -> category name
 sub lookUpTableParameter {  sub lookUpTableParameter {
     
     return (       return ( 
Line 1712  sub lookUpTableParameter { Line 1939  sub lookUpTableParameter {
         'retrypartial' => 'tries',          'retrypartial' => 'tries',
         'discussvote'  => 'misc',          'discussvote'  => 'misc',
         'examcode' => 'high_level_randomization',           'examcode' => 'high_level_randomization', 
     );          );
 }  }
   
   # Adds the given parameter name to an array of arrays listing all parameters for each category.
   #
   # @param {string} $name - parameter name
   # @param {array reference} $catList - array reference category name -> array reference of parameter names
 sub whatIsMyCategory {  sub whatIsMyCategory {
     my $name = shift;      my $name = shift;
     my $catList = shift;      my $catList = shift;
Line 1738  sub whatIsMyCategory { Line 1969  sub whatIsMyCategory {
     }              }        
 }  }
   
   # Sorts parameter names based on appearance order.
   #
   # @param {array reference} name - array reference of parameter names
   # @param {hash reference} $keyorder - hash parameter key -> appearance rank
   # @returns {Array} - array of parameter names
 sub keysindisplayorderCategory {  sub keysindisplayorderCategory {
     my ($name,$keyorder)=@_;      my ($name,$keyorder)=@_;
     return sort {      return sort {
Line 1745  sub keysindisplayorderCategory { Line 1981  sub keysindisplayorderCategory {
     } ( @{$name});      } ( @{$name});
 }  }
   
   # Returns a hash category name -> order, starting at 1 (integer)
   #
   # @returns {hash}
 sub category_order {  sub category_order {
     return (      return (
         'time_settings' => 1,          'time_settings' => 1,
Line 1761  sub category_order { Line 2000  sub category_order {
   
 }  }
   
   # Prints HTML to let the user select parameters, from a list of all parameters organized by category.
   #
   # @param {Apache2::RequestRec} $r - the Apache request
   # @param {hash reference} $allparms - hash parameter name -> parameter title
   # @param {array reference} $pscat - list of selected parameter names
   # @param {hash reference} $keyorder - hash parameter key -> appearance rank
 sub parmboxes {  sub parmboxes {
     my ($r,$allparms,$pscat,$keyorder)=@_;      my ($r,$allparms,$pscat,$keyorder)=@_;
     my %categories = &categories();      my %categories = &categories();
Line 1788  sub parmboxes { Line 2033  sub parmboxes {
         $r->print('<div class="LC_Box LC_400Box">'          $r->print('<div class="LC_Box LC_400Box">'
                  .'<h4 class="LC_hcell">'.&mt($categories{$key}).'</h4>'."\n");                   .'<h4 class="LC_hcell">'.&mt($categories{$key}).'</h4>'."\n");
         foreach my $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {          foreach my $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {
               next if ($tempkey eq '');
             $r->print('<span class="LC_nobreak">'              $r->print('<span class="LC_nobreak">'
                      .'<label><input type="checkbox" name="pscat" '                       .'<label><input type="checkbox" name="pscat" '
                      .'value="'.$tempkey.'" ');                       .'value="'.$tempkey.'" ');
Line 1802  sub parmboxes { Line 2048  sub parmboxes {
     }      }
     $r->print("\n");      $r->print("\n");
 }  }
   
   # Prints HTML with shortcuts to select groups of parameters in one click, or deselect all.
   # FIXME: remove unused parameters
 #  #
 # This function offers some links on the parameter section to get with one click a group a parameters  # @param {Apache2::RequestRec} $r - the Apache request
 #  # @param {hash reference} $allparms - hash parameter name -> parameter title (unused)
   # @param {array reference} $pscat - list of selected parameter names (unused)
   # @param {hash reference} $keyorder - hash parameter key -> appearance rank (unused)
 sub shortCuts {  sub shortCuts {
     my ($r,$allparms,$pscat,$keyorder)=@_;      my ($r,$allparms,$pscat,$keyorder)=@_;
   
Line 1837  sub shortCuts { Line 2088  sub shortCuts {
     );      );
 }  }
   
   # Prints HTML to select parts to view (except for the title).
   # Used by table and overview modes.
   #
   # @param {Apache2::RequestRec} $r - the Apache request
   # @param {hash reference} $allparts - hash parameter part -> part title
   # @param {array reference} $psprt - list of selected parameter parts
 sub partmenu {  sub partmenu {
     my ($r,$allparts,$psprt)=@_;      my ($r,$allparts,$psprt)=@_;
     my $selsize = 1+scalar(keys(%{$allparts}));      my $selsize = 1+scalar(keys(%{$allparts}));
Line 1846  sub partmenu { Line 2103  sub partmenu {
   
     $r->print('<select multiple="multiple" name="psprt" size="'.$selsize.'">');      $r->print('<select multiple="multiple" name="psprt" size="'.$selsize.'">');
     $r->print('<option value="all"');      $r->print('<option value="all"');
     $r->print(' selected="selected"') unless (@{$psprt});      $r->print(' selected="selected"') unless (@{$psprt}); # useless, the array is never empty
     $r->print('>'.&mt('All Parts').'</option>');      $r->print('>'.&mt('All Parts').'</option>');
     my %temphash=();      my %temphash=();
     foreach (@{$psprt}) { $temphash{$_}=1; }      foreach (@{$psprt}) { $temphash{$_}=1; }
Line 1864  sub partmenu { Line 2121  sub partmenu {
     $r->print('</select>');      $r->print('</select>');
 }  }
   
   # Prints HTML to select a user and/or a group.
   # Used by table mode.
   #
   # @param {Apache2::RequestRec} $r - the Apache request
   # @param {string} $uname - selected user name
   # @param {string} $id - selected Student/Employee ID
   # @param {string} $udom - selected user domain
   # @param {string} $csec - selected section name
   # @param {string} $cgroup - selected group name
   # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
   # @param {array reference} $usersgroups - list of groups the user belongs to, if any
   # @param {string} $pssymb - resource symb (when a single resource is selected)
 sub usermenu {  sub usermenu {
     my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups,$pssymb)=@_;      my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups,$pssymb)=@_;
     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.      my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
Line 1974  function group_or_section(caller) { Line 2243  function group_or_section(caller) {
                  ,$chooseopt));                   ,$chooseopt));
 }  }
   
   # Prints HTML to select parameters from a list of all parameters.
   # Uses parmmenu and parmboxes.
   # Used by table and overview modes.
 #  #
 # This function shows on table Mode the available Parameters for the selected Resources  # @param {Apache2::RequestRec} $r - the Apache request
 #  # @param {hash reference} $allparms - hash parameter name -> parameter title
   # @param {array reference} $pscat - list of selected parameter names
   # @param {array reference} $psprt - list of selected parameter parts (unused)
   # @param {hash reference} $keyorder - hash parameter key -> appearance rank
   # @param {string} [$divid] - name used to give an id to the HTML element for the scroll box
 sub displaymenu {  sub displaymenu {
     my ($r,$allparms,$pscat,$psprt,$keyorder,$divid)=@_;      my ($r,$allparms,$pscat,$psprt,$keyorder,$divid)=@_;
   
     $r->print(&Apache::lonhtmlcommon::start_pick_box());      $r->print(&Apache::lonhtmlcommon::start_pick_box());
     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameters to View')));      $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameters to View')));
   
     &parmmenu($r,$allparms,$pscat,$keyorder);      &parmmenu($r,$allparms,$pscat,$keyorder); # only $allparms is used by parmmenu
     $r->print(&Apache::loncommon::start_scrollbox('480px','440px','200px',$divid));      $r->print(&Apache::loncommon::start_scrollbox('480px','440px','200px',$divid));
     &parmboxes($r,$allparms,$pscat,$keyorder);      &parmboxes($r,$allparms,$pscat,$keyorder);
     $r->print(&Apache::loncommon::end_scrollbox());      $r->print(&Apache::loncommon::end_scrollbox());
Line 1993  sub displaymenu { Line 2269  sub displaymenu {
     
 }  }
   
   # Prints HTML to select a map.
   # Used by table mode and overview mode.
   #
   # @param {Apache2::RequestRec} $r - the Apache request
   # @param {hash reference} $allmaps - hash map pc -> map src
   # @param {string} $pschp - selected map pc, or 'all'
   # @param {hash reference} $maptitles - hash map id or src -> map title
   # @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 2144  sub mapmenu { Line 2428  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 2163  sub levelmenu { Line 2451  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 2188  sub sectionmenu { Line 2481  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 2210  sub groupmenu { Line 2508  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 2222  sub keysinorder { Line 2532  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 2234  sub keysinorder_bytype { Line 2550  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 2241  sub keysindisplayorder { Line 2563  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 2256  sub sortmenu { Line 2583  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 2284  sub standardkeyorder { Line 2614  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
   # @param $parm_permission - ref to hash of permissions
   #                           if $parm_permission->{'edit'} is true, editing is allowed.
 sub assessparms {  sub assessparms {
   
     my $r=shift;      my ($r,$parm_permission) = @_;
   
   
 # -------------------------------------------------------- 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 2313  sub assessparms { Line 2673  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 2457  sub assessparms { Line 2817  sub assessparms {
     $symbp{'0.0'} = '';      $symbp{'0.0'} = '';
   
 # ---------------------------------------------------------- Anything to store?  # ---------------------------------------------------------- Anything to store?
     if ($env{'form.pres_marker'}) {      if ($env{'form.pres_marker'} && $parm_permission->{'edit'}) {
         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});          my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
         my @values=split(/\&\&\&/,$env{'form.pres_value'});          my @values=split(/\&\&\&/,$env{'form.pres_value'});
         my @types=split(/\&\&\&/,$env{'form.pres_type'});          my @types=split(/\&\&\&/,$env{'form.pres_type'});
Line 2618  sub assessparms { Line 2978  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 2640  sub assessparms { Line 3006  sub assessparms {
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
 function parmsel_show() {  function parmsel_show() {
   document.getElementById('parmsel').style.display = "";      document.getElementById('parmsel').style.display = "";
   document.getElementById('parmsellink').style.display = "none";      document.getElementById('parmsellink').style.display = "none";
 }  }
 // ]]>  // ]]>
 </script>  </script>
 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 2743  ENDPARMSELSCRIPT Line 3110  ENDPARMSELSCRIPT
         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;          my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
         my $csuname=$env{'user.name'};          my $csuname=$env{'user.name'};
         my $csudom=$env{'user.domain'};          my $csudom=$env{'user.domain'};
           my $readonly = 1;
           if ($parm_permission->{'edit'}) {
               undef($readonly); 
           }
   
         if ($parmlev eq 'full') {          if ($parmlev eq 'full') {
 #  #
Line 2926  ENDTABLEHEADFOUR Line 3297  ENDTABLEHEADFOUR
                             &print_row($r,$item,\%part,\%name,\%symbp,$rid,\%default,                              &print_row($r,$item,\%part,\%name,\%symbp,$rid,\%default,
                                        \%type,\%display,$defbgone,$defbgtwo,                                         \%type,\%display,$defbgone,$defbgtwo,
                                        $defbgthree,$parmlev,$uname,$udom,$csec,                                         $defbgthree,$parmlev,$uname,$udom,$csec,
                                        $cgroup,\@usersgroups,$noeditgrp);                                         $cgroup,\@usersgroups,$noeditgrp,$readonly);
                         }                          }
                     }                      }
                 }                  }
Line 3049  ENDTABLEHEADFOUR Line 3420  ENDTABLEHEADFOUR
                     $r->print(&Apache::loncommon::start_data_table_row());                      $r->print(&Apache::loncommon::start_data_table_row());
                     &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,                      &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,                             \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp);                             $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                              $readonly);
                 }                  }
                 $r->print(&Apache::loncommon::end_data_table().'</p>'                  $r->print(&Apache::loncommon::end_data_table().'</p>'
                          .'</div>'                           .'</div>'
Line 3138  ENDMAPONE Line 3510  ENDMAPONE
             foreach my $item (&keysinorder(\%name,\%keyorder)) {              foreach my $item (&keysinorder(\%name,\%keyorder)) {
                 $r->print(&Apache::loncommon::start_data_table_row());                  $r->print(&Apache::loncommon::start_data_table_row());
                 &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,                  &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
                        \%type,\%display,$defbgone,$defbgtwo,$defbgthree,                             \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                                    $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp);                             $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                              $readonly);
             }              }
             $r->print(&Apache::loncommon::end_data_table()              $r->print(&Apache::loncommon::end_data_table()
                      .'</p>'                       .'</p>'
Line 3157  ENDMAPONE Line 3530  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,$is_map) = @_;
     if ($tableopen) {      if ($tableopen) {
         return '';          return '';
     } else {      } else {
Line 3169  sub tablestart { Line 3546  sub tablestart {
         if ($readonly) {          if ($readonly) {
             $output .= '<th>'.&mt('Current value').'</th>';              $output .= '<th>'.&mt('Current value').'</th>';
         } else {          } else {
             $output .= '<th>'.&mt('Delete').'</th><th>'.&mt('Set to ...').'</th>';              $output .= '<th>'.&mt('Delete').'</th>'.
                          '<th>'.&mt('Set to ...').'</th>';
               if ($is_map) {
                   $output .= '<th>'.&mt('Recursive?').'</th>';
               }
         }          }
         $output .= '</tr>';          $output .= '</tr>';
         return $output;          return $output;
     }      }
 }  }
   
   # 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 3185  sub tableend { Line 3568  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 3213  sub readdata { Line 3603  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 3223  sub storedata { Line 3629  sub storedata {
     my %newdata=();      my %newdata=();
     undef %newdata;      undef %newdata;
     my @deldata=();      my @deldata=();
       my @delrec=();
       my @delnonrec=();
     undef @deldata;      undef @deldata;
     my ($got_chostname,$chostname,$cmajor,$cminor);      my ($got_chostname,$chostname,$cmajor,$cminor);
     my $now = time;      my $now = time;
Line 3230  sub storedata { Line 3638  sub storedata {
         if ($key =~ /^form\.([a-z]+)\_(.+)$/) {          if ($key =~ /^form\.([a-z]+)\_(.+)$/) {
             my $cmd=$1;              my $cmd=$1;
             my $thiskey=$2;              my $thiskey=$2;
             next if ($cmd eq 'settext' || $cmd eq 'setipallow' || $cmd eq 'setipdeny');              my ($altkey,$recursive,$tkey,$tkeyrec,$tkeynonrec);
               next if ($cmd eq 'rec' || $cmd eq 'settext' || $cmd eq 'setipallow' || $cmd eq 'setipdeny');
               if ((($cmd eq 'set') || ($cmd eq 'datepointer') || ($cmd eq 'dateinterval') || ($cmd eq 'del')) && 
                    ($thiskey =~ /(?:sequence|page)\Q___(all)\E/)) {
                   unless ($thiskey =~ /(encrypturl|hiddenresource)$/) {
                       $altkey = $thiskey;
                       $altkey =~ s/\Q___(all)\E/___(rec)/;
                       if ($env{'form.rec_'.$thiskey}) {
                           $recursive = 1;
                       }
                   }
               }
             my ($tuname,$tudom)=&extractuser($thiskey);              my ($tuname,$tudom)=&extractuser($thiskey);
             my $tkey=$thiskey;  
             if ($tuname) {              if ($tuname) {
                   $tkey=$thiskey;
                 $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;                  $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   if ($altkey) {
                       $tkeynonrec = $tkey; 
                       $tkeyrec = $altkey;
                       $tkeyrec=~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 ($recursive) {
                 $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)=&parameter_release_vars();  
                             $got_chostname = 1;  
                         }  
                         $needsnewer = &parameter_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) = &parameter_release_vars();                                  ($chostname,$cmajor,$cminor)=&parameter_release_vars();
                                 $got_chostname = 1;                                  $got_chostname = 1;
                             }                              }
                             $needsnewer = &parameter_releasecheck(undef,$valchk,$valmatch,$namematch,                              $needsnewer = &parameter_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) = &parameter_release_vars();
                                       $got_chostname = 1;
                                   }
                                   $needsnewer = &parameter_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) {                  my ($reconlychg,$haschange,$storekey);
                     $r->print('<br />'.&oldversion_warning($name,$namematch,$data,  
                                                         $chostname,$cmajor,  
                                                         $cminor,$needsrelease));  
                     next;  
                 }  
             }  
             if (defined($data) and $$olddata{$thiskey} ne $data) {  
                 if ($tuname) {                  if ($tuname) {
                     if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,                      my $ustorekey;
                                         $tkey.'.type' => $typeof},                      if ($altkey) {
                                 $tudom,$tuname) eq 'ok') {                          if ($recursive) {
                         &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom);                              if (exists($$olddata{$thiskey})) {
                         $r->print('<br />'.$text.' '.                                  if ($$olddata{$thiskey} eq $data) {
                             &Apache::loncommon::plainname($tuname,$tudom));                                      $reconlychg = 1;
                                   }
                                   &Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname);
                               }
                               if (exists($$olddata{$altkey})) {
                                   if (defined($data) && $$olddata{$altkey} ne $data) {
                                       $haschange = 1;
                                   }
                               } elsif ((!$reconlychg) && ($data ne '')) {
                                   $haschange = 1;
                               }
                               $ustorekey = $tkeyrec;
                           } else {
                               if (exists($$olddata{$altkey})) {
                                   if ($$olddata{$altkey} eq $data) {
                                       $reconlychg = 1;
                                   }
                                   &Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname);
                               }
                               if (exists($$olddata{$thiskey})) {
                                   if (defined($data) && $$olddata{$thiskey} ne $data) {
                                       $haschange = 1;
                                   }
                               } elsif ((!$reconlychg) && ($data ne '')) {
                                   $haschange = 1;
                               }
                               $ustorekey = $tkeynonrec;
                           }
                     } else {                      } else {
                         $r->print('<div class="LC_error">'.                          if (exists($$olddata{$tkey})) {
                             &mt('Error saving parameters').'</div>');                              if (defined($data) && $$olddata{$tkey} ne $data) {
                                   $haschange = 1;
                               }
                               $ustorekey = $tkey;
                           }
                       }
                       if ($haschange || $reconlychg)  {
                           unless ($env{'form.del_'.$thiskey}) {
                               if (&Apache::lonnet::put('resourcedata',{$ustorekey=>$data,
                                                                        $ustorekey.'.type' => $typeof},
                                                                        $tudom,$tuname) eq 'ok') {
                                   &log_parmset({$ustorekey=>$data,$ustorekey.'.type' => $typeof},0,$tuname,$tudom);
                                   $r->print('<br />'.$text.' '.
                                             &Apache::loncommon::plainname($tuname,$tudom));
                               } else {
                                   $r->print('<div class="LC_error">'.
                                             &mt('Error saving parameters').'</div>');
                               }
                               &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                           }
                     }                      }
                     &Apache::lonnet::devalidateuserresdata($tuname,$tudom);  
                 } else {                  } else {
                     $newdata{$thiskey}=$data;                      if ($altkey) {
                     $newdata{$thiskey.'.type'}=$typeof;                          if ($recursive) {
                               if (exists($$olddata{$thiskey})) {
                                   if ($$olddata{$thiskey} eq $data) {
                                       $reconlychg = 1;
                                   }
                                   push(@delnonrec,($thiskey,$thiskey.'.type'));
                               }
                               if (exists($$olddata{$altkey})) {
                                   if (defined($data) && $$olddata{$altkey} ne $data) {
                                       $haschange = 1;
                                   }
                               } elsif (($data ne '') && (!$reconlychg)) {
                                   $haschange = 1;
                               }
                               $storekey = $altkey;
                           } else {
                               if (exists($$olddata{$altkey})) {
                                   if ($$olddata{$altkey} eq $data) {
                                       $reconlychg = 1;
                                   }
                                   push(@delrec,($altkey,$altkey.'.type'));
                               } 
                               if (exists($$olddata{$thiskey})) {
                                   if (defined($data) && $$olddata{$thiskey} ne $data) {
                                       $haschange = 1;
                                   }
                               } elsif (($data ne '') && (!$reconlychg)) {
                                   $haschange = 1;
                               }
                               $storekey = $thiskey;
                           }
                       } else {
                           if (defined($data) && $$olddata{$thiskey} ne $data) {
                               $haschange = 1;
                               $storekey = $thiskey;
                           }
                       }
                   }
                   if ($reconlychg || $haschange) {
                       unless ($env{'form.del_'.$thiskey}) {
                           $newdata{$storekey}=$data;
                           $newdata{$storekey.'.type'}=$typeof;
                       }
                 }                  }
             }  
             } elsif ($cmd eq 'del') {              } elsif ($cmd eq 'del') {
                 if ($tuname) {                  if ($tuname) {
                     if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') {                      my $error;
                             &log_parmset({$tkey=>''},1,$tuname,$tudom);                      if ($altkey) {  
                         $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));                          if (exists($$olddata{$altkey})) {
                               if (&Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname) eq 'ok') {
                                   &log_parmset({$tkeyrec=>''},1,$tuname,$tudom);
                                   if ($recursive) {
                                       $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                                   }
                               } elsif ($recursive) {
                                   $error = 1;
                               }
                           }
                           if (exists($$olddata{$thiskey})) {
                               if (&Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname) eq 'ok') {
                                   &log_parmset({$tkeynonrec=>''},1,$tuname,$tudom);
                                   unless ($recursive) {
                                       $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                                   }
                               } elsif (!$recursive) {
                                   $error = 1;
                               }
                           }
                     } else {                      } else {
                           if (exists($$olddata{$thiskey})) {
                               if (&Apache::lonnet::del('resourcedata',[$tkey,$tkey.'.type'],$tudom,$tuname) eq 'ok') {
                                   &log_parmset({$tkey=>''},1,$tuname,$tudom);
                                   $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                               } else {
                                   $error = 1;
                               }
                           }
                       }
                       if ($error) { 
                         $r->print('<div class="LC_error">'.                          $r->print('<div class="LC_error">'.
                             &mt('Error deleting parameters').'</div>');                              &mt('Error deleting parameters').'</div>');
                     }                      }
                     &Apache::lonnet::devalidateuserresdata($tuname,$tudom);                      &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                 } else {                  } else {
                     push (@deldata,$thiskey,$thiskey.'.type');                      if ($altkey) {
                           if (exists($$olddata{$altkey})) {
                               unless (grep(/^\Q$altkey\E$/,@delrec)) {
                                   push(@deldata,($altkey,$altkey.'.type'));
                               }
                           }
                           if (exists($$olddata{$thiskey})) {
                               unless (grep(/^\Q$thiskey\E$/,@delnonrec)) {
                                   push(@deldata,($thiskey,$thiskey.'.type'));
                               }
                           }
                       } elsif (exists($$olddata{$thiskey})) {
                           push(@deldata,($thiskey,$thiskey.'.type'));
                       }
                 }                  }
             }              }
         }          }
     }      }
 # Store all course level  # Store all course level
     my $delentries=$#deldata+1;      my $delentries=$#deldata+1;
       my @alldels;
       if (@delrec) {
           push(@alldels,@delrec);
       }
       if (@delnonrec) {
           push(@alldels,@delnonrec);
       }
       if (@deldata) {
           push(@alldels,@deldata);
       }
     my @newdatakeys=keys(%newdata);      my @newdatakeys=keys(%newdata);
     my $putentries=$#newdatakeys+1;      my $putentries=$#newdatakeys+1;
     if ($delentries) {      my ($delresult,$devalidate);
         if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {      if (@alldels) {
             my %loghash=map { $_ => '' } @deldata;          if (&Apache::lonnet::del('resourcedata',\@alldels,$dom,$crs) eq 'ok') {
               my %loghash=map { $_ => '' } @alldels;
             &log_parmset(\%loghash,1);              &log_parmset(\%loghash,1);
             $r->print('<h2>'.&mt('Deleted [quant,_1,parameter]',$delentries/2).'</h2>');              if ($delentries) {
         } else {                  $r->print('<h2>'.&mt('Deleted [quant,_1,parameter]',$delentries/2).'</h2>');
               }
           } elsif ($delentries) {
             $r->print('<div class="LC_error">'.              $r->print('<div class="LC_error">'.
                 &mt('Error deleting parameters').'</div>');                  &mt('Error deleting parameters').'</div>');
         }          }
         &Apache::lonnet::devalidatecourseresdata($crs,$dom);          $devalidate = 1; 
     }      }
     if ($putentries) {      if ($putentries) {
         if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {          if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
Line 3421  sub storedata { Line 3987  sub storedata {
             $r->print('<div class="LC_error">'.              $r->print('<div class="LC_error">'.
                 &mt('Error saving parameters').'</div>');                  &mt('Error saving parameters').'</div>');
         }          }
           $devalidate = 1; 
       }
       if ($devalidate) {
         &Apache::lonnet::devalidatecourseresdata($crs,$dom);          &Apache::lonnet::devalidatecourseresdata($crs,$dom);
     }      }
 }  }
   
   # 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 3450  sub parse_listdata_key { Line 4028  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
   # @param {boolean} $readonly - true if editing not allowed
   # @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,$readonly)=@_;
           
 # Start list output  # Start list output
   
Line 3474  sub listdata { Line 4061  sub listdata {
         }          }
     }      }
   
     foreach my $thiskey (sort {      foreach my $key (sort {
         my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);          my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
         my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);          my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
   
Line 3514  sub listdata { Line 4101  sub listdata {
   
         $result;          $result;
                   
     } keys(%{$listdata})) { # foreach my $thiskey      } keys(%{$listdata})) { # foreach my $key
           my $thiskey = $key;
         my $readonly;  
         if ($$listdata{$thiskey.'.type'}) {          if ($$listdata{$thiskey.'.type'}) {
             my $thistype=$$listdata{$thiskey.'.type'};              my $thistype=$$listdata{$thiskey.'.type'};
             if ($$resourcedata{$thiskey.'.type'}) {              if ($$resourcedata{$thiskey.'.type'}) {
                 $thistype=$$resourcedata{$thiskey.'.type'};                  $thistype=$$resourcedata{$thiskey.'.type'};
             }              }
             my ($middle,$part,$name)=              my ($middle,$part,$name)=
                 ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);                  ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
             my $section=&mt('All Students');              my $section=&mt('All Students');
               my $showval = $$resourcedata{$thiskey}; 
             if ($middle=~/^\[(.*)\]/) {              if ($middle=~/^\[(.*)\]/) {
                 my $issection=$1;                  my $issection=$1;
                 if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {                  if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
Line 3557  sub listdata { Line 4144  sub listdata {
             $middle=~s/\.+$//;              $middle=~s/\.+$//;
             $middle=~s/^\.+//;              $middle=~s/^\.+//;
             my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';              my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
             if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {              my ($is_map,$is_recursive,$mapurl,$maplevel);
                 my $mapurl = $1;              if ($caller eq 'overview') {
                 my $maplevel = $2;                  if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                       $mapurl = $1;
                       $maplevel = $2;
                       $is_map = 1;
                   }
               } elsif ($caller eq 'newoverview') {
                   if ($middle=~/^(.+)\_\_\_\((all)\)$/) {
                       $mapurl = $1;
                       $maplevel = $2;
                       $is_map = 1;
                   }
               }
               if ($is_map) {
                 my $leveltitle = &mt('Folder/Map');                  my $leveltitle = &mt('Folder/Map');
                 if ($maplevel eq 'rec') {                  unless (($name eq 'hiddenresource') || ($name eq 'encrypturl')) {   
                     $leveltitle = &mt('Recursive');                      if ($caller eq 'newoverview') {
                           my $altkey = $thiskey;
                           $altkey =~ s/\Q___(all)\E/___(rec)/;
                           if ((exists($$resourcedata{$altkey})) & (!exists($$resourcedata{$thiskey}))) {
                               $is_recursive = 1;
                               if ($$resourcedata{$altkey.'.type'}) {
                                   $thistype=$$resourcedata{$altkey.'.type'};
                               }
                               $showval = $$resourcedata{$altkey};
                           }
                       } elsif (($caller eq 'overview') && ($maplevel eq 'rec')) {
                           $thiskey =~ s/\Q___(rec)\E/___(all)/;
                           $is_recursive = 1;
                       }
                 }                  }
                 $realm='<span class="LC_parm_scope_folder">'.$leveltitle.': '.&Apache::lonnet::gettitle($mapurl).' <br /><span class="LC_parm_folder">('.$mapurl.')</span></span>';                  $realm='<span class="LC_parm_scope_folder">'.$leveltitle.': '.&Apache::lonnet::gettitle($mapurl).' <br /><span class="LC_parm_folder">('.$mapurl.')</span></span>';
             } elsif ($middle) {              } elsif ($middle) {
Line 3604  sub listdata { Line 4216  sub listdata {
     # Ready to print      # Ready to print
     #      #
             my $parmitem = &standard_parameter_names($name);              my $parmitem = &standard_parameter_names($name);
             $r->print(&tablestart($readonly).              $r->print(&tablestart($readonly,$is_map).
                 &Apache::loncommon::start_data_table_row().                  &Apache::loncommon::start_data_table_row().
                 '<td><b>'.&mt($parmitem).                  '<td><b>'.&mt($parmitem).
                 '</b></td>');                  '</b></td>');
Line 3624  sub listdata { Line 4236  sub listdata {
                 $r->print(                  $r->print(
                     &Apache::lonhtmlcommon::date_setter('parmform',                      &Apache::lonhtmlcommon::date_setter('parmform',
                                                         $jskey,                                                          $jskey,
                                                         $$resourcedata{$thiskey},                                                          $showval,
                                                         '',1,$state));                                                          '',1,$state));
                 unless  ($readonly) {                  unless  ($readonly) {
                     $r->print(                      $r->print(
     '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.      '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
     (($$resourcedata{$thiskey}!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$$resourcedata{$thiskey}.'">'.      (($showval!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$showval.'">'.
     &mt('Shift all dates based on this date').'</a></span>':'').      &mt('Shift all dates based on this date').'</a></span>':'').
     &date_sanity_info($$resourcedata{$thiskey})      &date_sanity_info($showval)
                     );                      );
                 }                  }
             } elsif ($thistype eq 'date_interval') {              } elsif ($thistype eq 'date_interval') {
                 $r->print(&date_interval_selector($thiskey,$name,                  $r->print(&date_interval_selector($thiskey,$name,
                         $$resourcedata{$thiskey},$readonly));                            $showval,$readonly));
             } elsif ($thistype =~ m/^string/) {              } elsif ($thistype =~ m/^string/) {
                 $r->print(&string_selector($thistype,$thiskey,                  $r->print(&string_selector($thistype,$thiskey,
                         $$resourcedata{$thiskey},$name,$readonly));                            $showval,$name,$readonly));
             } else {              } else {
                 $r->print(&default_selector($thiskey,$$resourcedata{$thiskey},$readonly));                  $r->print(&default_selector($thiskey,$showval,$readonly));
             }              }
             unless ($readonly) {              unless ($readonly) {
                 $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.                  $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                         $thistype.'" />');                          $thistype.'" />');
             }              }
             $r->print('</td>'.&Apache::loncommon::end_data_table_row());              $r->print('</td>');
               if ($is_map) {
                   if (($name eq 'encrypturl') || ($name eq 'hiddenresource')) {
                       $r->print('<td><table><tr><td>'.&mt('Yes').'</td></tr></table></td>');
                   } else {
                       my ($disabled,$recon,$recoff);
                       if ($readonly) {
                           $disabled = ' disabled="disabled"';
                       }
                       if ($is_recursive) {
                           $recon = ' checked="checked"';
                       } else {
                           $recoff = ' checked="checked"';
                       }
                       $r->print('<td><table><tr><td><label><input type="radio" name="rec_'.$thiskey.'" value="1"'.$recon.$disabled.' />'.&mt('Yes').'</label>'.
                                 '</td><td><label><input type="radio" name="rec_'.$thiskey.'" value="0"'.$recoff.$disabled.' />'.&mt('No').'</label></td></tr></table></td>');
                   }
               }
               $r->print(&Apache::loncommon::end_data_table_row());
         }          }
     }      }
     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 3685  sub get_date_interval_from_form { Line 4321  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 3694  sub default_selector { Line 4336  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 3722  sub string_ip_selector { Line 4370  sub string_ip_selector {
         @{$access{'deny'}} = ('');          @{$access{'deny'}} = ('');
     }      }
     my ($disabled,$addmore);      my ($disabled,$addmore);
     if ($disabled) {      if ($readonly) {
         $disabled=' disabled="disabled"';          $disabled=' disabled="disabled"';
     } else {      } else {
         $addmore = "\n".'<button class="LC_add_ipacc_button">'.&mt('Add more').'</button>';          $addmore = "\n".'<button class="LC_add_ipacc_button">'.&mt('Add more').'</button>';
Line 3807  my %stringtypes = ( Line 4455  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 3815  sub standard_string_options { Line 4468  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 3823  sub standard_string_matches { Line 4480  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 3831  sub get_stringtype { Line 4492  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 3996  my %intervaltypes = ( Line 4665  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 4004  sub standard_interval_matches { Line 4677  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 4012  sub get_intervaltype { Line 4689  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 4020  sub standard_interval_options { Line 4702  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 4102  sub date_interval_selector { Line 4791  sub date_interval_selector {
                 $currprocdisplay = 'text';                  $currprocdisplay = 'text';
             }              }
             my $onclick = ' onclick="toggleSecret(this.form,'."'done_','$thiskey'".');"';              my $onclick = ' onclick="toggleSecret(this.form,'."'done_','$thiskey'".');"';
               my $disabled;
               if ($readonly) {
                   $disabled = ' disabled="disabled"';
               }
             $result .= '<br /><span class="LC_nobreak">'.&mt('Include "done" button').              $result .= '<br /><span class="LC_nobreak">'.&mt('Include "done" button').
                        '<label><input type="radio" value="" name="done_'.$thiskey.'"'.$checkedoff.$onclick.' />'.                         '<label><input type="radio" value="" name="done_'.$thiskey.'"'.$checkedoff.$onclick.$disabled.' />'.
                        &mt('No').'</label>'.('&nbsp;'x2).                         &mt('No').'</label>'.('&nbsp;'x2).
                        '<label><input type="radio" value="_done" name="done_'.$thiskey.'"'.$checkedon.$onclick.' />'.                         '<label><input type="radio" value="_done" name="done_'.$thiskey.'"'.$checkedon.$onclick.$disabled.' />'.
                        &mt('Yes').'</label>'.('&nbsp;'x2).                         &mt('Yes').'</label>'.('&nbsp;'x2).
                        '<label><input type="radio" value="_done_proctor" name="done_'.$thiskey.'"'.$checkedproc.$onclick.' />'.                         '<label><input type="radio" value="_done_proctor" name="done_'.$thiskey.'"'.$checkedproc.$onclick.$disabled.' />'.
                        &mt('Yes, with proctor key').'</label>'.                         &mt('Yes, with proctor key').'</label>'.
                        '<input type="'.$currprocdisplay.'" id="done_'.$thiskey.'_proctorkey" '.                         '<input type="'.$currprocdisplay.'" id="done_'.$thiskey.'_proctorkey" '.
                        'name="done_'.$thiskey.'_proctorkey" value="'.&HTML::Entities::encode($currproctorkey,'"<>&').'" /></span><br />'.                         'name="done_'.$thiskey.'_proctorkey" value="'.&HTML::Entities::encode($currproctorkey,'"<>&').'"'.$disabled.' /></span><br />'.
                        '<span class="LC_nobreak">'.&mt('Button text').': '.                         '<span class="LC_nobreak">'.&mt('Button text').': '.
                        '<input type="text" name="done_'.$thiskey.'_buttontext" value="'.&HTML::Entities::encode($currdonetext,'"<>&').'" /></span>';                         '<input type="text" name="done_'.$thiskey.'_buttontext" value="'.&HTML::Entities::encode($currdonetext,'"<>&').'"'.$disabled.' /></span>';
         }          }
     }      }
     unless ($readonly) {      unless ($readonly) {
Line 4121  sub date_interval_selector { Line 4814  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 4196  sub oldversion_warning { Line 4899  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 4231  sub dateshift { Line 4935  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,$parm_permission) = @_;
   
     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};      my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};      my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
     my $crstype =  $env{'course.'.$env{'request.course.id'}.'.type'};      my $crstype =  $env{'course.'.$env{'request.course.id'}.'.type'};
       my $readonly = 1;
       if ($parm_permission->{'edit'}) {
           undef($readonly);
       }
     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',      &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
         text=>"Overview Mode"});          text=>"Overview Mode"});
   
Line 4339  ENDOVER Line 5050  ENDOVER
   
     $r->print('<div class="LC_Box">');      $r->print('<div class="LC_Box">');
     $r->print('<div>');      $r->print('<div>');
     &displaymenu($r,\%allparms,\@pscat,\%keyorder);      &displaymenu($r,\%allparms,\@pscat,\%keyorder); # FIXME: wrong parameters, could make keysindisplayorderCategory crash because $keyorder is undefined
     $r->print(&Apache::lonhtmlcommon::start_pick_box());      $r->print(&Apache::lonhtmlcommon::start_pick_box());
     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));      $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
     my $sectionselector = &sectionmenu(\@selected_sections);      my $sectionselector = &sectionmenu(\@selected_sections);
Line 4395  ENDOVER Line 5106  ENDOVER
   
 # List data  # List data
   
         &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview');          &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview',undef,$readonly);
     }      }
     $r->print(&tableend().      $r->print(&tableend());
          ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'').      unless ($readonly) {
           '</form>');          $r->print( ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'') );
       }
       $r->print('</form>');
     &endSettingsScreen($r);      &endSettingsScreen($r);
     $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 4424  sub secgroup_lister { Line 5151  sub secgroup_lister {
                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;                      my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                     $$listdata{$newparmkey}=1;                      $$listdata{$newparmkey}=1;
                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};                      $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                     $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(rec).'.$part.'.'.$cat;  
                     $$listdata{$newparmkey}=1;  
                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};  
                 }                  }
             } else {              } else {
 # resource-level parameter  # resource-level parameter
Line 4442  sub secgroup_lister { Line 5166  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,$parm_permission) = @_;
     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};      my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};      my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};      my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
       my $readonly = 1;
       if ($parm_permission->{'edit'}) {
           undef($readonly);
       }
     my $js = '<script type="text/javascript">'."\n".      my $js = '<script type="text/javascript">'."\n".
              '// <![CDATA['."\n".               '// <![CDATA['."\n".
              &toggleparmtextbox_js()."\n".               &toggleparmtextbox_js()."\n".
Line 4470  sub overview { Line 5201  sub overview {
   
 # Store modified  # Store modified
   
     &storedata($r,$crs,$dom);      unless ($readonly) {
           &storedata($r,$crs,$dom);
       }
   
 # Read modified data  # Read modified data
   
Line 4481  sub overview { Line 5214  sub overview {
     unless ($sortorder) { $sortorder='realmstudent'; }      unless ($sortorder) { $sortorder='realmstudent'; }
     &sortmenu($r,$sortorder);      &sortmenu($r,$sortorder);
   
       my $submitbutton = '<input type="submit" value="'.&mt('Save').'" />';
   
       if ($readonly) {
           $r->print('<p>'.$submitbutton.'</p>');
       }
   
 # List data  # List data
   
     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist);      my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist,$readonly);
     $r->print(&tableend().'<p>'.      $r->print(&tableend().'<p>');
     ($foundkeys?'<input type="submit" value="'.&mt('Save').'" />':'<span class="LC_info">'.&mt('There are no parameters.').'</span>').'</p></form>'.      if ($foundkeys) {
           &Apache::loncommon::end_page());          unless ($readonly) {
               $r->print('<p>'.$submitbutton.'</p>');
           }
       } else {
           $r->print('<p class="LC_info">'.&mt('There are no parameters.').'</p>');
       }
       $r->print('</form>'.&Apache::loncommon::end_page());
 }  }
   
 # 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 4578  ENDOVER Line 5325  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 4607  sub date_shift_one { Line 5357  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 4635  sub date_shift_two { Line 5387  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;
     my ($middle,$part,$name)=      my ($middle,$part,$name)=
     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);      ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
     $data{'scope_type'} = 'all';      $data{'scope_type'} = 'all';
     if ($middle=~/^\[(.*)\]/) {      if ($middle=~/^\[(.*)\]/) {
         $data{'scope'} = $1;          $data{'scope'} = $1;
Line 4675  sub parse_key { Line 5434  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 4685  sub header { Line 5445  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 4704  ENDMAINFORMHEAD Line 5468  ENDMAINFORMHEAD
     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});      my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});      my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
     my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});      my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});
       my $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'});
       my $vpa = &Apache::lonnet::allowed('vpa',$env{'request.course.id'});
     if ((!$dcm) && ($env{'request.course.sec'} ne '')) {      if ((!$dcm) && ($env{'request.course.sec'} ne '')) {
         $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.          $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.
                                         '/'.$env{'request.course.sec'});                                          '/'.$env{'request.course.sec'});
     }      }
       if ((!$vcb) && ($env{'request.course.sec'} ne '')) {
           $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'}.
                                           '/'.$env{'request.course.sec'});
       }
       my (%linktext,%linktitle,%url);
       if ($parm_permission->{'edit'}) {
           %linktext = (
                        newoverview     => 'Edit Resource Parameters - Overview Mode',
                        settable        => 'Edit Resource Parameters - Table Mode',
                        setoverview     => 'Modify Resource Parameters - Overview Mode',
                       );
           %linktitle = (
                        newoverview     => 'Set/Modify resource parameters in overview mode.',
                        settable        => 'Set/Modify resource parameters in table mode.',
                        setoverview     => 'Set/Modify existing resource parameters in overview mode.',
                        );
       } else {
           %linktext = (
                        newoverview     => 'View Resource Parameters - Overview Mode',
                        settable        => 'View Resource Parameters - Table Mode',
                        setoverview     => 'View Resource Parameters - Overview Mode',
                      );
           %linktitle = (
                        newoverview     => 'Display resource parameters in overview mode.',
                        settable        => 'Display resource parameters in table mode.',
                        setoverview     => 'Display existing resource parameters in overview mode.',
                        );
       }
       if ($mgr) {
           $linktext{'resettimes'} = 'Reset Student Access Times';
           $linktitle{'resettimes'} = "Reset access times for folders/maps, resources or the $lc_crstype.";
           $url{'resettimes'} = '/adm/helper/resettimes.helper';
       } elsif ($vgr) {
           $linktext{'resettimes'} = 'Display Student Access Times',
           $linktitle{'resettimes'} = "Display access times for folders/maps, resources or the $lc_crstype.",
           $url{'resettimes'} = '/adm/accesstimes';
       }
     my @menu =      my @menu =
         ( { categorytitle=>"Content Settings for this $crstype",          ( { categorytitle=>"Content Settings for this $crstype",
         items => [          items => [
           { linktext => 'Portfolio Metadata',            { linktext => 'Portfolio Metadata',
             url => '/adm/parmset?action=setrestrictmeta',              url => '/adm/parmset?action=setrestrictmeta',
             permission => $parm_permission,              permission => $parm_permission->{'setrestrictmeta'},
             linktitle => "Restrict metadata for this $lc_crstype." ,              linktitle => "Restrict metadata for this $lc_crstype." ,
             icon =>'contact-new.png'   ,              icon =>'contact-new.png'   ,
             },              },
           { linktext => 'Reset Student Access Times',            { linktext => $linktext{'resettimes'},
             url => '/adm/helper/resettimes.helper',              url => $url{'resettimes'},
             permission => $mgr,              permission => ($vgr || $mgr),
             linktitle => "Reset access times for folders/maps, resources or the $lc_crstype."  ,              linktitle => $linktitle{'resettimes'},
             icon => 'start-here.png'  ,              icon => 'start-here.png',
             },              },
           { linktext => 'Blocking Communication/Resource Access',            { linktext => 'Blocking Communication/Resource Access',
             url => '/adm/setblock',              url => '/adm/setblock',
             permission => $dcm,              permission => ($vcb || $dcm),
             linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',              linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',
             icon => 'comblock.png',              icon => 'comblock.png',
             },              },
           { linktext => 'Set Parameter Setting Default Actions',            { linktext => 'Set Parameter Setting Default Actions',
             url => '/adm/parmset?action=setdefaults',              url => '/adm/parmset?action=setdefaults',
             permission => $parm_permission,              permission => $parm_permission->{'setdefaults'},
             linktitle =>'Set default actions for parameters.'  ,              linktitle =>'Set default actions for parameters.'  ,
             icon => 'folder-new.png'  ,              icon => 'folder-new.png'  ,
             }]},              }]},
Line 4740  ENDMAINFORMHEAD Line 5542  ENDMAINFORMHEAD
         items => [          items => [
           { linktext => 'Edit Resource Parameters - Helper Mode',            { linktext => 'Edit Resource Parameters - Helper Mode',
             url => '/adm/helper/parameter.helper',              url => '/adm/helper/parameter.helper',
             permission => $parm_permission,              permission => $parm_permission->{'helper'},
             linktitle =>'Set/Modify resource parameters in helper mode.'  ,              linktitle =>'Set/Modify resource parameters in helper mode.'  ,
             icon => 'dialog-information.png'  ,              icon => 'dialog-information.png'  ,
             #help => 'Parameter_Helper',              #help => 'Parameter_Helper',
             },              },
           { linktext => 'Edit Resource Parameters - Overview Mode',            { linktext => $linktext{'newoverview'},
             url => '/adm/parmset?action=newoverview',              url => '/adm/parmset?action=newoverview',
             permission => $parm_permission,              permission => $parm_permission->{'newoverview'},
             linktitle =>'Set/Modify resource parameters in overview mode.'  ,              linktitle => $linktitle{'newoverview'},
             icon => 'edit-find.png'  ,              icon => 'edit-find.png',
             #help => 'Parameter_Overview',              #help => 'Parameter_Overview',
             },              },
           { linktext => 'Edit Resource Parameters - Table Mode',            { linktext => $linktext{'settable'},
             url => '/adm/parmset?action=settable',              url => '/adm/parmset?action=settable',
             permission => $parm_permission,              permission => $parm_permission->{'settable'},
             linktitle =>'Set/Modify resource parameters in table mode.'  ,              linktitle => $linktitle{'settable'},
             icon => 'edit-copy.png'  ,              icon => 'edit-copy.png',
             #help => 'Table_Mode',              #help => 'Table_Mode',
             }]},              }]},
            { categorytitle => 'Existing Parameter Settings for Resources',             { categorytitle => 'Existing Parameter Settings for Resources',
          items => [           items => [
           { linktext => 'Modify Resource Parameters - Overview Mode',            { linktext => $linktext{'setoverview'},
             url => '/adm/parmset?action=setoverview',              url => '/adm/parmset?action=setoverview',
             permission => $parm_permission,              permission => $parm_permission->{'setoverview'},
             linktitle =>'Set/Modify existing resource parameters in overview mode.'  ,              linktitle => $linktitle{'setoverview'},
             icon => 'preferences-desktop-wallpaper.png'  ,              icon => 'preferences-desktop-wallpaper.png',
             #help => 'Parameter_Overview',              #help => 'Parameter_Overview',
             },              },
           { linktext => 'Change Log',            { linktext => 'Change Log',
             url => '/adm/parmset?action=parameterchangelog',              url => '/adm/parmset?action=parameterchangelog',
             permission => $parm_permission,              permission => $parm_permission->{'parameterchangelog'},
             linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,              linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,
             icon => 'document-properties.png',              icon => 'document-properties.png',
             }]}              }]}
Line 4788  ENDMAINFORMHEAD Line 5590  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 4845  sub output_row { Line 5654  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 4935  sub order_meta_fields { Line 5747  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 4944  sub continue { Line 5758  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 4988  sub addmetafield { Line 5806  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">');
         $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 4999  sub addmetafield { Line 5817  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 5074  ENDButtons Line 5894  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 5089  ENDenv Line 5909  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 5103  sub get_added_meta_fieldnames { Line 5927  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 5124  sub get_deleted_meta_fieldnames { Line 5952  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 5217  sub defaultsetter { Line 6047  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 5262  $r->print(&mt('Manual setting rules appl Line 6092  $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 5272  $r->print(&mt('Manual setting rules appl Line 6102  $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 5290  $r->print(&mt('Manual setting rules appl Line 6120  $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 5298  sub components { Line 6150  sub components {
     }      }
   
     my ($middle,$part,$name)=      my ($middle,$part,$name)=
         ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);          ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
     my $issection;      my $issection;
   
     my $section=&mt('All Students');      my $section=&mt('All Students');
Line 5338  sub components { Line 6190  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 5357  sub load_parameter_names { Line 6210  sub load_parameter_names {
     close($config);      close($config);
     $standard_parms{'int_pos'}      = 'Positive Integer';      $standard_parms{'int_pos'}      = 'Positive Integer';
     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';      $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
       $standard_parms{'scoreformat'}  = 'Format for display of score';
 }  }
   
   # 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 5371  sub standard_parameter_names { Line 6229  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 5382  sub standard_parameter_types { Line 6244  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 5397  sub standard_parameter_levels { Line 6263  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,$parm_permission)=@_;
     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};      my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'}      my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',      &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
     text=>"Parameter Change Log"});      text=>"Parameter Change Log"});
     my $js = '<script type="text/javascript">'."\n".      my $js = '<script type="text/javascript">'."\n".
Line 5430  sub parm_change_log { Line 6298  sub parm_change_log {
               '<input type="submit" value="'.&mt('Display').'" />'.                '<input type="submit" value="'.&mt('Display').'" />'.
               '</form></fieldset></div><br clear="all" />');                '</form></fieldset></div><br clear="all" />');
   
       my $readonly = 1;
       if ($parm_permission->{'edit'}) {
           undef($readonly);
       }
     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);      my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().      $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
           '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.            '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
           &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th><th>'.&mt('Announce').'</th>'.            &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th>');
           &Apache::loncommon::end_data_table_header_row());      unless ($readonly) {
           $r->print('<th>'.&mt('Announce').'</th>');
       }
       $r->print(&Apache::loncommon::end_data_table_header_row());
     my $shown=0;      my $shown=0;
     my $folder='';      my $folder='';
     if ($env{'form.displayfilter'} eq 'currentfolder') {      if ($env{'form.displayfilter'} eq 'currentfolder') {
Line 5466  sub parm_change_log { Line 6341  sub parm_change_log {
                             $parmlog{$id}{'exe_uname'},                              $parmlog{$id}{'exe_uname'},
                             $parmlog{$id}{'exe_udom'});                              $parmlog{$id}{'exe_udom'});
         my $send_msg_link='';          my $send_msg_link='';
         if ((($parmlog{$id}{'exe_uname'} ne $env{'user.name'})          if ((!$readonly) && 
               (($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
             || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {              || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
             $send_msg_link ='<br />'.              $send_msg_link ='<br />'.
             &Apache::loncommon::messagewrapper(&mt('Send message'),              &Apache::loncommon::messagewrapper(&mt('Send message'),
Line 5543  sub parm_change_log { Line 6419  sub parm_change_log {
                     }                      }
                 }                  }
             }              }
             $output .= '</td><td>';              $output .= '</td>';
                   
             if ($stillactive) {              unless ($readonly) { 
                 my $parmitem = &standard_parameter_names($parmname);                  $output .= '<td>';
                 $parmitem = &mt($parmitem);                  if ($stillactive) {
                 my $title=&mt('Changed [_1]',$parmitem);                      my $parmitem = &standard_parameter_names($parmname);
                 my $description=&mt('Changed [_1] for [_2] to [_3]',                      $parmitem = &mt($parmitem);
                     $parmitem,$realmdescription,                      my $title=&mt('Changed [_1]',$parmitem);
                     (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));                      my $description=&mt('Changed [_1] for [_2] to [_3]',
                 if (($uname) && ($udom)) {                          $parmitem,$realmdescription,
                     $output .=                          (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
                     &Apache::loncommon::messagewrapper('Notify User',                      if (($uname) && ($udom)) {
                                     $uname,$udom,$title,                          $output .=
                                     $description);                          &Apache::loncommon::messagewrapper('Notify User',
                 } else {                                                             $uname,$udom,$title,
                     $output .=                                                             $description);
                     &Apache::lonrss::course_blog_link($id,$title,                      } else {
                                     $description);                          $output .=
                               &Apache::lonrss::course_blog_link($id,$title,
                                                                 $description);
                       }
                 }                  }
                   $output .= '</td>';
             }              }
             $output .= '</td>'.&Apache::loncommon::end_data_table_row();              $output .= &Apache::loncommon::end_data_table_row();
         }          }
         if ($env{'form.displayfilter'} eq 'containing') {          if ($env{'form.displayfilter'} eq 'containing') {
             my $wholeentry=$about_me_link.':'.              my $wholeentry=$about_me_link.':'.
Line 5591  sub parm_change_log { Line 6471  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 5645  sub update_slots { Line 6535  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 5681  sub delete_slots { Line 6581  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 5697  sub parameter_release_vars { Line 6603  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;
Line 5716  sub parameter_releasecheck { Line 6633  sub parameter_releasecheck {
     return $needsnewer;      return $needsnewer;
 }  }
   
   sub get_permission {
       my %permission;
       my $allowed = 0;
       return (\%permission,$allowed) unless ($env{'request.course.id'});
       if ((&Apache::lonnet::allowed('opa',$env{'request.course.id'})) ||
           (&Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
                     $env{'request.course.sec'}))) {
           %permission= (
                          'edit'               => 1,
                          'set'                => 1,
                          'setoverview'        => 1,
                          'addmetadata'        => 1,
                          'ordermetadata'      => 1,
                          'setrestrictmeta'    => 1,
                          'newoverview'        => 1,
                          'setdefaults'        => 1,
                          'settable'           => 1,
                          'parameterchangelog' => 1,
                          'cleanparameters'    => 1,
                          'dateshift1'         => 1,
                          'dateshift2'         => 1,
                          'helper'             => 1,
            );
       } elsif ((&Apache::lonnet::allowed('vpa',$env{'request.course.id'})) ||
                (&Apache::lonnet::allowed('vpa',$env{'request.course.id'}.'/'.
                     $env{'request.course.sec'}))) {
           %permission = (
                          'set'                => 1,
                          'settable'           => 1,
                          'newoverview'        => 1,
                          'setoverview'        => 1,
                          'parameterchangelog' => 1,
                         );
       }
       foreach my $perm (values(%permission)) {
           if ($perm) { $allowed=1; last; }
       }
       return (\%permission,$allowed);
   }
   
 ##################################################  ##################################################
 # HANDLER  # HANDLER
 ##################################################  ##################################################
Line 5764  sub handler { Line 6721  sub handler {
                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});                                              'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
   
 # ----------------------------------------------------- Needs to be in a course  # ----------------------------------------------------- Needs to be in a course
     my $parm_permission =      my ($parm_permission,$allowed) = &get_permission();
     (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||  
      &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.  
                   $env{'request.course.sec'}));  
     my $exists = &check_for_course_info();      my $exists = &check_for_course_info();
   
     if ($env{'request.course.id'} &&  $parm_permission && $exists) {      if ($env{'request.course.id'} && $allowed && $exists) {
         #          #
         # Main switch on form.action and form.state, as appropriate          # Main switch on form.action and form.state, as appropriate
         #          #
         # Check first if coming from someone else headed directly for          # Check first if coming from someone else headed directly for
         #  the table mode          #  the table mode
         if ((($env{'form.command'} eq 'set') && ($env{'form.url'})          if (($parm_permission->{'set'}) && 
                 && (!$env{'form.dis'})) || ($env{'form.symb'})) {              ((($env{'form.command'} eq 'set') && ($env{'form.url'})
             &assessparms($r);                  && (!$env{'form.dis'})) || ($env{'form.symb'}))) {
               &assessparms($r,$parm_permission);
         } elsif (! exists($env{'form.action'})) {          } elsif (! exists($env{'form.action'})) {
             &print_main_menu($r,$parm_permission);              &print_main_menu($r,$parm_permission);
           } elsif (!$parm_permission->{$env{'form.action'}}) {
               &print_main_menu($r,$parm_permission);
         } elsif ($env{'form.action'} eq 'setoverview') {          } elsif ($env{'form.action'} eq 'setoverview') {
             &overview($r);              &overview($r,$parm_permission);
         } elsif ($env{'form.action'} eq 'addmetadata') {          } elsif ($env{'form.action'} eq 'addmetadata') {
             &addmetafield($r);              &addmetafield($r);
         } elsif ($env{'form.action'} eq 'ordermetadata') {          } elsif ($env{'form.action'} eq 'ordermetadata') {
Line 5790  sub handler { Line 6747  sub handler {
         } elsif ($env{'form.action'} eq 'setrestrictmeta') {          } elsif ($env{'form.action'} eq 'setrestrictmeta') {
             &setrestrictmeta($r);              &setrestrictmeta($r);
         } elsif ($env{'form.action'} eq 'newoverview') {          } elsif ($env{'form.action'} eq 'newoverview') {
             &newoverview($r);              &newoverview($r,$parm_permission);
         } elsif ($env{'form.action'} eq 'setdefaults') {          } elsif ($env{'form.action'} eq 'setdefaults') {
             &defaultsetter($r);              &defaultsetter($r);
         } elsif ($env{'form.action'} eq 'settable') {          } elsif ($env{'form.action'} eq 'settable') {
             &assessparms($r);              &assessparms($r,$parm_permission);
         } elsif ($env{'form.action'} eq 'parameterchangelog') {          } elsif ($env{'form.action'} eq 'parameterchangelog') {
             &parm_change_log($r);              &parm_change_log($r,$parm_permission);
         } elsif ($env{'form.action'} eq 'cleanparameters') {          } elsif ($env{'form.action'} eq 'cleanparameters') {
             &clean_parameters($r);              &clean_parameters($r);
         } elsif ($env{'form.action'} eq 'dateshift1') {          } elsif ($env{'form.action'} eq 'dateshift1') {

Removed from v.1.560  
changed lines
  Added in v.1.577


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