Annotation of loncom/interface/lonparmset.pm, revision 1.565

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.565   ! damieng     4: # $Id: lonparmset.pm,v 1.564 2016/07/26 12:55:41 raeburn Exp $
1.40      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.59      matthew    28: ###################################################################
                     29: ###################################################################
                     30: 
                     31: =pod
                     32: 
                     33: =head1 NAME
                     34: 
                     35: lonparmset - Handler to set parameters for assessments and course
                     36: 
                     37: =head1 SYNOPSIS
                     38: 
1.560     damieng    39: lonparmset provides an interface to setting course parameters.
                     40: 
                     41: It contains all the code for the "Content and Problem Settings" UI, except
                     42: for the helpers parameter.helper and resettimes.helper, and lonhelper.pm,
                     43: and lonblockingmenu.pm.
1.59      matthew    44: 
                     45: =head1 DESCRIPTION
                     46: 
                     47: This module sets coursewide and assessment parameters.
                     48: 
                     49: =head1 INTERNAL SUBROUTINES
                     50: 
1.416     jms        51: =over
1.59      matthew    52: 
1.416     jms        53: =item parmval()
1.59      matthew    54: 
                     55: Figure out a cascading parameter.
                     56: 
1.71      albertel   57: Inputs:  $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162     albertel   58:          $id   - a bighash Id number
1.71      albertel   59:          $def  - the resource's default value   'stupid emacs
                     60: 
1.556     raeburn    61: Returns:  A list, the first item is the index into the remaining list of items of parm values that is the active one, the list consists of parm values at the 18 possible levels
1.71      albertel   62: 
1.556     raeburn    63: 18 - General Course
                     64: 17 - Map or Folder level in course (recursive) 
                     65: 16 - Map or Folder level in course (non-recursive)
                     66: 15 - resource default
                     67: 14 - map default
                     68: 13 - resource level in course
                     69: 12 - General for section
                     70: 11 - Map or Folder level for section (recursive)
                     71: 10 - Map or Folder level for section (non-recursive)
                     72: 9 - resource level in section
                     73: 8 - General for group
                     74: 7 - Map or Folder level for group (recursive)
                     75: 6 - Map or Folder level for group (non-recursive)
                     76: 5 - resource level in group
                     77: 4 - General for specific student
                     78: 3 - Map or Folder level for specific student (recursive)
                     79: 2 - Map or Folder level for specific student (non-recursive)
1.71      albertel   80: 1 - resource level for specific student
1.2       www        81: 
1.416     jms        82: =item parmval_by_symb()
                     83: 
                     84: =item reset_caches()
                     85: 
                     86: =item cacheparmhash() 
                     87: 
                     88: =item parmhash()
                     89: 
                     90: =item symbcache()
                     91: 
                     92: =item preset_defaults()
                     93: 
                     94: =item date_sanity_info()
                     95: 
                     96: =item storeparm()
                     97: 
                     98: Store a parameter by symb
                     99: 
                    100:     Takes
                    101:     - symb
                    102:     - name of parameter
                    103:     - level
                    104:     - new value
                    105:     - new type
                    106:     - username
                    107:     - userdomain
                    108: 
                    109: =item log_parmset()
                    110: 
                    111: =item storeparm_by_symb_inner()
                    112: 
                    113: =item valout()
                    114: 
                    115: Format a value for output.
                    116: 
                    117: Inputs:  $value, $type, $editable
                    118: 
                    119: Returns: $value, formatted for output.  If $type indicates it is a date,
                    120: localtime($value) is returned.
                    121: $editable will return an icon to click on
                    122: 
                    123: =item plink()
                    124: 
                    125: Produces a link anchor.
                    126: 
                    127: Inputs: $type,$dis,$value,$marker,$return,$call
                    128: 
                    129: Returns: scalar with html code for a link which will envoke the 
                    130: javascript function 'pjump'.
                    131: 
                    132: =item page_js()
                    133: 
                    134: =item startpage()
                    135: 
                    136: =item print_row()
                    137: 
                    138: =item print_td()
                    139: 
                    140: =item print_usergroups()
                    141: 
                    142: =item parm_control_group()
                    143: 
                    144: =item extractResourceInformation() : 
                    145: 
1.512     foxr      146:  extractResourceInformation extracts lots of information about all of the the course's resources into a variety of hashes.
1.416     jms       147: 
1.542     raeburn   148: Input: See list below
                    149: 
                    150: =over 4
1.416     jms       151: 
1.512     foxr      152: =item * B<env{'user.name'}> : Current username
1.416     jms       153: 
1.512     foxr      154: =item * B<env{'user.domain'}> : Domain of current user.
1.416     jms       155: 
1.542     raeburn   156: =item * B<env{"request.course.fn"}> : Course
                    157: 
                    158: =back
1.416     jms       159: 
1.512     foxr      160: Outputs: See list below:
1.416     jms       161: 
1.542     raeburn   162: =over 4
                    163: 
1.512     foxr      164: =item * B<ids> (out) : An array that will contain all of the ids in the course.
1.416     jms       165: 
1.512     foxr      166: =item * B<typep>(out) : hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
1.416     jms       167: 
1.512     foxr      168: =item * B<keyp> (out) : hash, id->key list, will contain a comma separated list of the meta-data keys available for the given id
1.416     jms       169: 
1.512     foxr      170: =item * B<allparms> (out) : hash, name of parameter->display value (what is the display value?)
1.416     jms       171: 
1.512     foxr      172: =item * B<allparts> (out) : hash, part identification->text representation of part, where the text representation is "[Part $part]"
                    173: 
                    174: =item * B<allmaps> (out) : hash, ???
1.416     jms       175: 
                    176: =item * B<mapp> : ??
                    177: 
                    178: =item * B<symbp> : hash, id->full sym?
                    179: 
1.512     foxr      180: =item * B<maptitles>
                    181: 
                    182: =item * B<uris>
1.416     jms       183: 
1.512     foxr      184: =item * B<keyorder>
                    185: 
                    186: =item * B<defkeytype>
1.416     jms       187: 
1.542     raeburn   188: =back
                    189: 
1.416     jms       190: =item isdateparm()
                    191: 
                    192: =item parmmenu()
                    193: 
                    194: =item partmenu()
                    195: 
                    196: =item usermenu()
                    197: 
                    198: =item displaymenu()
                    199: 
                    200: =item mapmenu()
                    201: 
                    202: =item levelmenu()
                    203: 
                    204: =item sectionmenu()
                    205: 
                    206: =item keysplit()
                    207: 
                    208: =item keysinorder()
                    209: 
                    210: =item keysinorder_bytype()
                    211: 
                    212: =item keysindisplayorder()
                    213: 
                    214: =item standardkeyorder()
                    215: 
                    216: =item assessparms() : 
                    217: 
                    218: Show assessment data and parameters.  This is a large routine that should
                    219: be simplified and shortened... someday.
                    220: 
1.513     foxr      221: Inputs: $r - the Apache request object.
                    222:   
1.416     jms       223: Returns: nothing
                    224: 
                    225: Variables used (guessed by Jeremy):
                    226: 
1.542     raeburn   227: =over
                    228: 
1.416     jms       229: =item * B<pscat>: ParameterS CATegories? ends up a list of the types of parameters that exist, e.g., tol, weight, acc, opendate, duedate, answerdate, sig, maxtries, type.
                    230: 
                    231: =item * B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
                    232: 
                    233: =item * B<@catmarker> contains list of all possible parameters including part #s
                    234: 
                    235: =item * B<$fullkeyp> contains the full part/id # for the extraction of proper parameters
                    236: 
                    237: =item * B<$tempkeyp> contains part 0 only (no ids - ie, subparts)
                    238:         When storing information, store as part 0
                    239:         When requesting information, request from full part
                    240: 
1.542     raeburn   241: =back
                    242: 
1.416     jms       243: =item tablestart()
                    244: 
                    245: =item tableend()
                    246: 
                    247: =item extractuser()
                    248: 
                    249: =item parse_listdata_key()
                    250: 
                    251: =item listdata()
                    252: 
                    253: =item date_interval_selector()
                    254: 
                    255: =item get_date_interval_from_form()
                    256: 
                    257: =item default_selector()
                    258: 
                    259: =item string_selector()
                    260: 
                    261: =item dateshift()
                    262: 
                    263: =item newoverview()
                    264: 
                    265: =item secgroup_lister()
                    266: 
                    267: =item overview()
                    268: 
                    269: =item clean_parameters()
                    270: 
                    271: =item date_shift_one()
                    272: 
                    273: =item date_shift_two()
                    274: 
                    275: =item parse_key()
                    276: 
                    277: =item header()
                    278: 
                    279: Output html header for page
                    280: 
                    281: =item print_main_menu()
                    282: 
                    283: =item output_row()
                    284: 
                    285: Set portfolio metadata
                    286: 
                    287: =item order_meta_fields()
                    288: 
                    289: =item addmetafield()
                    290: 
                    291: =item setrestrictmeta()
                    292: 
                    293: =item get_added_meta_fieldnames()
                    294: 
                    295: =item get_deleted_meta_fieldnames()
                    296: 
                    297: =item defaultsetter()
                    298: 
                    299: =item components()
                    300: 
                    301: =item load_parameter_names()
                    302: 
                    303: =item parm_change_log()
                    304: 
                    305: =item handler() : 
                    306: 
1.450     raeburn   307: Main handler.  Calls &assessparms subroutine.
1.416     jms       308: 
                    309: =back
                    310: 
1.59      matthew   311: =cut
                    312: 
1.416     jms       313: ###################################################################
                    314: ###################################################################
                    315: 
                    316: package Apache::lonparmset;
                    317: 
                    318: use strict;
                    319: use Apache::lonnet;
                    320: use Apache::Constants qw(:common :http REDIRECT);
                    321: use Apache::lonhtmlcommon();
                    322: use Apache::loncommon;
                    323: use GDBM_File;
                    324: use Apache::lonhomework;
                    325: use Apache::lonxml;
                    326: use Apache::lonlocal;
                    327: use Apache::lonnavmaps;
                    328: use Apache::longroup;
                    329: use Apache::lonrss;
1.506     www       330: use HTML::Entities;
1.416     jms       331: use LONCAPA qw(:DEFAULT :match);
                    332: 
                    333: 
1.560     damieng   334: ##################################################
                    335: # CONTENT AND PROBLEM SETTINGS HTML PAGE HEADER/FOOTER
                    336: ##################################################
                    337: 
                    338: # Page header
1.561     damieng   339: #
                    340: # @param {Apache2::RequestRec} $r - Apache request object
                    341: # @param {string} $mode - selected tab, 'parmset' for course and problem settings, or 'coursepref' for course settings
                    342: # @param {string} $crstype - course type ('Community' for community settings)
1.507     www       343: sub startSettingsScreen {
1.531     raeburn   344:     my ($r,$mode,$crstype)=@_;
1.507     www       345: 
1.531     raeburn   346:     my $tabtext = &mt('Course Settings');
                    347:     if ($crstype eq 'Community') {
                    348:         $tabtext = &mt('Community Settings');
                    349:     } 
1.507     www       350:     $r->print("\n".'<ul class="LC_TabContentBigger" id="main">');
                    351:     $r->print("\n".'<li'.($mode eq 'coursepref'?' class="active"':'').'><a href="/adm/courseprefs"><b>&nbsp;&nbsp;&nbsp;&nbsp;'.
1.531     raeburn   352:                                           $tabtext.
1.507     www       353:                                           '&nbsp;&nbsp;&nbsp;&nbsp;</b></a></li>');
                    354: 
1.523     raeburn   355:     $r->print("\n".'<li'.($mode eq 'parmset'?' class="active"':'').' id="tabbededitor"><a href="/adm/parmset"><b>'.
1.507     www       356:                                                                  &mt('Content and Problem Settings').'</b></a></li>');
                    357:     $r->print("\n".'</ul>'."\n");
1.523     raeburn   358:     $r->print('<div class="LC_Box" style="clear:both;margin:0;" id="parameditor"><div id="maincoursedoc" style="margin:0 0;padding:0 0;"><div class="LC_ContentBox" id="mainCourseDocuments" style="display: block;">');
1.507     www       359: }
                    360: 
1.560     damieng   361: # Page footer
1.507     www       362: sub endSettingsScreen {
                    363:    my ($r)=@_;
                    364:    $r->print('</div></div></div>');
                    365: }
                    366: 
                    367: 
                    368: 
1.560     damieng   369: ##################################################
1.563     damieng   370: # (mostly) TABLE MODE
1.560     damieng   371: # (parmval is also used for the log of parameter changes)
                    372: ##################################################
                    373: 
1.561     damieng   374: # Calls parmval_by_symb, getting the symb from $id (the big hash resource id) with &symbcache.
                    375: #
                    376: # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
                    377: # @param {string} $id - big hash resource id
                    378: # @param {string} $def - the resource's default value for this parameter
                    379: # @param {string} $uname - user name
                    380: # @param {string} $udom - user domain
                    381: # @param {string} $csec - section name
                    382: # @param {string} $cgroup - group name
                    383: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
                    384: # @returns {Array}
1.2       www       385: sub parmval {
1.275     raeburn   386:     my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
                    387:     return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,
                    388:                                                            $cgroup,$courseopt);
1.201     www       389: }
                    390: 
1.561     damieng   391: # Returns an array containing
                    392: # - the most specific level that is defined for that parameter (integer)
                    393: # - an array with the level as index and the parameter value as value (when defined)
                    394: #   (level 1 is the most specific and will have precedence)
                    395: #
                    396: # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
                    397: # @param {string} $symb - resource symb
                    398: # @param {string} $def - the resource's default value for this parameter
                    399: # @param {string} $uname - user name
                    400: # @param {string} $udom - user domain
                    401: # @param {string} $csec - section name
                    402: # @param {string} $cgroup - group name
                    403: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
                    404: # @returns {Array}
1.201     www       405: sub parmval_by_symb {
1.275     raeburn   406:     my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
1.200     www       407: 
1.352     albertel  408:     my $useropt;
                    409:     if ($uname ne '' && $udom ne '') {
1.561     damieng   410:         $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
1.352     albertel  411:     }
1.200     www       412: 
1.8       www       413:     my $result='';
1.44      albertel  414:     my @outpar=();
1.2       www       415: # ----------------------------------------------------- Cascading lookup scheme
1.446     bisitz    416:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  417:     $map = &Apache::lonnet::deversion($map);
1.561     damieng   418:     
                    419:     # NOTE: some of that code looks redondant with code in lonnavmaps::parmval_real,
                    420:     # any change should be reflected there.
                    421:     
1.201     www       422:     my $symbparm=$symb.'.'.$what;
1.556     raeburn   423:     my $recurseparm=$map.'___(rec).'.$what; 
1.201     www       424:     my $mapparm=$map.'___(all).'.$what;
1.10      www       425: 
1.269     raeburn   426:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$what;
                    427:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
1.556     raeburn   428:     my $grpleveli=$env{'request.course.id'}.'.['.$cgroup.'].'.$recurseparm;
1.269     raeburn   429:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    430: 
1.190     albertel  431:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
                    432:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
1.556     raeburn   433:     my $secleveli=$env{'request.course.id'}.'.['.$csec.'].'.$recurseparm;
1.190     albertel  434:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                    435: 
                    436:     my $courselevel=$env{'request.course.id'}.'.'.$what;
                    437:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
1.556     raeburn   438:     my $courseleveli=$env{'request.course.id'}.'.'.$recurseparm;
1.190     albertel  439:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.2       www       440: 
1.11      www       441: 
1.182     albertel  442: # --------------------------------------------------------- first, check course
1.11      www       443: 
1.561     damieng   444: # 18 - General Course
1.200     www       445:     if (defined($$courseopt{$courselevel})) {
1.556     raeburn   446:         $outpar[18]=$$courseopt{$courselevel};
                    447:         $result=18;
                    448:     }
                    449: 
1.561     damieng   450: # 17 - Map or Folder level in course (recursive) 
1.556     raeburn   451:     if (defined($$courseopt{$courseleveli})) {
                    452:         $outpar[17]=$$courseopt{$courseleveli};
                    453:         $result=17;
1.43      albertel  454:     }
1.11      www       455: 
1.561     damieng   456: # 16 - Map or Folder level in course (non-recursive)
1.200     www       457:     if (defined($$courseopt{$courselevelm})) {
1.556     raeburn   458:         $outpar[16]=$$courseopt{$courselevelm};
                    459:         $result=16;
1.43      albertel  460:     }
1.11      www       461: 
1.182     albertel  462: # ------------------------------------------------------- second, check default
                    463: 
1.561     damieng   464: # 15 - resource default
1.556     raeburn   465:     if (defined($def)) { $outpar[15]=$def; $result=15; }
1.182     albertel  466: 
                    467: # ------------------------------------------------------ third, check map parms
                    468: 
1.556     raeburn   469:     
1.561     damieng   470: # 14 - map default
1.376     albertel  471:     my $thisparm=&parmhash($symbparm);
1.556     raeburn   472:     if (defined($thisparm)) { $outpar[14]=$thisparm; $result=14; }
1.182     albertel  473: 
1.561     damieng   474: # 13 - resource level in course
1.200     www       475:     if (defined($$courseopt{$courselevelr})) {
1.556     raeburn   476:         $outpar[13]=$$courseopt{$courselevelr};
                    477:         $result=13;
1.43      albertel  478:     }
1.11      www       479: 
1.182     albertel  480: # ------------------------------------------------------ fourth, back to course
1.352     albertel  481:     if ($csec ne '') {
1.561     damieng   482: # 12 - General for section
1.200     www       483:         if (defined($$courseopt{$seclevel})) {
1.556     raeburn   484:             $outpar[12]=$$courseopt{$seclevel};
                    485:             $result=12;
                    486:         }
1.561     damieng   487: # 11 - Map or Folder level for section (recursive)
1.556     raeburn   488:         if (defined($$courseopt{$secleveli})) {
                    489:             $outpar[11]=$$courseopt{$secleveli};
                    490:             $result=11;
                    491:         }
1.561     damieng   492: # 10 - Map or Folder level for section (non-recursive)
1.200     www       493:         if (defined($$courseopt{$seclevelm})) {
1.556     raeburn   494:             $outpar[10]=$$courseopt{$seclevelm};
                    495:             $result=10;
                    496:         }
1.561     damieng   497: # 9 - resource level in section
1.200     www       498:         if (defined($$courseopt{$seclevelr})) {
1.556     raeburn   499:             $outpar[9]=$$courseopt{$seclevelr};
                    500:             $result=9;
                    501:         }
1.43      albertel  502:     }
1.275     raeburn   503: # ------------------------------------------------------ fifth, check course group
1.352     albertel  504:     if ($cgroup ne '') {
1.561     damieng   505: # 8 - General for group
1.269     raeburn   506:         if (defined($$courseopt{$grplevel})) {
1.556     raeburn   507:             $outpar[8]=$$courseopt{$grplevel};
                    508:             $result=8;
                    509:         }
1.561     damieng   510: # 7 - Map or Folder level for group (recursive)
1.556     raeburn   511:         if (defined($$courseopt{$grpleveli})) {
                    512:             $outpar[7]=$$courseopt{$grpleveli};
                    513:             $result=7;
1.269     raeburn   514:         }
1.561     damieng   515: # 6 - Map or Folder level for group (non-recursive)
1.269     raeburn   516:         if (defined($$courseopt{$grplevelm})) {
1.556     raeburn   517:             $outpar[6]=$$courseopt{$grplevelm};
                    518:             $result=6;
1.269     raeburn   519:         }
1.561     damieng   520: # 5 - resource level in group
1.269     raeburn   521:         if (defined($$courseopt{$grplevelr})) {
1.556     raeburn   522:             $outpar[5]=$$courseopt{$grplevelr};
                    523:             $result=5;
1.269     raeburn   524:         }
                    525:     }
1.11      www       526: 
1.556     raeburn   527: # ---------------------------------------------------------- sixth, check user
1.11      www       528: 
1.352     albertel  529:     if ($uname ne '') {
1.561     damieng   530: # 4 - General for specific student
                    531:         if (defined($$useropt{$courselevel})) {
                    532:             $outpar[4]=$$useropt{$courselevel};
                    533:             $result=4;
                    534:         }
1.556     raeburn   535: 
1.561     damieng   536: # 3 - Map or Folder level for specific student (recursive)
                    537:         if (defined($$useropt{$courseleveli})) {
                    538:             $outpar[3]=$$useropt{$courseleveli};
                    539:             $result=3;
                    540:         }
1.473     amueller  541: 
1.561     damieng   542: # 2 - Map or Folder level for specific student (non-recursive)
                    543:         if (defined($$useropt{$courselevelm})) {
                    544:             $outpar[2]=$$useropt{$courselevelm};
                    545:             $result=2;
                    546:         }
1.473     amueller  547: 
1.561     damieng   548: # 1 - resource level for specific student
                    549:         if (defined($$useropt{$courselevelr})) {
                    550:             $outpar[1]=$$useropt{$courselevelr};
                    551:             $result=1;
                    552:         }
1.43      albertel  553:     }
1.44      albertel  554:     return ($result,@outpar);
1.2       www       555: }
                    556: 
1.198     www       557: 
                    558: 
1.376     albertel  559: # --- Caches local to lonparmset
                    560: 
1.446     bisitz    561: 
1.561     damieng   562: # Reset lonparmset caches (called at the beginning and end of the handler).
1.376     albertel  563: sub reset_caches {
                    564:     &resetparmhash();
                    565:     &resetsymbcache();
                    566:     &resetrulescache();
1.203     www       567: }
                    568: 
1.561     damieng   569: # cache for map parameters, stored temporarily in $env{'request.course.fn'}_parms.db
                    570: # (these parameters come from param elements in .sequence files created with the advanced RAT)
1.376     albertel  571: {
1.561     damieng   572:     my $parmhashid; # course identifier, to initialize the cache only once for a course
                    573:     my %parmhash; # the parameter cache
                    574:     # reset map parameter hash
1.376     albertel  575:     sub resetparmhash {
1.560     damieng   576:         undef($parmhashid);
                    577:         undef(%parmhash);
1.376     albertel  578:     }
1.446     bisitz    579: 
1.561     damieng   580:     # dump the _parms.db database into %parmhash
1.376     albertel  581:     sub cacheparmhash {
1.560     damieng   582:         if ($parmhashid eq  $env{'request.course.fn'}) { return; }
                    583:         my %parmhashfile;
                    584:         if (tie(%parmhashfile,'GDBM_File',
                    585:             $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
                    586:             %parmhash=%parmhashfile;
                    587:             untie(%parmhashfile);
                    588:             $parmhashid=$env{'request.course.fn'};
                    589:         }
1.201     www       590:     }
1.446     bisitz    591: 
1.561     damieng   592:     # returns a parameter value for an identifier symb.parts.parameter, using the map parameter cache
1.376     albertel  593:     sub parmhash {
1.560     damieng   594:         my ($id) = @_;
                    595:         &cacheparmhash();
                    596:         return $parmhash{$id};
1.376     albertel  597:     }
1.560     damieng   598: }
1.376     albertel  599: 
1.561     damieng   600: # cache big hash id -> symb, using lonnavmaps to find association
1.446     bisitz    601: {
1.561     damieng   602:     my $symbsid; # course identifier, to initialize the cache only once for a course
                    603:     my %symbs; # hash id->symb
                    604:     # reset the id->symb cache
1.376     albertel  605:     sub resetsymbcache {
1.560     damieng   606:         undef($symbsid);
                    607:         undef(%symbs);
1.376     albertel  608:     }
1.446     bisitz    609: 
1.561     damieng   610:     # returns the symb corresponding to a big hash id (using lonnavmaps and a cache)
1.376     albertel  611:     sub symbcache {
1.560     damieng   612:         my $id=shift;
                    613:         if ($symbsid ne $env{'request.course.id'}) {
                    614:             undef(%symbs);
                    615:         }
                    616:         if (!$symbs{$id}) {
                    617:             my $navmap = Apache::lonnavmaps::navmap->new();
                    618:             if ($id=~/\./) {
                    619:                 my $resource=$navmap->getById($id);
                    620:                 $symbs{$id}=$resource->symb();
                    621:             } else {
                    622:                 my $resource=$navmap->getByMapPc($id);
                    623:                 $symbs{$id}=&Apache::lonnet::declutter($resource->src());
                    624:             }
                    625:             $symbsid=$env{'request.course.id'};
1.473     amueller  626:         }
1.560     damieng   627:         return $symbs{$id};
1.473     amueller  628:     }
1.560     damieng   629: }
1.201     www       630: 
1.561     damieng   631: # cache for parameter default actions (stored in parmdefactions.db)
1.446     bisitz    632: {
1.561     damieng   633:     my $rulesid; # course identifier, to initialize the cache only once for a course
                    634:     my %rules; # parameter default actions hash
1.376     albertel  635:     sub resetrulescache {
1.560     damieng   636:         undef($rulesid);
                    637:         undef(%rules);
1.376     albertel  638:     }
1.446     bisitz    639: 
1.561     damieng   640:     # returns the value for a given key in the parameter default action hash
1.376     albertel  641:     sub rulescache {
1.560     damieng   642:         my $id=shift;
                    643:         if ($rulesid ne $env{'request.course.id'}
                    644:             && !defined($rules{$id})) {
                    645:             my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    646:             my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                    647:             %rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
                    648:             $rulesid=$env{'request.course.id'};
                    649:         }
                    650:         return $rules{$id};
1.221     www       651:     }
                    652: }
                    653: 
1.416     jms       654: 
1.561     damieng   655: # Returns the values of the parameter type default action
                    656: # "default value when manually setting".
                    657: # If none is defined, ('','','','','') is returned.
                    658: #
                    659: # @param {string} $type - parameter type
                    660: # @returns {Array<string>} - (hours, min, sec, value)
1.229     www       661: sub preset_defaults {
                    662:     my $type=shift;
                    663:     if (&rulescache($type.'_action') eq 'default') {
1.560     damieng   664:         # yes, there is something
                    665:         return (&rulescache($type.'_hours'),
                    666:             &rulescache($type.'_min'),
                    667:             &rulescache($type.'_sec'),
                    668:             &rulescache($type.'_value'));
1.229     www       669:     } else {
1.560     damieng   670:         # nothing there or something else
                    671:         return ('','','','','');
1.229     www       672:     }
                    673: }
                    674: 
1.416     jms       675: 
1.561     damieng   676: # Checks that a date is after enrollment start date and before
                    677: # enrollment end date.
                    678: # Returns HTML with a warning if it is not, or the empty string otherwise.
                    679: # This is used by both overview and table modes.
                    680: #
                    681: # @param {integer} $checkdate - the date to check.
                    682: # @returns {string} - HTML possibly containing a localized warning message.
1.277     www       683: sub date_sanity_info {
                    684:    my $checkdate=shift;
                    685:    unless ($checkdate) { return ''; }
                    686:    my $result='';
                    687:    my $crsprefix='course.'.$env{'request.course.id'}.'.';
                    688:    if ($env{$crsprefix.'default_enrollment_end_date'}) {
                    689:       if ($checkdate>$env{$crsprefix.'default_enrollment_end_date'}) {
1.413     bisitz    690:          $result.='<div class="LC_warning">'
                    691:                  .&mt('After course enrollment end!')
                    692:                  .'</div>';
1.277     www       693:       }
                    694:    }
                    695:    if ($env{$crsprefix.'default_enrollment_start_date'}) {
                    696:       if ($checkdate<$env{$crsprefix.'default_enrollment_start_date'}) {
1.413     bisitz    697:          $result.='<div class="LC_warning">'
                    698:                  .&mt('Before course enrollment start!')
                    699:                  .'</div>';
1.277     www       700:       }
                    701:    }
1.413     bisitz    702: # Preparation for additional warnings about dates in the past/future.
                    703: # An improved, more context sensitive version is recommended,
                    704: # e.g. warn for due and answer dates which are defined before the corresponding open date, etc.
                    705: #   if ($checkdate<time) {
                    706: #      $result.='<div class="LC_info">'
                    707: #              .'('.&mt('in the past').')'
                    708: #              .'</div>';
                    709: #      }
                    710: #   if ($checkdate>time) {
                    711: #      $result.='<div class="LC_info">'
                    712: #              .'('.&mt('in the future').')'
                    713: #              .'</div>';
                    714: #      }
1.277     www       715:    return $result;
                    716: }
1.561     damieng   717: 
                    718: 
                    719: # Store a parameter value and type by ID, also triggering more parameter changes based on parameter default actions.
1.186     www       720: #
1.561     damieng   721: # @param {string} $sresid - resource big hash id
1.565   ! damieng   722: # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
1.561     damieng   723: # @param {integer} $snum - level
                    724: # @param {string} $nval - new value
                    725: # @param {string} $ntype - new type
                    726: # @param {string} $uname - username
                    727: # @param {string} $udom - userdomain
                    728: # @param {string} $csec - section name
                    729: # @param {string} $cgroup - group name
1.186     www       730: sub storeparm {
1.269     raeburn   731:     my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.275     raeburn   732:     &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);
1.197     www       733: }
                    734: 
1.561     damieng   735: my %recstack; # hash parameter name -> 1 when a parameter was used before in a recursive call to storeparm_by_symb
                    736: 
                    737: # Store a parameter value and type by symb, also triggering more parameter changes based on parameter default actions.
                    738: # Uses storeparm_by_symb_inner to actually store the parameter, ignoring any returned error.
                    739: #
                    740: # @param {string} $symb - resource symb
1.565   ! damieng   741: # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
1.561     damieng   742: # @param {integer} $snum - level
                    743: # @param {string} $nval - new value
                    744: # @param {string} $ntype - new type
                    745: # @param {string} $uname - username
                    746: # @param {string} $udom - userdomain
                    747: # @param {string} $csec - section name
                    748: # @param {boolean} $recflag - should be true for recursive calls to storeparm_by_symb, false otherwise
                    749: # @param {string} $cgroup - group name
1.197     www       750: sub storeparm_by_symb {
1.275     raeburn   751:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
1.226     www       752:     unless ($recflag) {
1.560     damieng   753:         # first time call
                    754:         %recstack=();
                    755:         $recflag=1;
1.226     www       756:     }
1.560     damieng   757:     # store parameter
1.226     www       758:     &storeparm_by_symb_inner
1.473     amueller  759:     ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
1.560     damieng   760:     # don't do anything if parameter was reset
1.266     www       761:     unless ($nval) { return; }
1.226     www       762:     my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/);
1.560     damieng   763:     # remember that this was set
1.226     www       764:     $recstack{$parm}=1;
1.560     damieng   765:     # what does this trigger?
1.226     www       766:     foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) {
1.560     damieng   767:         # don't backfire
                    768:         unless ((!$triggered) || ($recstack{$triggered})) {
                    769:             my $action=&rulescache($triggered.'_action');
                    770:             my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                    771:             # set triggered parameter on same level
                    772:             my $newspnam=$prefix.$triggered;
                    773:             my $newvalue='';
                    774:             my $active=1;
                    775:             if ($action=~/^when\_setting/) {
                    776:             # are there restrictions?
                    777:                 if (&rulescache($triggered.'_triggervalue')=~/\w/) {
                    778:                     $active=0;
1.565   ! damieng   779:                     foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
1.560     damieng   780:                         if (lc($possiblevalue) eq lc($nval)) { $active=1; }
                    781:                     }
                    782:                 }
                    783:                 $newvalue=&rulescache($triggered.'_value');
                    784:             } else {
                    785:                 my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
                    786:                 if ($action=~/^later\_than/) {
                    787:                     $newvalue=$nval+$totalsecs;
                    788:                 } else {
                    789:                     $newvalue=$nval-$totalsecs;
                    790:                 }
                    791:             }
                    792:             if ($active) {
                    793:                 &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
                    794:                         $uname,$udom,$csec,$recflag,$cgroup);
                    795:             }
                    796:         }
1.226     www       797:     }
                    798:     return '';
                    799: }
                    800: 
1.561     damieng   801: # Adds all given arguments to the course parameter log.
                    802: # @returns {string} - the answer to the lonnet query.
1.293     www       803: sub log_parmset {
1.525     raeburn   804:     return &Apache::lonnet::write_log('course','parameterlog',@_);
1.284     www       805: }
                    806: 
1.561     damieng   807: # Store a parameter value and type by symb, without using the parameter default actions.
                    808: # Expire related sheets.
                    809: #
                    810: # @param {string} $symb - resource symb
                    811: # @param {string} $spnam - part info and parameter name separated by a dot, e.g. '0.weight'
                    812: # @param {integer} $snum - level
                    813: # @param {string} $nval - new value
                    814: # @param {string} $ntype - new type
                    815: # @param {string} $uname - username
                    816: # @param {string} $udom - userdomain
                    817: # @param {string} $csec - section name
                    818: # @param {string} $cgroup - group name
                    819: # @returns {string} - HTML code with an error message if the parameter could not be stored.
1.226     www       820: sub storeparm_by_symb_inner {
1.197     www       821: # ---------------------------------------------------------- Get symb, map, etc
1.269     raeburn   822:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.197     www       823: # ---------------------------------------------------------- Construct prefixes
1.186     www       824:     $spnam=~s/\_([^\_]+)$/\.$1/;
1.446     bisitz    825:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  826:     $map = &Apache::lonnet::deversion($map);
                    827: 
1.197     www       828:     my $symbparm=$symb.'.'.$spnam;
1.556     raeburn   829:     my $recurseparm=$map.'___(rec).'.$spnam;
1.197     www       830:     my $mapparm=$map.'___(all).'.$spnam;
                    831: 
1.269     raeburn   832:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$spnam;
                    833:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
1.556     raeburn   834:     my $grpleveli=$env{'request.course.id'}.'.['.$cgroup.'].'.$recurseparm;
1.269     raeburn   835:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    836: 
1.190     albertel  837:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
                    838:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
1.556     raeburn   839:     my $secleveli=$env{'request.course.id'}.'.['.$csec.'].'.$recurseparm;
1.190     albertel  840:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
1.446     bisitz    841: 
1.190     albertel  842:     my $courselevel=$env{'request.course.id'}.'.'.$spnam;
                    843:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
1.556     raeburn   844:     my $courseleveli=$env{'request.course.id'}.'.'.$recurseparm;
1.190     albertel  845:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.446     bisitz    846: 
1.186     www       847:     my $storeunder='';
1.556     raeburn   848:     if (($snum==18) || ($snum==4)) { $storeunder=$courselevel; }
                    849:     if (($snum==17) || ($snum==3)) { $storeunder=$courseleveli; } 
                    850:     if (($snum==16) || ($snum==2)) { $storeunder=$courselevelm; }
                    851:     if (($snum==13) || ($snum==1)) { $storeunder=$courselevelr; }
                    852:     if ($snum==12) { $storeunder=$seclevel; }
                    853:     if ($snum==11) { $storeunder=$secleveli; }
                    854:     if ($snum==10) { $storeunder=$seclevelm; }
                    855:     if ($snum==9) { $storeunder=$seclevelr; }
                    856:     if ($snum==8) { $storeunder=$grplevel; }
                    857:     if ($snum==7) { $storeunder=$grpleveli; }
                    858:     if ($snum==6) { $storeunder=$grplevelm; }
                    859:     if ($snum==5) { $storeunder=$grplevelr; }
1.269     raeburn   860: 
1.446     bisitz    861: 
1.186     www       862:     my $delete;
                    863:     if ($nval eq '') { $delete=1;}
                    864:     my %storecontent = ($storeunder         => $nval,
1.473     amueller  865:             $storeunder.'.type' => $ntype);
1.186     www       866:     my $reply='';
1.560     damieng   867:     
1.556     raeburn   868:     if ($snum>4) {
1.186     www       869: # ---------------------------------------------------------------- Store Course
                    870: #
1.560     damieng   871:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    872:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    873:         # Expire sheets
                    874:         &Apache::lonnet::expirespread('','','studentcalc');
                    875:         if (($snum==13) || ($snum==9) || ($snum==5)) {
                    876:             &Apache::lonnet::expirespread('','','assesscalc',$symb);
                    877:         } elsif (($snum==14) || ($snum==10) || ($snum==6)) {
                    878:             &Apache::lonnet::expirespread('','','assesscalc',$map);
                    879:         } else {
                    880:             &Apache::lonnet::expirespread('','','assesscalc');
                    881:         }
                    882:         # Store parameter
                    883:         if ($delete) {
                    884:             $reply=&Apache::lonnet::del
                    885:             ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
                    886:                 &log_parmset(\%storecontent,1);
                    887:         } else {
                    888:             $reply=&Apache::lonnet::cput
                    889:             ('resourcedata',\%storecontent,$cdom,$cnum);
                    890:             &log_parmset(\%storecontent);
                    891:         }
                    892:         &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
1.186     www       893:     } else {
                    894: # ------------------------------------------------------------------ Store User
                    895: #
1.560     damieng   896:         # Expire sheets
                    897:         &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
                    898:         if ($snum==1) {
                    899:             &Apache::lonnet::expirespread
                    900:             ($uname,$udom,'assesscalc',$symb);
                    901:         } elsif ($snum==2) {
                    902:             &Apache::lonnet::expirespread
                    903:             ($uname,$udom,'assesscalc',$map);
                    904:         } else {
                    905:             &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
                    906:         }
                    907:         # Store parameter
                    908:         if ($delete) {
                    909:             $reply=&Apache::lonnet::del
                    910:             ('resourcedata',[keys(%storecontent)],$udom,$uname);
                    911:             &log_parmset(\%storecontent,1,$uname,$udom);
                    912:         } else {
                    913:             $reply=&Apache::lonnet::cput
                    914:             ('resourcedata',\%storecontent,$udom,$uname);
                    915:             &log_parmset(\%storecontent,0,$uname,$udom);
                    916:         }
                    917:         &Apache::lonnet::devalidateuserresdata($uname,$udom);
1.186     www       918:     }
1.446     bisitz    919: 
1.186     www       920:     if ($reply=~/^error\:(.*)/) {
1.560     damieng   921:         return "<span class=\"LC_error\">Write Error: $1</span>";
1.186     www       922:     }
                    923:     return '';
                    924: }
                    925: 
1.9       www       926: 
1.561     damieng   927: # Returns HTML with the value of the given parameter,
                    928: # using a readable format for dates, and
                    929: # a warning if there is a problem with a date.
                    930: # Used by table mode.
                    931: # Returns HTML for the editmap.png image if no value is defined and $editable is true.
                    932: #
                    933: # @param {string} $value - the parameter value
                    934: # @param {string} $type - the parameter type
                    935: # @param {string} $name - the parameter name (unused)
                    936: # @param {boolean} $editable - Set to true to get an icon when no value is defined.
1.9       www       937: sub valout {
1.554     raeburn   938:     my ($value,$type,$name,$editable)=@_;
1.59      matthew   939:     my $result = '';
                    940:     # Values of zero are valid.
                    941:     if (! $value && $value ne '0') {
1.528     bisitz    942:         if ($editable) {
                    943:             $result =
                    944:                 '<img src="/res/adm/pages/editmap.png"'
                    945:                .' alt="'.&mt('Change').'"'
1.539     raeburn   946:                .' title="'.&mt('Change').'" style="border:0;" />';
1.528     bisitz    947:         } else {
                    948:             $result='&nbsp;';
                    949:         }
1.59      matthew   950:     } else {
1.66      www       951:         if ($type eq 'date_interval') {
1.559     raeburn   952:             my ($totalsecs,$donesuffix) = split(/_/,$value,2);
                    953:             my ($usesdone,$donebuttontext,$proctor,$secretkey);
                    954:             if ($donesuffix =~ /^done\:([^\:]+)\:(.*)$/) {
                    955:                 $donebuttontext = $1;
                    956:                 (undef,$proctor,$secretkey) = split(/_/,$2);
                    957:                 $usesdone = 'done';
                    958:             } elsif ($donesuffix =~ /^done(|_.+)$/) {
                    959:                 $donebuttontext = &mt('Done');
                    960:                 ($usesdone,$proctor,$secretkey) = split(/_/,$donesuffix);
                    961:             }
1.554     raeburn   962:             my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($totalsecs);
1.413     bisitz    963:             my @timer;
1.66      www       964:             $year=$year-70;
                    965:             $mday--;
                    966:             if ($year) {
1.413     bisitz    967: #               $result.=&mt('[quant,_1,yr]',$year).' ';
                    968:                 push(@timer,&mt('[quant,_1,yr]',$year));
1.66      www       969:             }
                    970:             if ($mon) {
1.413     bisitz    971: #               $result.=&mt('[quant,_1,mth]',$mon).' ';
                    972:                 push(@timer,&mt('[quant,_1,mth]',$mon));
1.66      www       973:             }
                    974:             if ($mday) {
1.413     bisitz    975: #               $result.=&mt('[quant,_1,day]',$mday).' ';
                    976:                 push(@timer,&mt('[quant,_1,day]',$mday));
1.66      www       977:             }
                    978:             if ($hour) {
1.413     bisitz    979: #               $result.=&mt('[quant,_1,hr]',$hour).' ';
                    980:                 push(@timer,&mt('[quant,_1,hr]',$hour));
1.66      www       981:             }
                    982:             if ($min) {
1.413     bisitz    983: #               $result.=&mt('[quant,_1,min]',$min).' ';
                    984:                 push(@timer,&mt('[quant,_1,min]',$min));
1.66      www       985:             }
                    986:             if ($sec) {
1.413     bisitz    987: #               $result.=&mt('[quant,_1,sec]',$sec).' ';
                    988:                 push(@timer,&mt('[quant,_1,sec]',$sec));
1.66      www       989:             }
1.413     bisitz    990: #           $result=~s/\s+$//;
                    991:             if (!@timer) { # Special case: all entries 0 -> display "0 secs" intead of empty field to keep this field editable
                    992:                 push(@timer,&mt('[quant,_1,sec]',0));
                    993:             }
                    994:             $result.=join(", ",@timer);
1.559     raeburn   995:             if ($usesdone eq 'done') {
1.558     raeburn   996:                 if ($secretkey) {
1.559     raeburn   997:                     $result .= ' '.&mt('+ "[_1]" with proctor key: [_2]',$donebuttontext,$secretkey);  
1.558     raeburn   998:                 } else {
1.559     raeburn   999:                     $result .= ' + "'.$donebuttontext.'"';
                   1000:                 }
1.554     raeburn  1001:             }
1.213     www      1002:         } elsif (&isdateparm($type)) {
1.361     albertel 1003:             $result = &Apache::lonlocal::locallocaltime($value).
1.560     damieng  1004:                 &date_sanity_info($value);
1.59      matthew  1005:         } else {
                   1006:             $result = $value;
1.517     www      1007:             $result=~s/\,/\, /gs;
1.560     damieng  1008:             $result = &HTML::Entities::encode($result,'"<>&');
1.59      matthew  1009:         }
                   1010:     }
                   1011:     return $result;
1.9       www      1012: }
                   1013: 
1.59      matthew  1014: 
1.561     damieng  1015: # Returns HTML containing a link on a parameter value, for table mode.
                   1016: # The link uses the javascript function 'pjump'.
                   1017: #
                   1018: # @param {string} $type - parameter type
                   1019: # @param {string} $dis - dialog title for editing the parameter value and type
                   1020: # @param {string} $value - parameter value
                   1021: # @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.
                   1022: # @param {string} $return - prefix for the name of the form and field names that will be used to submit the form ('parmform.pres')
                   1023: # @param {string} $call - javascript function to call to submit the form ('psub')
1.5       www      1024: sub plink {
                   1025:     my ($type,$dis,$value,$marker,$return,$call)=@_;
1.23      www      1026:     my $winvalue=$value;
                   1027:     unless ($winvalue) {
1.560     damieng  1028:         if (&isdateparm($type)) {
1.190     albertel 1029:             $winvalue=$env{'form.recent_'.$type};
1.23      www      1030:         } else {
1.190     albertel 1031:             $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23      www      1032:         }
                   1033:     }
1.229     www      1034:     my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
                   1035:     my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
                   1036:     unless (defined($winvalue)) { $winvalue=$val; }
1.554     raeburn  1037:     my $valout = &valout($value,$type,$parmname,1);
1.429     raeburn  1038:     my $unencmarker = $marker;
1.378     albertel 1039:     foreach my $item (\$type, \$dis, \$winvalue, \$marker, \$return, \$call,
1.473     amueller 1040:               \$hour, \$min, \$sec) {
1.560     damieng  1041:         $$item = &HTML::Entities::encode($$item,'"<>&');
                   1042:         $$item =~ s/\'/\\\'/g;
1.378     albertel 1043:     }
1.429     raeburn  1044:     return '<table width="100%"><tr valign="top" align="right"><td><a name="'.$unencmarker.'" /></td></tr><tr><td align="center">'.
1.473     amueller 1045:     '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
                   1046:         .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."'".');">'.
                   1047:         $valout.'</a></td></tr></table>';
1.5       www      1048: }
                   1049: 
1.561     damieng  1050: # Javascript for table mode.
1.280     albertel 1051: sub page_js {
                   1052: 
1.81      www      1053:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88      matthew  1054:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.280     albertel 1055: 
                   1056:     return(<<ENDJS);
                   1057: <script type="text/javascript">
1.454     bisitz   1058: // <![CDATA[
1.44      albertel 1059: 
1.88      matthew  1060:     $pjump_def
1.44      albertel 1061: 
                   1062:     function psub() {
                   1063:         if (document.parmform.pres_marker.value!='') {
                   1064:             document.parmform.action+='#'+document.parmform.pres_marker.value;
                   1065:             var typedef=new Array();
                   1066:             typedef=document.parmform.pres_type.value.split('_');
1.562     damieng  1067:             if (document.parmform.pres_type.value!='') {
                   1068:                 if (typedef[0]=='date') {
                   1069:                     eval('document.parmform.recent_'+
                   1070:                         document.parmform.pres_type.value+
                   1071:                         '.value=document.parmform.pres_value.value;');
                   1072:                 } else {
                   1073:                     eval('document.parmform.recent_'+typedef[0]+
                   1074:                         '.value=document.parmform.pres_value.value;');
                   1075:                 }
1.44      albertel 1076:             }
                   1077:             document.parmform.submit();
                   1078:         } else {
                   1079:             document.parmform.pres_value.value='';
                   1080:             document.parmform.pres_marker.value='';
                   1081:         }
                   1082:     }
                   1083: 
1.57      albertel 1084:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   1085:         var options = "width=" + w + ",height=" + h + ",";
                   1086:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   1087:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   1088:         var newWin = window.open(url, wdwName, options);
                   1089:         newWin.focus();
                   1090:     }
1.523     raeburn  1091: 
1.454     bisitz   1092: // ]]>
1.523     raeburn  1093: 
1.44      albertel 1094: </script>
1.81      www      1095: $selscript
1.280     albertel 1096: ENDJS
                   1097: 
                   1098: }
1.507     www      1099: 
1.561     damieng  1100: # Javascript to show or hide the map selection (function showHide_courseContent),
                   1101: # for table and overview modes.
1.523     raeburn  1102: sub showhide_js {
                   1103:     return <<"COURSECONTENTSCRIPT";
                   1104: 
                   1105: function showHide_courseContent() {
                   1106:     var parmlevValue=document.getElementById("parmlev").value;
                   1107:     if (parmlevValue == 'general') {
                   1108:         document.getElementById('mapmenu').style.display="none";
                   1109:     } else {
                   1110:         if ((parmlevValue == "full") || (parmlevValue == "map")) {
                   1111:             document.getElementById('mapmenu').style.display ="";
                   1112:         } else {
                   1113:             document.getElementById('mapmenu').style.display="none";
                   1114:         }
                   1115:     }
                   1116:     return;
                   1117: }
                   1118: 
                   1119: COURSECONTENTSCRIPT
                   1120: }
                   1121: 
1.561     damieng  1122: # Javascript functions showHideLenient and toggleParmTextbox, for overview mode
1.549     raeburn  1123: sub toggleparmtextbox_js {
                   1124:     return <<"ENDSCRIPT";
                   1125: 
                   1126: if (!document.getElementsByClassName) {
                   1127:     function getElementsByClassName(node, classname) {
                   1128:         var a = [];
                   1129:         var re = new RegExp('(^| )'+classname+'( |$)');
                   1130:         var els = node.getElementsByTagName("*");
                   1131:         for(var i=0,j=els.length; i<j; i++)
                   1132:             if(re.test(els[i].className))a.push(els[i]);
                   1133:         return a;
                   1134:     }
                   1135: }
                   1136: 
                   1137: function showHideLenient() {
                   1138:     var lenients;
                   1139:     var setRegExp = /^set_/;
                   1140:     if (document.getElementsByClassName) {
                   1141:         lenients = document.getElementsByClassName('LC_lenient_radio');
                   1142:     } else {
                   1143:         lenients = getElementsByClassName(document.body,'LC_lenient_radio');
                   1144:     }
                   1145:     if (lenients != 'undefined') {
                   1146:         for (var i=0; i<lenients.length; i++) {
                   1147:             if (lenients[i].checked) {
                   1148:                 if (lenients[i].value == 'weighted') {
                   1149:                     if (setRegExp.test(lenients[i].name)) {
                   1150:                         var identifier = lenients[i].name.replace(setRegExp,'');
                   1151:                         toggleParmTextbox(document.parmform,identifier);
                   1152:                     }
                   1153:                 }
                   1154:             }
                   1155:         }
                   1156:     }
                   1157:     return;
                   1158: }
                   1159: 
                   1160: function toggleParmTextbox(form,key) {
                   1161:     var divfortext = document.getElementById('LC_parmtext_'+key);
                   1162:     if (divfortext) {
                   1163:         var caller = form.elements['set_'+key];
                   1164:         if (caller.length) {
                   1165:             for (i=0; i<caller.length; i++) {
                   1166:                 if (caller[i].checked) {
                   1167:                     if (caller[i].value == 'weighted') {
                   1168:                         divfortext.style.display = 'inline';
                   1169:                     } else {
                   1170:                         divfortext.style.display = 'none';
                   1171:                     }
                   1172:                 }
                   1173:             }
                   1174:         }
                   1175:     }
                   1176:     return;
                   1177: }
                   1178: 
                   1179: ENDSCRIPT
                   1180: }
                   1181: 
1.561     damieng  1182: # Javascript function validateParms, for overview mode
1.549     raeburn  1183: sub validateparms_js {
                   1184:     return <<'ENDSCRIPT';
                   1185: 
                   1186: function validateParms() {
                   1187:     var textRegExp = /^settext_/;
                   1188:     var tailLenient = /\.lenient$/;
                   1189:     var patternRelWeight = /^\-?[\d.]+$/;
                   1190:     var patternLenientStd = /^(yes|no|default)$/;
                   1191:     var ipallowRegExp = /^setipallow_/;
                   1192:     var ipdenyRegExp = /^setipdeny_/; 
                   1193:     var patternIP = /[\[\]\*\.a-zA-Z\d\-]+/;
                   1194:     if ((document.parmform.elements.length != 'undefined')  && (document.parmform.elements.length) != 'null') {
                   1195:         if (document.parmform.elements.length) {
                   1196:             for (i=0; i<document.parmform.elements.length; i++) {
                   1197:                 var name=document.parmform.elements[i].name;
                   1198:                 if (textRegExp.test(name)) { 
                   1199:                     var identifier = name.replace(textRegExp,'');
                   1200:                     if (tailLenient.test(identifier)) {
                   1201:                         if (document.parmform.elements['set_'+identifier].length) {
                   1202:                             for (var j=0; j<document.parmform.elements['set_'+identifier].length; j++) {
                   1203:                                 if (document.parmform.elements['set_'+identifier][j].checked) {
                   1204:                                     if (!(patternLenientStd.test(document.parmform.elements['set_'+identifier][j].value))) {
                   1205:                                         var relweight = document.parmform.elements[i].value;
                   1206:                                         relweight = relweight.replace(/^\s+|\s+$/g,'');
                   1207:                                         if (!patternRelWeight.test(relweight)) {
                   1208:                                             relweight = '0.0';
                   1209:                                         }
                   1210:                                         if (document.parmform.elements['set_'+identifier][j].value == 'weighted') {
                   1211:                                             document.parmform.elements['set_'+identifier][j].value = relweight;
                   1212:                                         } else {
                   1213:                                             document.parmform.elements['set_'+identifier][j].value += ','+relweight;
                   1214:                                         }
                   1215:                                     }
                   1216:                                     break;
                   1217:                                 }
                   1218:                             }
                   1219:                         }
                   1220:                     }
                   1221:                 } else {
                   1222:                     if (ipallowRegExp.test(name)) {
                   1223:                         var identifier = name.replace(ipallowRegExp,'');
                   1224:                         var possallow = document.parmform.elements[i].value;
                   1225:                         possallow = possallow.replace(/^\s+|\s+$/g,'');
                   1226:                         if (patternIP.test(possallow)) {
                   1227:                             if (document.parmform.elements['set_'+identifier].value) {
                   1228:                                 possallow = ','+possallow;
                   1229:                             }
                   1230:                             document.parmform.elements['set_'+identifier].value += possallow; 
                   1231:                         }
                   1232:                     } else {
                   1233:                         if (ipdenyRegExp.test(name)) {
                   1234:                             var identifier = name.replace(ipdenyRegExp,'');
                   1235:                             var possdeny = document.parmform.elements[i].value;
                   1236:                             possdeny = possdeny.replace(/^\s+|\s+$/g,'');
                   1237:                             if (patternIP.test(possdeny)) {
                   1238:                                 possdeny = '!'+possdeny;
                   1239:                                 if (document.parmform.elements['set_'+identifier].value) {
                   1240:                                     possdeny = ','+possdeny;
                   1241:                                 }
                   1242:                                 document.parmform.elements['set_'+identifier].value += possdeny;
                   1243:                             }
                   1244:                         }
                   1245:                     }
                   1246:                 }
                   1247:             }
                   1248:         }
                   1249:     }
                   1250:     return true;
                   1251: }
                   1252: 
                   1253: ENDSCRIPT
                   1254: }
                   1255: 
1.561     damieng  1256: # Javascript initialization, for overview mode
1.549     raeburn  1257: sub ipacc_boxes_js  {
                   1258:     my $remove = &mt('Remove');
                   1259:     return <<"END";
                   1260: \$(document).ready(function() {
                   1261:     var wrapper         = \$(".LC_string_ipacc_wrap");
                   1262:     var add_button      = \$(".LC_add_ipacc_button");
                   1263:     var ipaccRegExp     = /^LC_string_ipacc_/;
                   1264: 
                   1265:     \$(add_button).click(function(e){
                   1266:         e.preventDefault();
                   1267:         var identifier = \$(this).closest("div").attr("id");
                   1268:         identifier = identifier.replace(ipaccRegExp,'');
1.551     raeburn  1269:         \$(this).closest('div').find('.LC_string_ipacc_inner').append('<div><input type="text" name="setip'+identifier+'" /><a href="#" class="LC_remove_ipacc">$remove</a></div>');
1.549     raeburn  1270:     });
                   1271: 
                   1272:     \$(wrapper).delegate(".LC_remove_ipacc","click", function(e){
                   1273:         e.preventDefault(); \$(this).closest("div").remove();
                   1274:     })
                   1275: });
                   1276: 
                   1277: 
                   1278: END
                   1279: }
                   1280: 
1.561     damieng  1281: # Javascript function toggleSecret, for overview mode.
1.558     raeburn  1282: sub done_proctor_js {
                   1283:     return <<"END";
                   1284: function toggleSecret(form,radio,key) {
                   1285:     var radios = form[radio+key];
                   1286:     if (radios.length) {
                   1287:         for (var i=0; i<radios.length; i++) {
                   1288:             if (radios[i].checked) {
                   1289:                 if (radios[i].value == '_done_proctor') {
                   1290:                     if (document.getElementById('done_'+key+'_proctorkey')) {
                   1291:                         document.getElementById('done_'+key+'_proctorkey').type='text';
                   1292:                     }
                   1293:                 } else {
                   1294:                     if (document.getElementById('done_'+key+'_proctorkey')) {
                   1295:                         document.getElementById('done_'+key+'_proctorkey').type='hidden';
                   1296:                         document.getElementById('done_'+key+'_proctorkey').value='';
                   1297:                     }
                   1298:                 }
                   1299:             }
                   1300:         }
                   1301:     }
                   1302: }
                   1303: END
                   1304: 
                   1305: }
                   1306: 
1.561     damieng  1307: # Prints HTML page start for table mode.
                   1308: # @param {Apache2::RequestRec} $r - the Apache request
                   1309: # @param {string} $psymb - resource symb
                   1310: # @param {string} $crstype - course type (Community / Course / Placement Test)
1.280     albertel 1311: sub startpage {
1.531     raeburn  1312:     my ($r,$psymb,$crstype) = @_;
1.281     albertel 1313: 
1.515     raeburn  1314:     my %loaditems = (
                   1315:                       'onload'   => "group_or_section('cgroup')",
                   1316:                     );
                   1317:     if (!$psymb) {
1.523     raeburn  1318:         $loaditems{'onload'} = "showHide_courseContent(); group_or_section('cgroup'); resize_scrollbox('mapmenuscroll','1','1');";
1.515     raeburn  1319:     }
1.280     albertel 1320: 
1.560     damieng  1321:     if ((($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   1322:             (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   1323:         &Apache::lonhtmlcommon::add_breadcrumb({help=>'Problem_Parameters',
                   1324:             text=>"Problem Parameters"});
1.414     droeschl 1325:     } else {
1.560     damieng  1326:         &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
                   1327:             text=>"Table Mode",
                   1328:             help => 'Course_Setting_Parameters'});
1.414     droeschl 1329:     }
1.523     raeburn  1330:     my $js = &page_js().'
                   1331: <script type="text/javascript">
                   1332: // <![CDATA[
                   1333: '.
                   1334:             &Apache::lonhtmlcommon::resize_scrollbox_js('params').'
                   1335: // ]]>
                   1336: </script>
                   1337: ';
1.446     bisitz   1338:     my $start_page =
1.523     raeburn  1339:         &Apache::loncommon::start_page('Set/Modify Course Parameters',$js,
                   1340:                                        {'add_entries' => \%loaditems,});
1.446     bisitz   1341:     my $breadcrumbs =
1.473     amueller 1342:     &Apache::lonhtmlcommon::breadcrumbs('Table Mode Parameter Setting','Table_Mode');
1.506     www      1343:     my $escfilter=&Apache::lonhtmlcommon::entity_encode($env{'form.filter'});
                   1344:     my $escpart=&Apache::lonhtmlcommon::entity_encode($env{'form.part'});
1.507     www      1345:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  1346:     &startSettingsScreen($r,'parmset',$crstype);
1.280     albertel 1347:     $r->print(<<ENDHEAD);
1.193     albertel 1348: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.419     bisitz   1349: <input type="hidden" value="" name="pres_value" />
                   1350: <input type="hidden" value="" name="pres_type" />
                   1351: <input type="hidden" value="" name="pres_marker" />
                   1352: <input type="hidden" value="1" name="prevvisit" />
1.506     www      1353: <input type="hidden" value="$escfilter" name="filter" />
                   1354: <input type="hidden" value="$escpart" name="part" />
1.44      albertel 1355: ENDHEAD
                   1356: }
                   1357: 
1.209     www      1358: 
1.561     damieng  1359: # Prints a row for table mode (except for the tr start).
                   1360: # Every time a hash reference is passed, a single entry is used, so print_row
                   1361: # could just use these values, but why make it simple when it can be complicated ?
                   1362: #
                   1363: # @param {Apache2::RequestRec} $r - the Apache request
                   1364: # @param {string} $which - parameter key ('parameter_'.part.'_'.name)
                   1365: # @param {hash reference} $part - parameter key -> parameter part (can be problem part.'_'.response id for response parameters)
                   1366: # @param {hash reference} $name - parameter key -> parameter name
                   1367: # @param {hash reference} $symbp - resource id -> symb
                   1368: # @param {string} $rid - resource id
                   1369: # @param {hash reference} $default - parameter key -> resource parameter default value
                   1370: # @param {hash reference} $defaulttype - parameter key -> resource parameter default type
                   1371: # @param {hash reference} $display - parameter key -> full title for the parameter
                   1372: # @param {string} $defbgone - user level and other levels background color
                   1373: # @param {string} $defbgtwo - section level background color, also used for part number
                   1374: # @param {string} $defbgthree - group level background color
                   1375: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   1376: # @param {string} $uname - user name
                   1377: # @param {string} $udom - user domain
                   1378: # @param {string} $csec - section name
                   1379: # @param {string} $cgroup - group name
                   1380: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1381: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.44      albertel 1382: sub print_row {
1.201     www      1383:     my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.553     raeburn  1384:     $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups,$noeditgrp)=@_;
1.275     raeburn  1385:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   1386:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1387:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.553     raeburn  1388: 
1.560     damieng  1389:     # get the values for the parameter in cascading order
                   1390:     # empty levels will remain empty
1.44      albertel 1391:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.473     amueller 1392:       $rid,$$default{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560     damieng  1393:     # get the type for the parameters
                   1394:     # problem: these may not be set for all levels
1.66      www      1395:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
1.275     raeburn  1396:                                           $$name{$which}.'.type',$rid,
1.473     amueller 1397:          $$defaulttype{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560     damieng  1398:     # cascade down manually
1.182     albertel 1399:     my $cascadetype=$$defaulttype{$which};
1.556     raeburn  1400:     for (my $i=18;$i>0;$i--) {
1.560     damieng  1401:         if ($typeoutpar[$i]) {
1.66      www      1402:             $cascadetype=$typeoutpar[$i];
1.560     damieng  1403:         } else {
1.66      www      1404:             $typeoutpar[$i]=$cascadetype;
                   1405:         }
                   1406:     }
1.57      albertel 1407:     my $parm=$$display{$which};
                   1408: 
1.203     www      1409:     if ($parmlev eq 'full') {
1.419     bisitz   1410:         $r->print('<td style="background-color:'.$defbgtwo.';" align="center">'
1.506     www      1411:                   .($$part{$which} eq '0'?'0 ('.&mt('default').')':$$part{$which}).'</td>');
1.433     raeburn  1412:     } else {
1.57      albertel 1413:         $parm=~s|\[.*\]\s||g;
                   1414:     }
1.231     www      1415:     my $automatic=&rulescache(($which=~/\_([^\_]+)$/)[0].'_triggers');
                   1416:     if ($automatic) {
1.560     damieng  1417:         $parm.='<span class="LC_warning"><br />'.&mt('Automatically sets').' '.join(', ',split(/\:/,$automatic)).'</span>';
1.231     www      1418:     }
1.427     bisitz   1419:     $r->print('<td>'.$parm.'</td>');
1.446     bisitz   1420: 
1.44      albertel 1421:     my $thismarker=$which;
                   1422:     $thismarker=~s/^parameter\_//;
                   1423:     my $mprefix=$rid.'&'.$thismarker.'&';
1.554     raeburn  1424:     my $effective_parm = &valout($outpar[$result],$typeoutpar[$result],$thismarker);
1.275     raeburn  1425:     my ($othergrp,$grp_parm,$controlgrp);
1.44      albertel 1426: 
1.57      albertel 1427:     if ($parmlev eq 'general') {
                   1428:         if ($uname) {
1.556     raeburn  1429:             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
1.269     raeburn  1430:         } elsif ($cgroup) {
1.556     raeburn  1431:             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);
1.57      albertel 1432:         } elsif ($csec) {
1.556     raeburn  1433:             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
1.57      albertel 1434:         } else {
1.556     raeburn  1435:             &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
1.57      albertel 1436:         }
                   1437:     } elsif ($parmlev eq 'map') {
                   1438:         if ($uname) {
1.556     raeburn  1439:             &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1440:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display); 
1.269     raeburn  1441:         } elsif ($cgroup) {
1.556     raeburn  1442:             &print_td($r,7,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);
                   1443:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);
1.57      albertel 1444:         } elsif ($csec) {
1.556     raeburn  1445:             &print_td($r,11,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1446:             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
1.57      albertel 1447:         } else {
1.556     raeburn  1448:             &print_td($r,17,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1449:             &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
1.57      albertel 1450:         }
                   1451:     } else {
1.275     raeburn  1452:         if ($uname) {
                   1453:             if (@{$usersgroups} > 1) {
                   1454:                 my ($coursereply,$grp_parm,$controlgrp);
                   1455:                 ($coursereply,$othergrp,$grp_parm,$controlgrp) =
                   1456:                     &print_usergroups($r,$$part{$which}.'.'.$$name{$which},
                   1457:                        $rid,$cgroup,$defbgone,$usersgroups,$result,$courseopt);
1.556     raeburn  1458:                 if ($coursereply && $result > 4) {
1.275     raeburn  1459:                     if (defined($controlgrp)) {
                   1460:                         if ($cgroup ne $controlgrp) {
                   1461:                             $effective_parm = $grp_parm;
                   1462:                             $result = 0;
                   1463:                         }
                   1464:                     }
                   1465:                 }
                   1466:             }
                   1467:         }
1.57      albertel 1468: 
1.556     raeburn  1469:         &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1470:         &print_td($r,17,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1471:         &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1472:         &print_td($r,15,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1473:         &print_td($r,14,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
1.548     raeburn  1474:         &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1475: 
                   1476:         if ($csec) {
1.556     raeburn  1477:             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1478:             &print_td($r,11,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1479:             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
1.548     raeburn  1480:             &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1481:         }
1.269     raeburn  1482: 
                   1483:         if ($cgroup) {
1.556     raeburn  1484:             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);
                   1485:             &print_td($r,7,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);
1.553     raeburn  1486:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);
                   1487:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp);
1.269     raeburn  1488:         }
1.446     bisitz   1489: 
1.548     raeburn  1490:         if ($uname) {
1.275     raeburn  1491:             if ($othergrp) {
                   1492:                 $r->print($othergrp);
                   1493:             }
1.556     raeburn  1494:             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
1.548     raeburn  1495:             &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1496:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1497:             &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display);
                   1498:         }
1.57      albertel 1499: 
                   1500:     } # end of $parmlev if/else
1.419     bisitz   1501:     $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.'</td>');
1.136     albertel 1502: 
1.203     www      1503:     if ($parmlev eq 'full') {
1.136     albertel 1504:         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201     www      1505:                                         '.'.$$name{$which},$$symbp{$rid});
1.136     albertel 1506:         my $sessionvaltype=$typeoutpar[$result];
1.560     damieng  1507:         if (!defined($sessionvaltype)) {
                   1508:             $sessionvaltype=$$defaulttype{$which};
                   1509:         }
1.419     bisitz   1510:         $r->print('<td style="background-color:#999999;" align="center"><font color="#FFFFFF">'.
1.554     raeburn  1511:                   &valout($sessionval,$sessionvaltype,$$name{$which}).'&nbsp;'.
1.57      albertel 1512:                   '</font></td>');
1.136     albertel 1513:     }
1.44      albertel 1514:     $r->print('</tr>');
1.57      albertel 1515:     $r->print("\n");
1.44      albertel 1516: }
1.59      matthew  1517: 
1.561     damieng  1518: # Prints a cell for table mode.
                   1519: #
                   1520: # FIXME: some of these parameter names are uninspired ($which and $value)
                   1521: # Also, it would make more sense to pass the display for this cell rather
                   1522: # than the full display hash and the key to use.
                   1523: #
                   1524: # @param {Apache2::RequestRec} $r - the Apache request
                   1525: # @param {integer} $which - level
                   1526: # @param {string} $defbg - cell background color
                   1527: # @param {integer} $result - the most specific level that is defined for that parameter
                   1528: # @param {array reference} $outpar - array level -> parameter value (when defined)
                   1529: # @param {string} $mprefix - resource id.'&'.part.'_'.parameter name.'&'
                   1530: # @param {string} $value - parameter key ('parameter_'.part.'_'.name)
                   1531: # @param {array reference} $typeoutpar - array level -> parameter type (when defined)
                   1532: # @param {hash reference} $display - parameter key -> full title for the parameter
                   1533: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.44      albertel 1534: sub print_td {
1.553     raeburn  1535:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,$noeditgrp)=@_;
1.419     bisitz   1536:     $r->print('<td style="background-color:'.(($result==$which)?'#AAFFAA':$defbg).
                   1537:               ';" align="center">');
1.437     raeburn  1538:     my $nolink = 0;
1.556     raeburn  1539:     if ($which == 14 || $which == 15) {
1.437     raeburn  1540:         $nolink = 1;
1.556     raeburn  1541:     } elsif (($env{'request.course.sec'} ne '') && ($which > 12)) {
1.552     raeburn  1542:         $nolink = 1;
1.556     raeburn  1543:     } elsif ($which == 5 || $which ==  6 || $which == 7 || $which == 8) {
1.553     raeburn  1544:         if ($noeditgrp) {
                   1545:             $nolink = 1;
                   1546:         }
1.437     raeburn  1547:     } elsif ($mprefix =~ /availablestudent\&$/) {
1.556     raeburn  1548:         if ($which > 4) {
1.437     raeburn  1549:             $nolink = 1;
                   1550:         }
1.533     raeburn  1551:     } elsif ($mprefix =~ /examcode\&$/) {
                   1552:         unless ($which == 2) {
                   1553:             $nolink = 1;
                   1554:         }
1.437     raeburn  1555:     }
                   1556:     if ($nolink) {
1.554     raeburn  1557:         $r->print(&valout($$outpar[$which],$$typeoutpar[$which],$mprefix));
1.561     damieng  1558: # FIXME: probably a good thing that mprefix is not used in valout, because it does not look like a parameter name !
1.114     www      1559:     } else {
1.437     raeburn  1560:         $r->print(&plink($$typeoutpar[$which],
                   1561:                          $$display{$value},$$outpar[$which],
                   1562:                          $mprefix."$which",'parmform.pres','psub'));
1.114     www      1563:     }
                   1564:     $r->print('</td>'."\n");
1.57      albertel 1565: }
                   1566: 
1.561     damieng  1567: # FIXME: Despite the name, this does not print anything, the $r parameter is unused.
                   1568: # Returns HTML and other info for the cell added when a user is selected
                   1569: # and that user is in several groups. This is the cell with the title "Control by other group".
                   1570: #
                   1571: # @param {Apache2::RequestRec} $r - the Apache request (unused)
                   1572: # @param {string} $what - parameter part.'.'.parameter name
                   1573: # @param {string} $rid - resource id
                   1574: # @param {string} $cgroup - group name
                   1575: # @param {string} $defbg - cell background color
                   1576: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1577: # @param {integer} $result - level
                   1578: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
                   1579: # @returns {Array} - array (parameter value for the other group, HTML for the cell, HTML with the value, name of the other group)
1.275     raeburn  1580: sub print_usergroups {
                   1581:     my ($r,$what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
                   1582:     my $courseid = $env{'request.course.id'};
                   1583:     my $output;
                   1584:     my $symb = &symbcache($rid);
                   1585:     my $symbparm=$symb.'.'.$what;
                   1586:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.556     raeburn  1587:     my $recurseparm=$map.'___(rec).'.$what; 
1.275     raeburn  1588:     my $mapparm=$map.'___(all).'.$what;
                   1589:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype) =
1.556     raeburn  1590:           &parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,
                   1591:                               $recurseparm,$what,$courseopt);
1.275     raeburn  1592:     my $bgcolor = $defbg;
                   1593:     my $grp_parm;
1.446     bisitz   1594:     if (($coursereply) && ($cgroup ne $resultgroup)) {
1.275     raeburn  1595:         if ($result > 3) {
1.419     bisitz   1596:             $bgcolor = '#AAFFAA';
1.554     raeburn  1597:             $grp_parm = &valout($coursereply,$resulttype,$what);
1.275     raeburn  1598:         }
1.554     raeburn  1599:         $grp_parm = &valout($coursereply,$resulttype,$what);
1.419     bisitz   1600:         $output = '<td style="background-color:'.$bgcolor.';" align="center">';
1.275     raeburn  1601:         if ($resultgroup && $resultlevel) {
                   1602:             $output .= '<small><b>'.$resultgroup.'</b> ('.$resultlevel.'): </small>'.$grp_parm;
                   1603:         } else {
                   1604:             $output .= '&nbsp;';
                   1605:         }
                   1606:         $output .= '</td>';
                   1607:     } else {
1.419     bisitz   1608:         $output .= '<td style="background-color:'.$bgcolor.';">&nbsp;</td>';
1.275     raeburn  1609:     }
                   1610:     return ($coursereply,$output,$grp_parm,$resultgroup);
                   1611: }
                   1612: 
1.561     damieng  1613: # Looks for a group with a defined parameter for given user and parameter.
                   1614: # Used by print_usergroups.
                   1615: #
                   1616: # @param {string} $courseid - the course id
                   1617: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1618: # @param {string} $symbparm - end of the course parameter hash key for the group resource level
                   1619: # @param {string} $mapparm - end of the course parameter hash key for the group map/folder level
                   1620: # @param {string} $recurseparm - end of the course parameter hash key for the group recursive level
                   1621: # @param {string} $what - parameter part.'.'.parameter name
                   1622: # @param {hash reference} $courseopt - course parameters hash
                   1623: # @returns {Array} - (parameter value for the group, course parameter hash key for the parameter, name of the group, level name, parameter type)
1.275     raeburn  1624: sub parm_control_group {
1.556     raeburn  1625:     my ($courseid,$usersgroups,$symbparm,$mapparm,$recurseparm,$what,$courseopt) = @_;
1.275     raeburn  1626:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1627:     my $grpfound = 0;
1.556     raeburn  1628:     my @levels = ($symbparm,$mapparm,$recurseparm,$what);
                   1629:     my @levelnames = ('resource','map/folder','recursive','general');
1.275     raeburn  1630:     foreach my $group (@{$usersgroups}) {
                   1631:         if ($grpfound) { last; }
                   1632:         for (my $i=0; $i<@levels; $i++) {
                   1633:             my $item = $courseid.'.['.$group.'].'.$levels[$i];
                   1634:             if (defined($$courseopt{$item})) {
                   1635:                 $coursereply = $$courseopt{$item};
                   1636:                 $resultitem = $item;
                   1637:                 $resultgroup = $group;
                   1638:                 $resultlevel = $levelnames[$i];
                   1639:                 $resulttype = $$courseopt{$item.'.type'};
                   1640:                 $grpfound = 1;
                   1641:                 last;
                   1642:             }
                   1643:         }
                   1644:     }
                   1645:     return($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1646: }
1.201     www      1647: 
1.63      bowersj2 1648: 
                   1649: 
1.562     damieng  1650: # Extracts lots of information about all of the the course's resources into a variety of hashes, using lonnavmaps and lonnet::metadata.
                   1651: # All the parameters are references and are filled by the sub.
                   1652: #
                   1653: # @param {array reference} $ids - resource ids
                   1654: # @param {hash reference} $typep - hash resource id (from big hash) -> resource type (file extension)
                   1655: # @param {hash reference} $keyp - hash resource id -> comma-separated list of parameter keys from lonnet::metadata
                   1656: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   1657: # @param {hash reference} $allparts - hash parameter part -> part title (a parameter part can be problem part.'_'.response id for response parameters)
                   1658: # @param {hash reference} $allmaps - hash map id (from big hash) -> map src
                   1659: # @param {hash reference} $mapp - hash resource id -> enclosing map src
                   1660: # @param {hash reference} $symbp - hash map id or resource id -> map src.'___(all)' for a map or resource symb for a resource
                   1661: # @param {hash reference} $maptitles - hash map id or src -> map title (this should really be two separate hashes)
                   1662: # @param {hash reference} $uris - hash resource id -> resource src
                   1663: # @param {hash reference} $keyorder - hash parameter key -> appearance rank for this parameter when looking through every resource and every parameter, starting at 100 (integer)
                   1664: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.63      bowersj2 1665: sub extractResourceInformation {
                   1666:     my $ids = shift;
                   1667:     my $typep = shift;
                   1668:     my $keyp = shift;
                   1669:     my $allparms = shift;
                   1670:     my $allparts = shift;
                   1671:     my $allmaps = shift;
                   1672:     my $mapp = shift;
                   1673:     my $symbp = shift;
1.82      www      1674:     my $maptitles=shift;
1.196     www      1675:     my $uris=shift;
1.210     www      1676:     my $keyorder=shift;
1.211     www      1677:     my $defkeytype=shift;
1.196     www      1678: 
1.210     www      1679:     my $keyordercnt=100;
1.63      bowersj2 1680: 
1.196     www      1681:     my $navmap = Apache::lonnavmaps::navmap->new();
                   1682:     my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
                   1683:     foreach my $resource (@allres) {
1.480     amueller 1684:         my $id=$resource->id();
1.196     www      1685:         my ($mapid,$resid)=split(/\./,$id);
1.480     amueller 1686:         if ($mapid eq '0') { next; }
                   1687:         $$ids[$#$ids+1]=$id;
                   1688:         my $srcf=$resource->src();
                   1689:         $srcf=~/\.(\w+)$/;
                   1690:         $$typep{$id}=$1;
                   1691:         $$keyp{$id}='';
1.196     www      1692:         $$uris{$id}=$srcf;
1.512     foxr     1693: 
1.480     amueller 1694:         foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
                   1695:             next if ($key!~/^parameter_/);
1.363     albertel 1696: 
1.209     www      1697: # Hidden parameters
1.480     amueller 1698:             next if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm');
1.209     www      1699: #
                   1700: # allparms is a hash of parameter names
                   1701: #
1.480     amueller 1702:             my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
                   1703:             if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
                   1704:                 my ($display,$parmdis);
                   1705:                 $display = &standard_parameter_names($name);
                   1706:                 if ($display eq '') {
                   1707:                     $display= &Apache::lonnet::metadata($srcf,$key.'.display');
                   1708:                     $parmdis = $display;
                   1709:                     $parmdis =~ s/\s*\[Part.*$//g;
                   1710:                 } else {
                   1711:                     $parmdis = &mt($display);
                   1712:                 }
                   1713:                 $$allparms{$name}=$parmdis;
                   1714:                 if (ref($defkeytype)) {
                   1715:                     $$defkeytype{$name}=
                   1716:                     &Apache::lonnet::metadata($srcf,$key.'.type');
                   1717:                 }
                   1718:             }
1.363     albertel 1719: 
1.209     www      1720: #
                   1721: # allparts is a hash of all parts
                   1722: #
1.480     amueller 1723:             my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
                   1724:             $$allparts{$part} = &mt('Part: [_1]',$part);
1.209     www      1725: #
                   1726: # Remember all keys going with this resource
                   1727: #
1.480     amueller 1728:             if ($$keyp{$id}) {
                   1729:                 $$keyp{$id}.=','.$key;
                   1730:             } else {
                   1731:                 $$keyp{$id}=$key;
                   1732:             }   
1.210     www      1733: #
                   1734: # Put in order
1.446     bisitz   1735: #
1.480     amueller 1736:             unless ($$keyorder{$key}) {
                   1737:                 $$keyorder{$key}=$keyordercnt;
                   1738:                 $keyordercnt++;
                   1739:             }
1.473     amueller 1740:         }
                   1741: 
                   1742: 
1.480     amueller 1743:         if (!exists($$mapp{$mapid})) {
                   1744:             $$mapp{$id}=
                   1745:             &Apache::lonnet::declutter($resource->enclosing_map_src());
                   1746:             $$mapp{$mapid}=$$mapp{$id};
                   1747:             $$allmaps{$mapid}=$$mapp{$id};
                   1748:             if ($mapid eq '1') {
1.532     raeburn  1749:                 $$maptitles{$mapid}=&mt('Main Content');
1.480     amueller 1750:             } else {
                   1751:                 $$maptitles{$mapid}=&Apache::lonnet::gettitle($$mapp{$id});
                   1752:             }
                   1753:             $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
1.556     raeburn  1754:             $$symbp{$mapid}=$$mapp{$id}.'___(all)';  # Added in rev. 1.57, but seems not to be used.
                   1755:                                                      # Lines 1038 and 1114 which use $symbp{$mapid}
                   1756:                                                      # are commented out in rev. 1.57
1.473     amueller 1757:         } else {
1.480     amueller 1758:             $$mapp{$id} = $$mapp{$mapid};
1.473     amueller 1759:         }
1.480     amueller 1760:         $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
1.63      bowersj2 1761:     }
                   1762: }
                   1763: 
1.208     www      1764: 
1.562     damieng  1765: # Tells if a parameter type is a date.
                   1766: #
                   1767: # @param {string} type - parameter type
                   1768: # @returns{boolean} - true if it is a date
1.213     www      1769: sub isdateparm {
                   1770:     my $type=shift;
                   1771:     return (($type=~/^date/) && (!($type eq 'date_interval')));
                   1772: }
                   1773: 
1.562     damieng  1774: # Prints the HTML and Javascript to select parameters, with various shortcuts.
                   1775: # FIXME: remove unused parameters
1.468     amueller 1776: #
1.562     damieng  1777: # @param {Apache2::RequestRec} $r - the Apache request (unused)
                   1778: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   1779: # @param {array reference} $pscat - list of selected parameter names (unused)
                   1780: # @param {hash reference} $keyorder - hash parameter key -> appearance rank (unused)
1.208     www      1781: sub parmmenu {
1.211     www      1782:     my ($r,$allparms,$pscat,$keyorder)=@_;
1.208     www      1783:     my $tempkey;
                   1784:     $r->print(<<ENDSCRIPT);
                   1785: <script type="text/javascript">
1.454     bisitz   1786: // <![CDATA[
1.208     www      1787:     function checkall(value, checkName) {
1.453     schualex 1788: 
                   1789:         var li = "_li";
                   1790:         var displayOverview = "";
                   1791:         
                   1792:         if (value == false) {
                   1793:             displayOverview = "none"
                   1794:         }
                   1795: 
1.562     damieng  1796:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.208     www      1797:             ele = document.forms.parmform.elements[i];
                   1798:             if (ele.name == checkName) {
                   1799:                 document.forms.parmform.elements[i].checked=value;
                   1800:             }
                   1801:         }
                   1802:     }
1.210     www      1803: 
                   1804:     function checkthis(thisvalue, checkName) {
1.562     damieng  1805:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.210     www      1806:             ele = document.forms.parmform.elements[i];
                   1807:             if (ele.name == checkName) {
1.562     damieng  1808:                 if (ele.value == thisvalue) {
                   1809:                     document.forms.parmform.elements[i].checked=true;
                   1810:                 }
1.210     www      1811:             }
                   1812:         }
                   1813:     }
                   1814: 
                   1815:     function checkdates() {
1.562     damieng  1816:         checkthis('duedate','pscat');
                   1817:         checkthis('opendate','pscat');
                   1818:         checkthis('answerdate','pscat');
1.218     www      1819:     }
                   1820: 
                   1821:     function checkdisset() {
1.562     damieng  1822:         checkthis('discussend','pscat');
                   1823:         checkthis('discusshide','pscat');
                   1824:         checkthis('discussvote','pscat');
1.218     www      1825:     }
                   1826: 
                   1827:     function checkcontdates() {
1.562     damieng  1828:         checkthis('contentopen','pscat');
                   1829:         checkthis('contentclose','pscat');
1.218     www      1830:     }
1.446     bisitz   1831: 
1.210     www      1832:     function checkvisi() {
1.562     damieng  1833:         checkthis('hiddenresource','pscat');
                   1834:         checkthis('encrypturl','pscat');
                   1835:         checkthis('problemstatus','pscat');
                   1836:         checkthis('contentopen','pscat');
                   1837:         checkthis('opendate','pscat');
1.210     www      1838:     }
                   1839: 
                   1840:     function checkparts() {
1.562     damieng  1841:         checkthis('hiddenparts','pscat');
                   1842:         checkthis('display','pscat');
                   1843:         checkthis('ordered','pscat');
1.210     www      1844:     }
                   1845: 
                   1846:     function checkstandard() {
                   1847:         checkall(false,'pscat');
1.562     damieng  1848:         checkdates();
                   1849:         checkthis('weight','pscat');
                   1850:         checkthis('maxtries','pscat');
                   1851:         checkthis('type','pscat');
                   1852:         checkthis('problemstatus','pscat');
1.210     www      1853:     }
                   1854: 
1.454     bisitz   1855: // ]]>
1.208     www      1856: </script>
                   1857: ENDSCRIPT
1.453     schualex 1858: 
1.491     bisitz   1859:     $r->print('<hr />');
1.453     schualex 1860:     &shortCuts($r,$allparms,$pscat,$keyorder);
1.491     bisitz   1861:     $r->print('<hr />');
1.453     schualex 1862: }
1.562     damieng  1863: 
                   1864: # Returns parameter categories.
                   1865: #
                   1866: # @returns {hash} - category name -> title in English
1.465     amueller 1867: sub categories {
                   1868:     return ('time_settings' => 'Time Settings',
                   1869:     'grading' => 'Grading',
                   1870:     'tries' => 'Tries',
                   1871:     'problem_appearance' => 'Problem Appearance',
                   1872:     'behaviour_of_input_fields' => 'Behaviour of Input Fields',
                   1873:     'hiding' => 'Hiding',
                   1874:     'high_level_randomization' => 'High Level Randomization',
                   1875:     'slots' => 'Slots',
                   1876:     'file_submission' => 'File Submission',
                   1877:     'misc' => 'Miscellaneous' ); 
                   1878: }
                   1879: 
1.562     damieng  1880: # Returns the category for each parameter.
                   1881: #
                   1882: # @returns {hash} - parameter name -> category name
1.465     amueller 1883: sub lookUpTableParameter {
                   1884:  
                   1885:     return ( 
                   1886:         'opendate' => 'time_settings',
                   1887:         'duedate' => 'time_settings',
                   1888:         'answerdate' => 'time_settings',
                   1889:         'interval' => 'time_settings',
                   1890:         'contentopen' => 'time_settings',
                   1891:         'contentclose' => 'time_settings',
                   1892:         'discussend' => 'time_settings',
1.560     damieng  1893:         'printstartdate' => 'time_settings',
                   1894:         'printenddate' => 'time_settings',
1.465     amueller 1895:         'weight' => 'grading',
                   1896:         'handgrade' => 'grading',
                   1897:         'maxtries' => 'tries',
                   1898:         'hinttries' => 'tries',
1.503     raeburn  1899:         'randomizeontries' => 'tries',
1.465     amueller 1900:         'type' => 'problem_appearance',
                   1901:         'problemstatus' => 'problem_appearance',
                   1902:         'display' => 'problem_appearance',
                   1903:         'ordered' => 'problem_appearance',
                   1904:         'numbubbles' => 'problem_appearance',
                   1905:         'tol' => 'behaviour_of_input_fields',
                   1906:         'sig' => 'behaviour_of_input_fields',
                   1907:         'turnoffunit' => 'behaviour_of_input_fields',
                   1908:         'hiddenresource' => 'hiding',
                   1909:         'hiddenparts' => 'hiding',
                   1910:         'discusshide' => 'hiding',
                   1911:         'buttonshide' => 'hiding',
                   1912:         'turnoffeditor' => 'hiding',
                   1913:         'encrypturl' => 'hiding',
                   1914:         'randomorder' => 'high_level_randomization',
                   1915:         'randompick' => 'high_level_randomization',
                   1916:         'available' => 'slots',
                   1917:         'useslots' => 'slots',
                   1918:         'availablestudent' => 'slots',
                   1919:         'uploadedfiletypes' => 'file_submission',
                   1920:         'maxfilesize' => 'file_submission',
                   1921:         'cssfile' => 'misc',
                   1922:         'mapalias' => 'misc',
                   1923:         'acc' => 'misc',
                   1924:         'maxcollaborators' => 'misc',
                   1925:         'scoreformat' => 'misc',
1.514     raeburn  1926:         'lenient' => 'grading',
1.519     raeburn  1927:         'retrypartial' => 'tries',
1.521     raeburn  1928:         'discussvote'  => 'misc',
1.533     raeburn  1929:         'examcode' => 'high_level_randomization', 
1.465     amueller 1930:     );    
                   1931: }
                   1932: 
1.562     damieng  1933: # Adds the given parameter name to an array of arrays listing all parameters for each category.
                   1934: #
                   1935: # @param {string} $name - parameter name
                   1936: # @param {array reference} $catList - array reference category name -> array reference of parameter names
1.465     amueller 1937: sub whatIsMyCategory {
                   1938:     my $name = shift;
                   1939:     my $catList = shift;
                   1940:     my @list;
                   1941:     my %lookUpList = &lookUpTableParameter; #Initilize the lookupList
                   1942:     my $cat = $lookUpList{$name};
                   1943:     if (defined($cat)) {
                   1944:         if (!defined($$catList{$cat})){
                   1945:             push @list, ($name);
                   1946:             $$catList{$cat} = \@list;
                   1947:         } else {
                   1948:             push @{${$catList}{$cat}}, ($name);     
                   1949:         }
                   1950:     } else {
                   1951:         if (!defined($$catList{'misc'})){
                   1952:             push @list, ($name);
                   1953:             $$catList{'misc'} = \@list;
                   1954:         } else {
                   1955:             push @{${$catList}{'misc'}}, ($name);     
                   1956:         }
                   1957:     }        
                   1958: }
                   1959: 
1.562     damieng  1960: # Sorts parameter names based on appearance order.
                   1961: #
                   1962: # @param {array reference} name - array reference of parameter names
                   1963: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   1964: # @returns {Array} - array of parameter names
1.465     amueller 1965: sub keysindisplayorderCategory {
                   1966:     my ($name,$keyorder)=@_;
                   1967:     return sort {
1.473     amueller 1968:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b}; 
1.465     amueller 1969:     } ( @{$name});
                   1970: }
                   1971: 
1.562     damieng  1972: # Returns a hash category name -> order, starting at 1 (integer)
                   1973: #
                   1974: # @returns {hash}
1.467     amueller 1975: sub category_order {
                   1976:     return (
                   1977:         'time_settings' => 1,
                   1978:         'grading' => 2,
                   1979:         'tries' => 3,
                   1980:         'problem_appearance' => 4,
                   1981:         'hiding' => 5,
                   1982:         'behaviour_of_input_fields' => 6,
                   1983:         'high_level_randomization'  => 7,
                   1984:         'slots' => 8,
                   1985:         'file_submission' => 9,
                   1986:         'misc' => 10
                   1987:     );
                   1988: 
                   1989: }
1.453     schualex 1990: 
1.562     damieng  1991: # Prints HTML to let the user select parameters, from a list of all parameters organized by category.
                   1992: #
                   1993: # @param {Apache2::RequestRec} $r - the Apache request
                   1994: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   1995: # @param {array reference} $pscat - list of selected parameter names
                   1996: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
1.453     schualex 1997: sub parmboxes {
                   1998:     my ($r,$allparms,$pscat,$keyorder)=@_;
1.548     raeburn  1999:     my %categories = &categories();
1.467     amueller 2000:     my %category_order = &category_order();
1.465     amueller 2001:     my %categoryList = (
                   2002:         'time_settings' => [],
                   2003:         'grading' => [],
                   2004:         'tries' => [],
                   2005:         'problem_appearance' => [],
                   2006:         'behaviour_of_input_fields' => [],
                   2007:         'hiding' => [],
                   2008:         'high_level_randomization' => [],
                   2009:         'slots' => [],
                   2010:         'file_submission' => [],
                   2011:         'misc' => [],
1.489     bisitz   2012:     );
1.510     www      2013: 
1.548     raeburn  2014:     foreach my $tempparameter (keys(%$allparms)) {
1.465     amueller 2015:         &whatIsMyCategory($tempparameter, \%categoryList);
                   2016:     }
1.453     schualex 2017:     #part to print the parm-list
1.536     raeburn  2018:     foreach my $key (sort { $category_order{$a} <=> $category_order{$b} } keys(%categoryList)) {
                   2019:         next if (@{$categoryList{$key}} == 0);
                   2020:         next if ($key eq '');
                   2021:         $r->print('<div class="LC_Box LC_400Box">'
                   2022:                  .'<h4 class="LC_hcell">'.&mt($categories{$key}).'</h4>'."\n");
                   2023:         foreach my $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {
                   2024:             $r->print('<span class="LC_nobreak">'
                   2025:                      .'<label><input type="checkbox" name="pscat" '
                   2026:                      .'value="'.$tempkey.'" ');
                   2027:             if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
                   2028:                 $r->print( ' checked="checked"');
                   2029:             }
                   2030:             $r->print(' />'.($$allparms{$tempkey}=~/\S/ ? $$allparms{$tempkey}
1.465     amueller 2031:                                                       : $tempkey)
1.536     raeburn  2032:                      .'</label></span><br />'."\n");
1.465     amueller 2033:         }
1.536     raeburn  2034:         $r->print('</div>');
1.465     amueller 2035:     }
1.536     raeburn  2036:     $r->print("\n");
1.453     schualex 2037: }
1.562     damieng  2038: 
                   2039: # Prints HTML with shortcuts to select groups of parameters in one click, or deselect all.
                   2040: # FIXME: remove unused parameters
1.468     amueller 2041: #
1.562     damieng  2042: # @param {Apache2::RequestRec} $r - the Apache request
                   2043: # @param {hash reference} $allparms - hash parameter name -> parameter title (unused)
                   2044: # @param {array reference} $pscat - list of selected parameter names (unused)
                   2045: # @param {hash reference} $keyorder - hash parameter key -> appearance rank (unused)
1.453     schualex 2046: sub shortCuts {
                   2047:     my ($r,$allparms,$pscat,$keyorder)=@_;
                   2048: 
1.491     bisitz   2049:     # Parameter Selection
                   2050:     $r->print(
                   2051:         &Apache::lonhtmlcommon::start_funclist(&mt('Parameter Selection'))
                   2052:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2053:             '<a href="javascript:checkall(true, \'pscat\')">'.&mt('Select All').'</a>')
                   2054:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2055:             '<a href="javascript:checkstandard()">'.&mt('Select Common Only').'</a>')
                   2056:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2057:             '<a href="javascript:checkall(false, \'pscat\')">'.&mt('Unselect All').'</a>')
                   2058:        .&Apache::lonhtmlcommon::end_funclist()
                   2059:     );
                   2060: 
                   2061:     # Add Selection for...
                   2062:     $r->print(
                   2063:         &Apache::lonhtmlcommon::start_funclist(&mt('Add Selection for...'))
                   2064:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2065:             '<a href="javascript:checkdates()">'.&mt('Problem Dates').'</a>')
                   2066:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2067:             '<a href="javascript:checkcontdates()">'.&mt('Content Dates').'</a>')
                   2068:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2069:             '<a href="javascript:checkdisset()">'.&mt('Discussion Settings').'</a>')
                   2070:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2071:             '<a href="javascript:checkvisi()">'.&mt('Visibilities').'</a>')
                   2072:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2073:             '<a href="javascript:checkparts()">'.&mt('Part Parameters').'</a>')
                   2074:        .&Apache::lonhtmlcommon::end_funclist()
                   2075:     );
1.208     www      2076: }
                   2077: 
1.562     damieng  2078: # Prints HTML to select parts to view (except for the title).
                   2079: # Used by table and overview modes.
                   2080: #
                   2081: # @param {Apache2::RequestRec} $r - the Apache request
                   2082: # @param {hash reference} $allparts - hash parameter part -> part title
                   2083: # @param {array reference} $psprt - list of selected parameter parts
1.209     www      2084: sub partmenu {
1.446     bisitz   2085:     my ($r,$allparts,$psprt)=@_;
1.523     raeburn  2086:     my $selsize = 1+scalar(keys(%{$allparts}));
                   2087:     if ($selsize > 8) {
                   2088:         $selsize = 8;
                   2089:     }
1.446     bisitz   2090: 
1.523     raeburn  2091:     $r->print('<select multiple="multiple" name="psprt" size="'.$selsize.'">');
1.208     www      2092:     $r->print('<option value="all"');
1.562     damieng  2093:     $r->print(' selected="selected"') unless (@{$psprt}); # useless, the array is never empty
1.208     www      2094:     $r->print('>'.&mt('All Parts').'</option>');
                   2095:     my %temphash=();
                   2096:     foreach (@{$psprt}) { $temphash{$_}=1; }
1.234     albertel 2097:     foreach my $tempkey (sort {
1.560     damieng  2098:                 if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); }
                   2099:             } keys(%{$allparts})) {
                   2100:         unless ($tempkey =~ /\./) {
                   2101:             $r->print('<option value="'.$tempkey.'"');
                   2102:             if ($$psprt[0] eq "all" ||  $temphash{$tempkey}) {
                   2103:                 $r->print(' selected="selected"');
                   2104:             }
                   2105:             $r->print('>'.$$allparts{$tempkey}.'</option>');
1.473     amueller 2106:         }
1.208     www      2107:     }
1.446     bisitz   2108:     $r->print('</select>');
1.209     www      2109: }
                   2110: 
1.562     damieng  2111: # Prints HTML to select a user and/or a group.
                   2112: # Used by table mode.
                   2113: #
                   2114: # @param {Apache2::RequestRec} $r - the Apache request
                   2115: # @param {string} $uname - selected user name
                   2116: # @param {string} $id - selected Student/Employee ID
                   2117: # @param {string} $udom - selected user domain
                   2118: # @param {string} $csec - selected section name
                   2119: # @param {string} $cgroup - selected group name
                   2120: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   2121: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   2122: # @param {string} $pssymb - resource symb (when a single resource is selected)
1.209     www      2123: sub usermenu {
1.553     raeburn  2124:     my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups,$pssymb)=@_;
1.209     www      2125:     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                   2126:         &Apache::loncommon::selectstudent_link('parmform','uname','udom');
                   2127:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.412     bisitz   2128: 
1.209     www      2129:     my $sections='';
1.300     albertel 2130:     my %sectionhash = &Apache::loncommon::get_sections();
                   2131: 
1.269     raeburn  2132:     my $groups;
1.553     raeburn  2133:     my %grouphash;
                   2134:     if (($pssymb) || &Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2135:         %grouphash = &Apache::longroup::coursegroups();
                   2136:     } elsif ($env{'request.course.groups'} ne '') {
                   2137:         map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
                   2138:     }
1.299     albertel 2139: 
1.412     bisitz   2140:     my $g_s_header='';
                   2141:     my $g_s_footer='';
1.446     bisitz   2142: 
1.552     raeburn  2143:     my $currsec = $env{'request.course.sec'};
                   2144:     if ($currsec) {
                   2145:         $sections=&mt('Section:').' '.$currsec;
                   2146:         if (%grouphash) {
                   2147:             $sections .= ';'.('&nbsp;' x2);
                   2148:         }
                   2149:     } elsif (%sectionhash && $currsec eq '') {
1.412     bisitz   2150:         $sections=&mt('Section:').' <select name="csec"';
1.299     albertel 2151:         if (%grouphash && $parmlev ne 'full') {
1.269     raeburn  2152:             $sections .= qq| onchange="group_or_section('csec')" |;
                   2153:         }
                   2154:         $sections .= '>';
1.548     raeburn  2155:     foreach my $section ('',sort(keys(%sectionhash))) {
1.473     amueller 2156:         $sections.='<option value="'.$section.'" '.
                   2157:         ($section eq $csec?'selected="selected"':'').'>'.$section.
1.275     raeburn  2158:                                                               '</option>';
1.209     www      2159:         }
                   2160:         $sections.='</select>';
1.269     raeburn  2161:     }
1.412     bisitz   2162: 
1.552     raeburn  2163:     if (%sectionhash && %grouphash && $parmlev ne 'full' && $currsec eq '') {
1.412     bisitz   2164:         $sections .= '&nbsp;'.&mt('or').'&nbsp;';
1.269     raeburn  2165:         $sections .= qq|
                   2166: <script type="text/javascript">
1.454     bisitz   2167: // <![CDATA[
1.269     raeburn  2168: function group_or_section(caller) {
                   2169:    if (caller == "cgroup") {
                   2170:        if (document.parmform.cgroup.selectedIndex != 0) {
                   2171:            document.parmform.csec.selectedIndex = 0;
                   2172:        }
                   2173:    } else {
                   2174:        if (document.parmform.csec.selectedIndex != 0) {
                   2175:            document.parmform.cgroup.selectedIndex = 0;
                   2176:        }
                   2177:    }
                   2178: }
1.454     bisitz   2179: // ]]>
1.269     raeburn  2180: </script>
                   2181: |;
1.554     raeburn  2182:     } else {
1.269     raeburn  2183:         $sections .= qq|
                   2184: <script type="text/javascript">
1.454     bisitz   2185: // <![CDATA[
1.269     raeburn  2186: function group_or_section(caller) {
                   2187:     return;
                   2188: }
1.454     bisitz   2189: // ]]>
1.269     raeburn  2190: </script>
                   2191: |;
1.446     bisitz   2192:     }
1.299     albertel 2193: 
                   2194:     if (%grouphash) {
1.412     bisitz   2195:         $groups=&mt('Group:').' <select name="cgroup"';
1.552     raeburn  2196:         if (%sectionhash && $env{'form.action'} eq 'settable' && $currsec eq '') {
1.269     raeburn  2197:             $groups .= qq| onchange="group_or_section('cgroup')" |;
                   2198:         }
                   2199:         $groups .= '>';
1.548     raeburn  2200:         foreach my $grp ('',sort(keys(%grouphash))) {
1.275     raeburn  2201:             $groups.='<option value="'.$grp.'" ';
                   2202:             if ($grp eq $cgroup) {
                   2203:                 unless ((defined($uname)) && ($grp eq '')) {
                   2204:                     $groups .=  'selected="selected" ';
                   2205:                 }
                   2206:             } elsif (!defined($cgroup)) {
                   2207:                 if (@{$usersgroups} == 1) {
                   2208:                     if ($grp eq $$usersgroups[0]) {
                   2209:                         $groups .=  'selected="selected" ';
                   2210:                     }
                   2211:                 }
                   2212:             }
                   2213:             $groups .= '>'.$grp.'</option>';
1.269     raeburn  2214:         }
                   2215:         $groups.='</select>';
                   2216:     }
1.412     bisitz   2217: 
1.445     neumanie 2218:     if (%sectionhash || %grouphash) {
1.446     bisitz   2219:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Group/Section')));
                   2220:         $r->print($sections.$groups);
1.448     bisitz   2221:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.554     raeburn  2222:     } else {
                   2223:         $r->print($sections); 
1.445     neumanie 2224:     }
1.446     bisitz   2225: 
                   2226:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('User')));
1.443     neumanie 2227:     $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
1.412     bisitz   2228:                  ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
                   2229:                  ,'<input type="text" value="'.$id.'" size="12" name="id" /> '
1.446     bisitz   2230:                  ,$chooseopt));
1.209     www      2231: }
                   2232: 
1.562     damieng  2233: # Prints HTML to select parameters from a list of all parameters.
                   2234: # Uses parmmenu and parmboxes.
                   2235: # Used by table and overview modes.
1.468     amueller 2236: #
1.562     damieng  2237: # @param {Apache2::RequestRec} $r - the Apache request
                   2238: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2239: # @param {array reference} $pscat - list of selected parameter names
                   2240: # @param {array reference} $psprt - list of selected parameter parts (unused)
                   2241: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2242: # @param {string} [$divid] - name used to give an id to the HTML element for the scroll box
1.209     www      2243: sub displaymenu {
1.536     raeburn  2244:     my ($r,$allparms,$pscat,$psprt,$keyorder,$divid)=@_;
1.510     www      2245: 
1.445     neumanie 2246:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.510     www      2247:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameters to View')));
                   2248: 
1.562     damieng  2249:     &parmmenu($r,$allparms,$pscat,$keyorder); # only $allparms is used by parmmenu
1.536     raeburn  2250:     $r->print(&Apache::loncommon::start_scrollbox('480px','440px','200px',$divid));
1.510     www      2251:     &parmboxes($r,$allparms,$pscat,$keyorder);
                   2252:     $r->print(&Apache::loncommon::end_scrollbox());
                   2253: 
                   2254:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.453     schualex 2255:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.510     www      2256:  
1.209     www      2257: }
                   2258: 
1.562     damieng  2259: # Prints HTML to select a map.
                   2260: # Used by table mode and overview mode.
                   2261: #
                   2262: # @param {Apache2::RequestRec} $r - the Apache request
                   2263: # @param {hash reference} $allmaps - hash map id -> map src
                   2264: # @param {string} $pschp - selected map id, or 'all'
                   2265: # @param {hash reference} $maptitles - hash map id or src -> map title
                   2266: # @param {hash reference} $symbp - hash map id or resource id -> map src.'___(all)' for a map or resource symb for a resource
1.445     neumanie 2267: sub mapmenu {
1.499     raeburn  2268:     my ($r,$allmaps,$pschp,$maptitles,$symbp)=@_;
1.468     amueller 2269:     my %allmaps_inverted = reverse %$allmaps;
1.461     neumanie 2270:     my $navmap = Apache::lonnavmaps::navmap->new();
                   2271:     my $tree=[];
                   2272:     my $treeinfo={};
                   2273:     if (defined($navmap)) {
1.499     raeburn  2274:         my $it=$navmap->getIterator(undef,undef,undef,1,1,undef);
1.461     neumanie 2275:         my $curRes;
                   2276:         my $depth = 0;
1.468     amueller 2277:         my %parent = ();
                   2278:         my $startcount = 5;
                   2279:         my $lastcontainer = $startcount;
                   2280: # preparing what is to show ...
1.461     neumanie 2281:         while ($curRes = $it->next()) {
                   2282:             if ($curRes == $it->BEGIN_MAP()) {
                   2283:                 $depth++;
1.468     amueller 2284:                 $parent{$depth}= $lastcontainer;
1.461     neumanie 2285:             }
                   2286:             if ($curRes == $it->END_MAP()) {
                   2287:                 $depth--;
1.468     amueller 2288:                 $lastcontainer = $parent{$depth};
1.461     neumanie 2289:             }
                   2290:             if (ref($curRes)) {
1.468     amueller 2291:                 my $symb = $curRes->symb();
                   2292:                 my $ressymb = $symb;
1.461     neumanie 2293:                 if (($curRes->is_sequence()) || ($curRes->is_page())) {
                   2294:                     my $type = 'sequence';
                   2295:                     if ($curRes->is_page()) {
                   2296:                         $type = 'page';
                   2297:                     }
                   2298:                     my $id= $curRes->id();
1.468     amueller 2299:                     my $srcf = $curRes->src();
                   2300:                     my $resource_name = &Apache::lonnet::gettitle($srcf);
                   2301:                     if(!exists($treeinfo->{$id})) {
                   2302:                         push(@$tree,$id);
1.473     amueller 2303:                         my $enclosing_map_folder = &Apache::lonnet::declutter($curRes->enclosing_map_src());        
1.468     amueller 2304:                         $treeinfo->{$id} = {
1.461     neumanie 2305:                                     depth => $depth,
                   2306:                                     type  => $type,
1.468     amueller 2307:                                     name  => $resource_name,
                   2308:                                     enclosing_map_folder => $enclosing_map_folder,
1.461     neumanie 2309:                                     };
1.462     neumanie 2310:                     }
1.461     neumanie 2311:                 }
                   2312:             }
                   2313:         }
1.462     neumanie 2314:     }
1.473     amueller 2315: # Show it ...    
1.484     amueller 2316:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Enclosing Map or Folder'),'','',' id="mapmenu"'));
1.461     neumanie 2317:     if ((ref($tree) eq 'ARRAY') && (ref($treeinfo) eq 'HASH')) {
                   2318:         my $icon = '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.497     bisitz   2319:         my $whitespace =
                   2320:             '<img src="'
                   2321:            .&Apache::loncommon::lonhttpdurl('/adm/lonIcons/whitespace_21.gif')
                   2322:            .'" alt="" />';
                   2323: 
1.498     bisitz   2324:         # Info about selectable folders/maps
                   2325:         $r->print(
                   2326:             '<div class="LC_info">'
1.508     www      2327:            .&mt('You can only select maps and folders which have modifiable settings.')
                   2328:            .' '.&Apache::loncommon::help_open_topic('Parameter_Set_Folder') 
1.498     bisitz   2329:            .'</div>'
                   2330:         );
                   2331: 
1.536     raeburn  2332:         $r->print(&Apache::loncommon::start_scrollbox('700px','680px','400px','mapmenuscroll'));
1.523     raeburn  2333:         $r->print(&Apache::loncommon::start_data_table(undef,'mapmenuinner'));
1.497     bisitz   2334: 
1.498     bisitz   2335:         # Display row: "All Maps or Folders"
                   2336:         $r->print(
1.523     raeburn  2337:             &Apache::loncommon::start_data_table_row(undef,'picklevel')
1.498     bisitz   2338:            .'<td>'
                   2339:            .'<label>'
                   2340:            .'<input type="radio" name="pschp"'
1.497     bisitz   2341:         );
                   2342:         $r->print(' checked="checked"') if ($pschp eq 'all' || !$pschp);
1.498     bisitz   2343:         $r->print(
                   2344:             ' value="all" />&nbsp;'.$icon.'&nbsp;'
                   2345:            .&mt('All Maps or Folders')
                   2346:            .'</label>'
                   2347:            .'<hr /></td>'
                   2348:            .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2349:         );
1.497     bisitz   2350: 
1.532     raeburn  2351:         # Display row: "Main Content"
1.468     amueller 2352:         if (exists($$allmaps{1})) {
1.498     bisitz   2353:             $r->print(
                   2354:                 &Apache::loncommon::start_data_table_row()
                   2355:                .'<td>'
                   2356:                .'<label>'
                   2357:                .'<input type="radio" name="pschp" value="1"'
1.468     amueller 2358:             );
1.497     bisitz   2359:             $r->print(' checked="checked"') if ($pschp eq '1');
1.498     bisitz   2360:             $r->print(
                   2361:                 '/>&nbsp;'.$icon.'&nbsp;'
                   2362:                .$$maptitles{1}
                   2363:                .($$allmaps{1} !~/^uploaded/?' ['.$$allmaps{1}.']':'')
                   2364:                .'</label>'
                   2365:                .'</td>'
                   2366:                .&Apache::loncommon::end_data_table_row()
1.468     amueller 2367:             );
                   2368:         }
1.497     bisitz   2369: 
                   2370:         # Display rows for all course maps and folders
1.468     amueller 2371:         foreach my $id (@{$tree}) {
                   2372:             my ($mapid,$resid)=split(/\./,$id);
1.464     bisitz   2373:             # Indentation
1.468     amueller 2374:             my $depth = $treeinfo->{$id}->{'depth'};
1.464     bisitz   2375:             my $indent;
                   2376:             for (my $i = 0; $i < $depth; $i++) {
                   2377:                 $indent.= $whitespace;
                   2378:             }
1.461     neumanie 2379:             $icon =  '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.468     amueller 2380:             if ($treeinfo->{$id}->{'type'} eq 'page') {
1.461     neumanie 2381:                 $icon = '<img src="/adm/lonIcons/navmap.page.open.gif" alt="" />';
                   2382:             }
1.468     amueller 2383:             my $symb_name = $$symbp{$id};
                   2384:             my ($front, $tail) = split (/___${resid}___/, $symb_name);
                   2385:             $symb_name = $tail;
1.498     bisitz   2386:             $r->print(
                   2387:                 &Apache::loncommon::start_data_table_row()
                   2388:                .'<td>'
                   2389:                .'<label>'
1.463     bisitz   2390:             );
1.498     bisitz   2391:             # Only offer radio button for folders/maps which can be parameterized
                   2392:             if ($allmaps_inverted{$symb_name}) {
                   2393:                 $r->print(
                   2394:                     '<input type ="radio" name="pschp"'
                   2395:                    .' value="'.$allmaps_inverted{$symb_name}.'"'
                   2396:                 );
                   2397:                 $r->print(' checked="checked"') if ($allmaps_inverted{$symb_name} eq $pschp);
                   2398:                 $r->print('/>');
                   2399:             } else {
                   2400:                 $r->print($whitespace);
1.461     neumanie 2401:             }
1.498     bisitz   2402:             $r->print(
                   2403:                 $indent.$icon.'&nbsp;'
                   2404:                .$treeinfo->{$id}->{name}
                   2405:                .($$allmaps{$mapid}!~/^uploaded/?' ['.$$allmaps{$mapid}.']':'')
                   2406:                .'</label>'
                   2407:                .'</td>'
                   2408:                .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2409:             );
1.461     neumanie 2410:         }
1.497     bisitz   2411: 
1.523     raeburn  2412:         $r->print(&Apache::loncommon::end_data_table().
                   2413:                   '<br style="line-height:2px;" />'.
                   2414:                   &Apache::loncommon::end_scrollbox());
1.209     www      2415:     }
                   2416: }
                   2417: 
1.563     damieng  2418: # Prints HTML to select the parameter level (resource, map/folder or course).
                   2419: # Used by table and overview modes.
                   2420: #
                   2421: # @param {Apache2::RequestRec} $r - the Apache request
                   2422: # @param {hash reference} $alllevs - all parameter levels, hash English title -> value
                   2423: # @param {string} $parmlev - selected level value (full|map|general), or ''
1.209     www      2424: sub levelmenu {
1.446     bisitz   2425:     my ($r,$alllevs,$parmlev)=@_;
                   2426: 
1.548     raeburn  2427:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameter Level').
                   2428:                                                 &Apache::loncommon::help_open_topic('Course_Parameter_Levels')));
1.474     amueller 2429:     $r->print('<select id="parmlev" name="parmlev" onchange="showHide_courseContent()">');
1.548     raeburn  2430:     foreach my $lev (reverse(sort(keys(%{$alllevs})))) {
                   2431:         $r->print('<option value="'.$$alllevs{$lev}.'"');
                   2432:         if ($parmlev eq $$alllevs{$lev}) {
                   2433:             $r->print(' selected="selected"');
                   2434:         }
                   2435:         $r->print('>'.&mt($lev).'</option>');
1.208     www      2436:     }
1.446     bisitz   2437:     $r->print("</select>");
1.208     www      2438: }
                   2439: 
1.211     www      2440: 
1.563     damieng  2441: # Returns HTML to select a section (with a select HTML element).
                   2442: # Used by overview mode.
                   2443: #
                   2444: # @param {array reference} $selectedsections - list of selected section ids
                   2445: # @returns {string}
1.211     www      2446: sub sectionmenu {
1.553     raeburn  2447:     my ($selectedsections)=@_;
1.300     albertel 2448:     my %sectionhash = &Apache::loncommon::get_sections();
1.553     raeburn  2449:     return '' if (!%sectionhash);
1.300     albertel 2450: 
1.552     raeburn  2451:     my (@possibles,$disabled);
                   2452:     if ($env{'request.course.sec'} ne '') {
                   2453:         @possibles = ($env{'request.course.sec'});
                   2454:         $selectedsections = [$env{'request.course.sec'}];
                   2455:         $disabled = ' disabled="disabled"';
                   2456:     } else {
                   2457:         @possibles = ('all',sort(keys(%sectionhash)));
                   2458:     }
1.553     raeburn  2459:     my $output = '<select name="Section" multiple="multiple" size="8"'.$disabled.'>';
1.552     raeburn  2460:     foreach my $s (@possibles) {
1.553     raeburn  2461:         $output .= '    <option value="'.$s.'"';
                   2462:         if ((@{$selectedsections}) && (grep(/^\Q$s\E$/,@{$selectedsections}))) {  
                   2463:             $output .= ' selected="selected"';
1.473     amueller 2464:         }
1.553     raeburn  2465:         $output .= '>'."$s</option>\n";
1.300     albertel 2466:     }
1.553     raeburn  2467:     $output .= "</select>\n";
                   2468:     return $output;
1.269     raeburn  2469: }
                   2470: 
1.563     damieng  2471: # Returns HTML to select a group (with a select HTML element).
                   2472: # Used by overview mode.
                   2473: #
                   2474: # @param {array reference} $selectedgroups - list of selected group names
                   2475: # @returns {string}
1.269     raeburn  2476: sub groupmenu {
1.553     raeburn  2477:     my ($selectedgroups)=@_;
                   2478:     my %grouphash;
                   2479:     if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2480:         %grouphash = &Apache::longroup::coursegroups();
                   2481:     } elsif ($env{'request.course.groups'} ne '') {
                   2482:          map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
                   2483:     }
                   2484:     return '' if (!%grouphash);
1.299     albertel 2485: 
1.553     raeburn  2486:     my $output = '<select name="Group" multiple="multiple" size="8">';
1.299     albertel 2487:     foreach my $group (sort(keys(%grouphash))) {
1.553     raeburn  2488:         $output .= '    <option value="'.$group.'"';
                   2489:         if ((@{$selectedgroups}) && (grep(/^\Q$group\E$/,\@{$selectedgroups}))) {
                   2490:             $output .=  ' selected="selected"';
1.473     amueller 2491:         }
1.553     raeburn  2492:         $output .= '>'."$group</option>\n";
1.211     www      2493:     }
1.553     raeburn  2494:     $output .= "</select>\n";
                   2495:     return $output;
1.211     www      2496: }
                   2497: 
1.563     damieng  2498: # Returns an array with the given parameter split by comma.
                   2499: # Used by assessparms (table mode).
                   2500: #
                   2501: # @param {string} $keyp - the string to split
                   2502: # @returns {Array<string>}
1.210     www      2503: sub keysplit {
                   2504:     my $keyp=shift;
                   2505:     return (split(/\,/,$keyp));
                   2506: }
                   2507: 
1.563     damieng  2508: # Returns the keys in $name, sorted using $keyorder.
                   2509: # Parameters are sorted by key, which means they are sorted by part first, then by name.
                   2510: # Used by assessparms (table mode) for resource level.
                   2511: #
                   2512: # @param {hash reference} $name - parameter key -> parameter name
                   2513: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2514: # @returns {Array<string>}
1.210     www      2515: sub keysinorder {
                   2516:     my ($name,$keyorder)=@_;
                   2517:     return sort {
1.560     damieng  2518:         $$keyorder{$a} <=> $$keyorder{$b};
1.548     raeburn  2519:     } (keys(%{$name}));
1.210     www      2520: }
                   2521: 
1.563     damieng  2522: # Returns the keys in $name, sorted using $keyorder to sort parameters by name first, then by part.
                   2523: # Used by assessparms (table mode) for map and general levels.
                   2524: #
                   2525: # @param {hash reference} $name - parameter key -> parameter name
                   2526: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2527: # @returns {Array<string>}
1.236     albertel 2528: sub keysinorder_bytype {
                   2529:     my ($name,$keyorder)=@_;
                   2530:     return sort {
1.563     damieng  2531:         my $ta=(split('_',$a))[-1]; # parameter name
1.560     damieng  2532:         my $tb=(split('_',$b))[-1];
                   2533:         if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
                   2534:             return ($a cmp $b);
                   2535:         }
                   2536:         $$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
1.548     raeburn  2537:     } (keys(%{$name}));
1.236     albertel 2538: }
                   2539: 
1.563     damieng  2540: # Returns the keys in $name, sorted using $keyorder to sort parameters by name.
                   2541: # Used by defaultsetter (parameter settings default actions).
                   2542: #
                   2543: # @param {hash reference} $name - hash parameter name -> parameter title
                   2544: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2545: # @returns {Array<string>}
1.211     www      2546: sub keysindisplayorder {
                   2547:     my ($name,$keyorder)=@_;
                   2548:     return sort {
1.560     damieng  2549:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
1.548     raeburn  2550:     } (keys(%{$name}));
1.211     www      2551: }
                   2552: 
1.563     damieng  2553: # Prints HTML with a choice to sort results by realm or student first.
                   2554: # Used by overview mode.
                   2555: #
                   2556: # @param {Apache2::RequestRec} $r - the Apache request
                   2557: # @param {string} $sortorder - realmstudent|studentrealm
1.214     www      2558: sub sortmenu {
                   2559:     my ($r,$sortorder)=@_;
1.236     albertel 2560:     $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214     www      2561:     if ($sortorder eq 'realmstudent') {
1.422     bisitz   2562:        $r->print(' checked="checked"');
1.214     www      2563:     }
                   2564:     $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236     albertel 2565:     $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214     www      2566:     if ($sortorder eq 'studentrealm') {
1.422     bisitz   2567:        $r->print(' checked="checked"');
1.214     www      2568:     }
1.236     albertel 2569:     $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
1.473     amueller 2570:           '</label>');
1.214     www      2571: }
                   2572: 
1.563     damieng  2573: # Returns a hash parameter key -> order (integer) giving the order for some parameters.
                   2574: #
                   2575: # @returns {hash}
1.211     www      2576: sub standardkeyorder {
                   2577:     return ('parameter_0_opendate' => 1,
1.473     amueller 2578:         'parameter_0_duedate' => 2,
                   2579:         'parameter_0_answerdate' => 3,
                   2580:         'parameter_0_interval' => 4,
                   2581:         'parameter_0_weight' => 5,
                   2582:         'parameter_0_maxtries' => 6,
                   2583:         'parameter_0_hinttries' => 7,
                   2584:         'parameter_0_contentopen' => 8,
                   2585:         'parameter_0_contentclose' => 9,
                   2586:         'parameter_0_type' => 10,
                   2587:         'parameter_0_problemstatus' => 11,
                   2588:         'parameter_0_hiddenresource' => 12,
                   2589:         'parameter_0_hiddenparts' => 13,
                   2590:         'parameter_0_display' => 14,
                   2591:         'parameter_0_ordered' => 15,
                   2592:         'parameter_0_tol' => 16,
                   2593:         'parameter_0_sig' => 17,
                   2594:         'parameter_0_turnoffunit' => 18,
1.521     raeburn  2595:         'parameter_0_discussend' => 19,
                   2596:         'parameter_0_discusshide' => 20,
                   2597:         'parameter_0_discussvote' => 21,
1.560     damieng  2598:         'parameter_0_printstartdate'  =>  22,
                   2599:         'parameter_0_printenddate' =>  23);
1.211     www      2600: }
                   2601: 
1.59      matthew  2602: 
1.560     damieng  2603: # Table mode UI.
1.563     damieng  2604: # If nothing is selected, prints HTML forms to select resources, parts, parameters, user, group and section.
                   2605: # Otherwise, prints the parameter table, with a link to change the selection unless a single resource is selected.
                   2606: #
                   2607: # Parameters used from the request:
                   2608: # action - handler action (see handler), usermenu is checking for value 'settable'
                   2609: # cgroup - selected group
                   2610: # command - 'set': direct access to table mode for a resource
                   2611: # csec - selected section
                   2612: # dis - set when the "Update Display" button was used, used only to discard command 'set'
                   2613: # hideparmsel - can be 'hidden' to hide the parameter selection div initially and display the "Change Parameter Selection" link instead (which displays the div)
                   2614: # id - student/employee ID
                   2615: # parmlev - selected level (full|map|general)
                   2616: # part - selected part (unused ?)
                   2617: # pres_marker - &&&-separated parameter identifiers, "resource id&part_parameter name&level"
                   2618: # pres_type - &&&-separated parameter types
                   2619: # pres_value - &&&-separated parameter values
                   2620: # prevvisit - '1' if the user has submitted the form before
                   2621: # pscat (multiple values) - selected parameter names
                   2622: # pschp - selected map id, or 'all'
                   2623: # psprt (multiple values) - list of selected parameter parts
                   2624: # filter - part of or whole parameter name, to be filtered out when parameters are displayed (unused ?)
                   2625: # recent_* (* = parameter type) - recent values entered by the user for parameter types
                   2626: # symb - resource symb (when a single resource is selected)
                   2627: # udom - selected user domain
                   2628: # uname - selected user name
                   2629: # url - used only with command 'set', the resource url
                   2630: #
                   2631: # @param {Apache2::RequestRec} $r - the Apache request
1.30      www      2632: sub assessparms {
1.1       www      2633: 
1.43      albertel 2634:     my $r=shift;
1.201     www      2635: 
1.512     foxr     2636: 
                   2637: # -------------------------------------------------------- Variable declaration
1.563     damieng  2638:     my @ids=(); # resource ids
                   2639:     my %symbp=(); # hash map id or resource id -> map src.'___(all)' for a map or resource symb for a resource
                   2640:     my %mapp=(); # hash resource id -> enclosing map src
                   2641:     my %typep=(); # hash resource id (from big hash) -> resource type (file extension)
                   2642:     my %keyp=(); # hash resource id -> comma-separated list of parameter keys
                   2643:     my %uris=(); # hash resource id -> resource src
                   2644:     my %maptitles=(); # hash map id or src -> map title
                   2645:     my %allmaps=(); # hash map id (from big hash) -> map src
                   2646:     my %alllevs=(); # hash English level title -> value
                   2647: 
                   2648:     my $uname; # selected user name
                   2649:     my $udom; # selected user domain
                   2650:     my $uhome; # server with the user's files, or 'no_host'
                   2651:     my $csec; # selected section name
                   2652:     my $cgroup; # selected group name
                   2653:     my @usersgroups = (); # list of the user groups
1.446     bisitz   2654: 
1.190     albertel 2655:     my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187     www      2656: 
1.57      albertel 2657:     $alllevs{'Resource Level'}='full';
1.215     www      2658:     $alllevs{'Map/Folder Level'}='map';
1.57      albertel 2659:     $alllevs{'Course Level'}='general';
                   2660: 
1.563     damieng  2661:     my %allparms; # hash parameter name -> parameter title
                   2662:     my %allparts; # hash parameter part -> part title
1.512     foxr     2663: # ------------------------------------------------------------------------------
                   2664: 
1.210     www      2665: #
                   2666: # Order in which these parameters will be displayed
                   2667: #
1.211     www      2668:     my %keyorder=&standardkeyorder();
                   2669: 
1.512     foxr     2670: #    @ids=();
                   2671: #    %symbp=();       # These seem defined above already.
                   2672: #    %typep=();
1.43      albertel 2673: 
                   2674:     my $message='';
                   2675: 
1.190     albertel 2676:     $csec=$env{'form.csec'};
1.552     raeburn  2677:     if ($env{'request.course.sec'} ne '') {
                   2678:         $csec = $env{'request.course.sec'};    
                   2679:     }
                   2680: 
1.553     raeburn  2681: # Check group privs.
1.269     raeburn  2682:     $cgroup=$env{'form.cgroup'};
1.553     raeburn  2683:     my $noeditgrp; 
                   2684:     if ($cgroup ne '') {
                   2685:         unless (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2686:             if (($env{'request.course.groups'} eq '') || 
                   2687:                 (!grep(/^\Q$cgroup\E$/,split(/,/,$env{'request.course.groups'})))) {
                   2688:                 $noeditgrp = 1;
                   2689:             }
                   2690:         }
                   2691:     }
1.188     www      2692: 
1.190     albertel 2693:     if      ($udom=$env{'form.udom'}) {
                   2694:     } elsif ($udom=$env{'request.role.domain'}) {
                   2695:     } elsif ($udom=$env{'user.domain'}) {
1.172     albertel 2696:     } else {
1.473     amueller 2697:         $udom=$r->dir_config('lonDefDomain');
1.172     albertel 2698:     }
1.468     amueller 2699:     
1.43      albertel 2700: 
1.134     albertel 2701:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190     albertel 2702:     my $pschp=$env{'form.pschp'};
1.506     www      2703: 
                   2704: 
1.134     albertel 2705:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      2706:     if (!@psprt) { $psprt[0]='all'; }
1.506     www      2707:     if (($env{'form.part'}) && ($psprt[0] ne 'all')) { $psprt[0]=$env{'form.part'}; }
1.57      albertel 2708: 
1.43      albertel 2709:     my $pssymb='';
1.57      albertel 2710:     my $parmlev='';
1.446     bisitz   2711: 
1.190     albertel 2712:     unless ($env{'form.parmlev'}) {
1.57      albertel 2713:         $parmlev = 'map';
                   2714:     } else {
1.190     albertel 2715:         $parmlev = $env{'form.parmlev'};
1.57      albertel 2716:     }
1.26      www      2717: 
1.29      www      2718: # ----------------------------------------------- Was this started from grades?
                   2719: 
1.560     damieng  2720:     if (($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   2721:             (!$env{'form.dis'})) {
1.473     amueller 2722:         my $url=$env{'form.url'};
                   2723:         $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                   2724:         $pssymb=&Apache::lonnet::symbread($url);
                   2725:         if (!@pscat) { @pscat=('all'); }
                   2726:         $pschp='';
1.57      albertel 2727:         $parmlev = 'full';
1.190     albertel 2728:     } elsif ($env{'form.symb'}) {
1.473     amueller 2729:         $pssymb=$env{'form.symb'};
                   2730:         if (!@pscat) { @pscat=('all'); }
                   2731:         $pschp='';
1.57      albertel 2732:         $parmlev = 'full';
1.43      albertel 2733:     } else {
1.473     amueller 2734:         $env{'form.url'}='';
1.43      albertel 2735:     }
                   2736: 
1.190     albertel 2737:     my $id=$env{'form.id'};
1.43      albertel 2738:     if (($id) && ($udom)) {
1.555     raeburn  2739:         $uname=(&Apache::lonnet::idget($udom,[$id],'ids'))[1];
1.473     amueller 2740:         if ($uname) {
                   2741:             $id='';
                   2742:         } else {
                   2743:             $message=
1.540     bisitz   2744:                 '<p class="LC_warning">'.
                   2745:                 &mt('Unknown ID [_1] at domain [_2]',
                   2746:                     "'".$id."'","'".$udom."'").
                   2747:                 '</p>';
1.473     amueller 2748:         }
1.43      albertel 2749:     } else {
1.473     amueller 2750:         $uname=$env{'form.uname'};
1.43      albertel 2751:     }
                   2752:     unless ($udom) { $uname=''; }
                   2753:     $uhome='';
                   2754:     if ($uname) {
1.473     amueller 2755:         $uhome=&Apache::lonnet::homeserver($uname,$udom);
1.43      albertel 2756:         if ($uhome eq 'no_host') {
1.473     amueller 2757:             $message=
1.540     bisitz   2758:                 '<p class="LC_warning">'.
                   2759:                 &mt('Unknown user [_1] at domain [_2]',
                   2760:                     "'".$uname."'","'".$udom."'").
                   2761:                 '</p>';
1.473     amueller 2762:             $uname='';
1.12      www      2763:         } else {
1.473     amueller 2764:             $csec=&Apache::lonnet::getsection($udom,$uname,
                   2765:                           $env{'request.course.id'});
                   2766:             if ($csec eq '-1') {
1.540     bisitz   2767:                 $message=
                   2768:                     '<p class="LC_warning">'.
                   2769:                     &mt('User [_1] at domain [_2] not in this course',
                   2770:                         "'".$uname."'","'".$udom."'").
                   2771:                     '</p>';
1.473     amueller 2772:                 $uname='';
                   2773:                 $csec=$env{'form.csec'};
1.269     raeburn  2774:                 $cgroup=$env{'form.cgroup'};
1.473     amueller 2775:             } else {
                   2776:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   2777:                   ('firstname','middlename','lastname','generation','id'));
                   2778:                 $message="\n<p>\n".&mt("Full Name").": ".
                   2779:                 $name{'firstname'}.' '.$name{'middlename'}.' '
                   2780:                 .$name{'lastname'}.' '.$name{'generation'}.
1.501     bisitz   2781:                 "<br />\n".&mt('Student/Employee ID').": ".$name{'id'}.'<p>';
1.473     amueller 2782:             }
1.297     raeburn  2783:             @usersgroups = &Apache::lonnet::get_users_groups(
1.275     raeburn  2784:                                        $udom,$uname,$env{'request.course.id'});
1.297     raeburn  2785:             if (@usersgroups > 0) {
1.306     albertel 2786:                 unless (grep(/^\Q$cgroup\E$/,@usersgroups)) {
1.275     raeburn  2787:                     $cgroup = $usersgroups[0];
1.297     raeburn  2788:                 }
1.269     raeburn  2789:             }
1.12      www      2790:         }
1.43      albertel 2791:     }
1.2       www      2792: 
1.43      albertel 2793:     unless ($csec) { $csec=''; }
1.269     raeburn  2794:     unless ($cgroup) { $cgroup=''; }
1.12      www      2795: 
1.14      www      2796: # --------------------------------------------------------- Get all assessments
1.446     bisitz   2797:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 2798:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   2799:                 \%keyorder);
1.63      bowersj2 2800: 
1.57      albertel 2801:     $mapp{'0.0'} = '';
                   2802:     $symbp{'0.0'} = '';
1.99      albertel 2803: 
1.14      www      2804: # ---------------------------------------------------------- Anything to store?
1.190     albertel 2805:     if ($env{'form.pres_marker'}) {
1.205     www      2806:         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
                   2807:         my @values=split(/\&\&\&/,$env{'form.pres_value'});
                   2808:         my @types=split(/\&\&\&/,$env{'form.pres_type'});
1.500     raeburn  2809:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2810:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.504     raeburn  2811:         my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   2812:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   2813:         my $totalstored = 0;
1.546     raeburn  2814:         my $now = time;
1.473     amueller 2815:         for (my $i=0;$i<=$#markers;$i++) {
1.557     raeburn  2816:             my ($needsrelease,$needsnewer,$name,$namematch);
1.556     raeburn  2817:             if (($env{'request.course.sec'} ne '') && ($markers[$i] =~ /\&(9|10|11|12)$/)) {
1.552     raeburn  2818:                 next if ($csec ne $env{'request.course.sec'});
                   2819:             }
1.556     raeburn  2820:             if ($markers[$i] =~ /\&(8|7|6|5)$/) {
1.553     raeburn  2821:                 next if ($noeditgrp);
1.557     raeburn  2822:             }
                   2823:             if ($markers[$i] =~ /\&(17|11|7|3)$/) {
                   2824:                 $namematch = 'maplevelrecurse';
                   2825:             }
1.556     raeburn  2826:             if ($markers[$i] =~ /^[\d.]+\&0_availablestudent\&(1|2|3|4)$/) {
1.437     raeburn  2827:                 my (@ok_slots,@fail_slots,@del_slots);
                   2828:                 my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
                   2829:                 my ($level,@all) =
                   2830:                     &parmval_by_symb('0.availablestudent',$pssymb,'',$uname,$udom,
                   2831:                                      $csec,$cgroup,$courseopt);
                   2832:                 foreach my $slot_name (split(/:/,$values[$i])) {
                   2833:                     next if ($slot_name eq '');
                   2834:                     if (&update_slots($slot_name,$cdom,$cnum,$pssymb,$uname,$udom) eq 'ok') {
                   2835:                         push(@ok_slots,$slot_name);
                   2836: 
                   2837:                     } else {
                   2838:                         push(@fail_slots,$slot_name);
                   2839:                     }
                   2840:                 }
                   2841:                 if (@ok_slots) {
                   2842:                     $values[$i] = join(':',@ok_slots);
                   2843:                 } else {
                   2844:                     $values[$i] = '';
                   2845:                 }
                   2846:                 if ($all[$level] ne '') {
                   2847:                     my @existing = split(/:/,$all[$level]);
                   2848:                     foreach my $slot_name (@existing) {
                   2849:                         if (!grep(/^\Q$slot_name\E$/,split(/:/,$values[$i]))) {
                   2850:                             if (&delete_slots($slot_name,$cdom,$cnum,$uname,$udom,$pssymb) eq 'ok') {
                   2851:                                 push(@del_slots,$slot_name);
                   2852:                             }
                   2853:                         }
                   2854:                     }
                   2855:                 }
1.554     raeburn  2856:             } elsif ($markers[$i] =~ /_(type|lenient|retrypartial|discussvote|examcode|printstartdate|printenddate|acc|interval)\&\d+$/) {
1.514     raeburn  2857:                 $name = $1;
1.533     raeburn  2858:                 my $val = $values[$i];
1.549     raeburn  2859:                 my $valmatch = '';
1.533     raeburn  2860:                 if ($name eq 'examcode') {
1.544     raeburn  2861:                     if (&Apache::lonnet::validCODE($values[$i])) {
                   2862:                         $val = 'valid';
                   2863:                     }
1.546     raeburn  2864:                 } elsif ($name eq 'printstartdate') {
                   2865:                     if ($val =~ /^\d+$/) {
                   2866:                         if ($val > $now) {
                   2867:                             $val = 'future';
                   2868:                         }
                   2869:                     } 
                   2870:                 } elsif ($name eq 'printenddate') {
                   2871:                     if ($val =~ /^\d+$/) {
                   2872:                         if ($val < $now) {
                   2873:                             $val = 'past';
                   2874:                         }
                   2875:                     }
1.549     raeburn  2876:                 } elsif (($name eq 'lenient') || ($name eq 'acc')) {
                   2877:                     my $stringtype = &get_stringtype($name);
                   2878:                     my $stringmatch = &standard_string_matches($stringtype);
                   2879:                     if (ref($stringmatch) eq 'ARRAY') {
                   2880:                         foreach my $item (@{$stringmatch}) {
                   2881:                             if (ref($item) eq 'ARRAY') {
                   2882:                                 my ($regexpname,$pattern) = @{$item};
                   2883:                                 if ($pattern ne '') {
                   2884:                                     if ($val =~ /$pattern/) {
                   2885:                                         $valmatch = $regexpname;
                   2886:                                         $val = '';
                   2887:                                         last;
                   2888:                                     }
                   2889:                                 }
                   2890:                             }
                   2891:                         }
                   2892:                     }
1.554     raeburn  2893:                 } elsif ($name eq 'interval') {
                   2894:                     my $intervaltype = &get_intervaltype($name);
                   2895:                     my $intervalmatch = &standard_interval_matches($intervaltype);
                   2896:                     if (ref($intervalmatch) eq 'ARRAY') {
                   2897:                         foreach my $item (@{$intervalmatch}) {
                   2898:                             if (ref($item) eq 'ARRAY') {
                   2899:                                 my ($regexpname,$pattern) = @{$item};
                   2900:                                 if ($pattern ne '') {
                   2901:                                     if ($val =~ /$pattern/) {
                   2902:                                         $valmatch = $regexpname;
                   2903:                                         $val = '';
                   2904:                                         last;
                   2905:                                     }
                   2906:                                 }
                   2907:                             }
                   2908:                         }
                   2909:                     }
1.533     raeburn  2910:                 }
1.504     raeburn  2911:                 $needsrelease =
1.557     raeburn  2912:                     $Apache::lonnet::needsrelease{"parameter:$name:$val:$valmatch:"};
1.504     raeburn  2913:                 if ($needsrelease) {
1.505     raeburn  2914:                     unless ($got_chostname) {
1.514     raeburn  2915:                         ($chostname,$cmajor,$cminor) = &parameter_release_vars();
1.504     raeburn  2916:                         $got_chostname = 1;
1.546     raeburn  2917:                     } 
1.557     raeburn  2918:                     $needsnewer = &parameter_releasecheck($name,$val,$valmatch,undef,
1.514     raeburn  2919:                                                           $needsrelease,
                   2920:                                                           $cmajor,$cminor);
1.500     raeburn  2921:                 }
1.437     raeburn  2922:             }
1.504     raeburn  2923:             if ($needsnewer) {
1.557     raeburn  2924:                 undef($namematch);
                   2925:             } else {
                   2926:                 my $currneeded;
                   2927:                 if ($needsrelease) {
                   2928:                     $currneeded = $needsrelease;
                   2929:                 }
                   2930:                 if ($namematch) {
                   2931:                     $needsrelease =
                   2932:                         $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   2933:                     if (($needsrelease) && (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   2934:                         unless ($got_chostname) {
                   2935:                             ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   2936:                             $got_chostname = 1;
                   2937:                         }
                   2938:                         $needsnewer = &parameter_releasecheck(undef,undef,undef,$namematch,
                   2939:                                                               $needsrelease,
                   2940:                                                               $cmajor,$cminor);
                   2941:                     } else {
                   2942:                         undef($namematch);
                   2943:                     }
                   2944:                 }
                   2945:             }
                   2946:             if ($needsnewer) {
                   2947:                 $message .= &oldversion_warning($name,$namematch,$values[$i],$chostname,$cmajor,
1.504     raeburn  2948:                                                 $cminor,$needsrelease);
                   2949:             } else {
                   2950:                 $message.=&storeparm(split(/\&/,$markers[$i]),
                   2951:                                      $values[$i],
                   2952:                                      $types[$i],
                   2953:                                      $uname,$udom,$csec,$cgroup);
                   2954:                 $totalstored ++;
                   2955:             }
1.473     amueller 2956:         }
1.68      www      2957: # ---------------------------------------------------------------- Done storing
1.504     raeburn  2958:         if ($totalstored) {
                   2959:             $message.='<p class="LC_warning">'
                   2960:                      .&mt('Changes can take up to 10 minutes before being active for all students.')
                   2961:                      .&Apache::loncommon::help_open_topic('Caching')
                   2962:                      .'</p>';
                   2963:         }
1.68      www      2964:     }
1.57      albertel 2965: #----------------------------------------------- if all selected, fill in array
1.563     damieng  2966:     if ($pscat[0] eq "all") {
                   2967:         @pscat = (keys(%allparms));
                   2968:     }
                   2969:     if (!@pscat) {
                   2970:         @pscat=('duedate','opendate','answerdate','weight','maxtries','type','problemstatus')
                   2971:     };
                   2972:     if ($psprt[0] eq "all" || !@psprt) {
                   2973:         @psprt = (keys(%allparts));
                   2974:     }
1.2       www      2975: # ------------------------------------------------------------------ Start page
1.63      bowersj2 2976: 
1.531     raeburn  2977:     my $crstype = &Apache::loncommon::course_type();
                   2978:     &startpage($r,$pssymb,$crstype);
1.57      albertel 2979: 
1.548     raeburn  2980:     foreach my $item ('tolerance','date_default','date_start','date_end',
1.563     damieng  2981:             'date_interval','int','float','string') {
1.473     amueller 2982:         $r->print('<input type="hidden" value="'.
1.563     damieng  2983:             &HTML::Entities::encode($env{'form.recent_'.$item},'"&<>').
                   2984:             '" name="recent_'.$item.'" />');
1.44      albertel 2985:     }
1.446     bisitz   2986: 
1.459     bisitz   2987:     # ----- Start Parameter Selection
                   2988: 
                   2989:     # Hide parm selection?
                   2990:     $r->print(<<ENDPARMSELSCRIPT);
                   2991: <script type="text/javascript">
                   2992: // <![CDATA[
                   2993: function parmsel_show() {
1.562     damieng  2994:     document.getElementById('parmsel').style.display = "";
                   2995:     document.getElementById('parmsellink').style.display = "none";
1.459     bisitz   2996: }
                   2997: // ]]>
                   2998: </script>
                   2999: ENDPARMSELSCRIPT
1.474     amueller 3000:     
1.445     neumanie 3001:     if (!$pssymb) {
1.563     damieng  3002:         # No single resource selected, print forms to select things (hidden after first selection)
1.486     www      3003:         my $parmselhiddenstyle=' style="display:none"';
                   3004:         if($env{'form.hideparmsel'} eq 'hidden') {
                   3005:            $r->print('<div id="parmsel"'.$parmselhiddenstyle.'>');
                   3006:         } else  {
                   3007:            $r->print('<div id="parmsel">');
                   3008:         }
                   3009: 
1.491     bisitz   3010:         # Step 1
1.523     raeburn  3011:         $r->print(&Apache::lonhtmlcommon::topic_bar(1,&mt('Resource Specification'),'parmstep1'));
                   3012:         $r->print('
1.474     amueller 3013: <script type="text/javascript">
1.523     raeburn  3014: // <![CDATA['.
                   3015:                  &showhide_js().'
1.474     amueller 3016: // ]]>
                   3017: </script>
1.523     raeburn  3018: ');
                   3019:         $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.209     www      3020:         &levelmenu($r,\%alllevs,$parmlev);
1.491     bisitz   3021:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.474     amueller 3022:         &mapmenu($r,\%allmaps,$pschp,\%maptitles, \%symbp);
1.491     bisitz   3023:         $r->print(&Apache::lonhtmlcommon::row_closure());
                   3024:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
                   3025:         &partmenu($r,\%allparts,\@psprt);
1.474     amueller 3026:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3027:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3028: 
                   3029:         # Step 2
1.523     raeburn  3030:         $r->print(&Apache::lonhtmlcommon::topic_bar(2,&mt('Parameter Specification'),'parmstep2'));
1.536     raeburn  3031:         &displaymenu($r,\%allparms,\@pscat,\@psprt,\%keyorder,'parmmenuscroll');
1.491     bisitz   3032: 
                   3033:         # Step 3
1.523     raeburn  3034:         $r->print(&Apache::lonhtmlcommon::topic_bar(3,&mt('User Specification (optional)'),'parmstep3'));
1.486     www      3035:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3036:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3037:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3038:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3039: 
                   3040:         # Update Display Button
1.486     www      3041:         $r->print('<p>'
                   3042:              .'<input type="submit" name="dis"'
1.511     www      3043:              .' value="'.&mt('Update Display').'" />'
1.486     www      3044:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
                   3045:              .'</p>');
                   3046:         $r->print('</div>');
1.491     bisitz   3047: 
1.486     www      3048:         # Offer link to display parameter selection again
                   3049:         $r->print('<p id="parmsellink"');
                   3050:         if ($env{'form.hideparmsel'} ne 'hidden') {
                   3051:            $r->print($parmselhiddenstyle);
                   3052:         }
                   3053:         $r->print('>'
                   3054:              .'<a href="javascript:parmsel_show()">'
                   3055:              .&mt('Change Parameter Selection')
                   3056:              .'</a>'
                   3057:              .'</p>');
1.44      albertel 3058:     } else {
1.478     amueller 3059:         # parameter screen for a single resource. 
1.486     www      3060:         my ($map,$iid,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.473     amueller 3061:         my $title = &Apache::lonnet::gettitle($pssymb);
1.501     bisitz   3062:         $r->print(&mt('Specific Resource: [_1] ([_2])',
                   3063:                          $title,'<span class="LC_filename">'.$resource.'</span>').
1.472     amueller 3064:                 '<input type="hidden" value="'.$pssymb.'" name="symb" />'.
1.486     www      3065:                   '<br />');
                   3066:         $r->print(&Apache::lonhtmlcommon::topic_bar('',&mt('Additional Display Specification (optional)')));
                   3067:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3068:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3069:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3070:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3071:         $r->print('<p>'
1.459     bisitz   3072:              .'<input type="submit" name="dis"'
1.511     www      3073:              .' value="'.&mt('Update Display').'" />'
1.459     bisitz   3074:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
1.486     www      3075:              .'</p>');
1.459     bisitz   3076:     }
1.478     amueller 3077:     
1.486     www      3078:     # ----- End Parameter Selection
1.57      albertel 3079: 
1.459     bisitz   3080:     # Display Messages
                   3081:     $r->print('<div>'.$message.'</div>');
1.210     www      3082: 
1.57      albertel 3083: 
                   3084:     my @temp_pscat;
                   3085:     map {
                   3086:         my $cat = $_;
                   3087:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   3088:     } @pscat;
                   3089: 
                   3090:     @pscat = @temp_pscat;
                   3091: 
1.548     raeburn  3092: 
1.209     www      3093:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      3094: # ----------------------------------------------------------------- Start Table
1.57      albertel 3095:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 3096:         my $csuname=$env{'user.name'};
                   3097:         my $csudom=$env{'user.domain'};
1.57      albertel 3098: 
1.203     www      3099:         if ($parmlev eq 'full') {
1.506     www      3100: #
                   3101: # This produces the cascading table output of parameters
                   3102: #
1.560     damieng  3103:             my $coursespan=$csec?10:6;
                   3104:             my $userspan=4;
                   3105:             if ($cgroup ne '') {
                   3106:                 $coursespan += 4;
                   3107:             }
1.473     amueller 3108: 
1.560     damieng  3109:             $r->print(&Apache::loncommon::start_data_table());
                   3110:             #
                   3111:             # This produces the headers
                   3112:             #
                   3113:             $r->print('<tr><td colspan="5"></td>');
                   3114:             $r->print('<th colspan="'.($coursespan).'">'.&mt('Any User').'</th>');
                   3115:             if ($uname) {
1.473     amueller 3116:                 if (@usersgroups > 1) {
1.560     damieng  3117:                     $userspan ++;
                   3118:                 }
                   3119:                 $r->print('<th colspan="'.$userspan.'" rowspan="2">');
                   3120:                 $r->print(&mt('User [_1] at Domain [_2]',"'".$uname."'","'".$udom."'").'</th>');
                   3121:             }
                   3122:             my %lt=&Apache::lonlocal::texthash(
1.473     amueller 3123:                 'pie'    => "Parameter in Effect",
                   3124:                 'csv'    => "Current Session Value",
1.472     amueller 3125:                 'rl'     => "Resource Level",
1.473     amueller 3126:                 'ic'     => 'in Course',
                   3127:                 'aut'    => "Assessment URL and Title",
                   3128:                 'type'   => 'Type',
                   3129:                 'emof'   => "Enclosing Map or Folder",
                   3130:                 'part'   => 'Part',
1.472     amueller 3131:                 'pn'     => 'Parameter Name',
1.473     amueller 3132:                 'def'    => 'default',
                   3133:                 'femof'  => 'from Enclosing Map or Folder',
                   3134:                 'gen'    => 'general',
                   3135:                 'foremf' => 'for Enclosing Map or Folder',
1.556     raeburn  3136:                 'formfr' => 'for Map or Folder (recursive)',
1.473     amueller 3137:                 'fr'     => 'for Resource'
                   3138:             );
1.560     damieng  3139:             $r->print(<<ENDTABLETWO);
1.419     bisitz   3140: <th rowspan="3">$lt{'pie'}</th>
1.501     bisitz   3141: <th rowspan="3">$lt{'csv'}<br />($csuname:$csudom)</th>
1.556     raeburn  3142: </tr><tr><td colspan="5"></td><th colspan="3">$lt{'ic'}</th><th colspan="2">$lt{'rl'}</th>
1.419     bisitz   3143: <th colspan="1">$lt{'ic'}</th>
1.182     albertel 3144: 
1.10      www      3145: ENDTABLETWO
1.560     damieng  3146:             if ($csec) {
                   3147:                 $r->print('<th colspan="4">'.
                   3148:                 &mt("in Section")." $csec</th>");
                   3149:             }
                   3150:             if ($cgroup) {
1.556     raeburn  3151:                 $r->print('<th colspan="4">'.
1.472     amueller 3152:                 &mt("in Group")." $cgroup</th>");
1.560     damieng  3153:             }
                   3154:             $r->print(<<ENDTABLEHEADFOUR);
1.133     www      3155: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   3156: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.556     raeburn  3157: <th>$lt{'gen'}</th><th>$lt{'formfr'}</th><th>$lt{'foremf'}</th>
1.192     albertel 3158: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      3159: ENDTABLEHEADFOUR
1.57      albertel 3160: 
1.560     damieng  3161:             if ($csec) {
                   3162:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'formfr'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
                   3163:             }
1.473     amueller 3164: 
1.560     damieng  3165:             if ($cgroup) {
                   3166:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'formfr'}.'</th><th>'.&mt('foremf').'</th><th>'.$lt{'fr'}.'</th>');
                   3167:             }
                   3168: 
                   3169:             if ($uname) {
                   3170:                 if (@usersgroups > 1) {
                   3171:                     $r->print('<th>'.&mt('Control by other group?').'</th>');
                   3172:                 }
                   3173:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'formfr'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
                   3174:             }
                   3175: 
                   3176:             $r->print('</tr>');
1.506     www      3177: #
                   3178: # Done with the headers
                   3179: # 
1.560     damieng  3180:             my $defbgone='';
                   3181:             my $defbgtwo='';
                   3182:             my $defbgthree = '';
1.57      albertel 3183: 
1.560     damieng  3184:             foreach my $rid (@ids) {
1.57      albertel 3185: 
                   3186:                 my ($inmapid)=($rid=~/\.(\d+)$/);
                   3187: 
1.446     bisitz   3188:                 if ((!$pssymb &&
1.560     damieng  3189:                         (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   3190:                         ||
                   3191:                         ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      3192: # ------------------------------------------------------ Entry for one resource
1.473     amueller 3193:                     if ($defbgone eq '#E0E099') {
                   3194:                         $defbgone='#E0E0DD';
1.57      albertel 3195:                     } else {
1.419     bisitz   3196:                         $defbgone='#E0E099';
1.57      albertel 3197:                     }
1.419     bisitz   3198:                     if ($defbgtwo eq '#FFFF99') {
1.473     amueller 3199:                         $defbgtwo='#FFFFDD';
1.57      albertel 3200:                     } else {
1.473     amueller 3201:                         $defbgtwo='#FFFF99';
1.57      albertel 3202:                     }
1.419     bisitz   3203:                     if ($defbgthree eq '#FFBB99') {
                   3204:                         $defbgthree='#FFBBDD';
1.269     raeburn  3205:                     } else {
1.419     bisitz   3206:                         $defbgthree='#FFBB99';
1.269     raeburn  3207:                     }
                   3208: 
1.57      albertel 3209:                     my $thistitle='';
                   3210:                     my %name=   ();
                   3211:                     undef %name;
                   3212:                     my %part=   ();
                   3213:                     my %display=();
                   3214:                     my %type=   ();
                   3215:                     my %default=();
1.196     www      3216:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 3217: 
1.506     www      3218:                     my $filter=$env{'form.filter'};
1.548     raeburn  3219:                     foreach my $tempkeyp (&keysplit($keyp{$rid})) {
1.57      albertel 3220:                         if (grep $_ eq $tempkeyp, @catmarker) {
1.560     damieng  3221:                             my $parmname=&Apache::lonnet::metadata($uri,$tempkeyp.'.name');
                   3222:     # We may only want certain parameters listed
                   3223:                             if ($filter) {
                   3224:                                 unless ($filter=~/\Q$parmname\E/) { next; }
                   3225:                             }
                   3226:                             $name{$tempkeyp}=$parmname;
                   3227:                             $part{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.part');
                   3228: 
                   3229:                             my $parmdis=&Apache::lonnet::metadata($uri,$tempkeyp.'.display');
                   3230:                             if ($allparms{$name{$tempkeyp}} ne '') {
                   3231:                                 my $identifier;
                   3232:                                 if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3233:                                     $identifier = $1;
                   3234:                                 }
                   3235:                                 $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3236:                             } else {
                   3237:                                 $display{$tempkeyp} = $parmdis;
                   3238:                             }
                   3239:                             unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3240:                             $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3241:                             $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp);
                   3242:                             $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.type');
                   3243:                             $thistitle=&Apache::lonnet::metadata($uri,$tempkeyp.'.title');
1.57      albertel 3244:                         }
                   3245:                     }
1.548     raeburn  3246:                     my $totalparms=scalar(keys(%name));
1.57      albertel 3247:                     if ($totalparms>0) {
1.560     damieng  3248:                         my $firstrow=1;
1.473     amueller 3249:                         my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.419     bisitz   3250:                         $r->print('<tr><td style="background-color:'.$defbgone.';"'.
1.57      albertel 3251:                              ' rowspan='.$totalparms.
1.419     bisitz   3252:                              '><tt><font size="-1">'.
1.57      albertel 3253:                              join(' / ',split(/\//,$uri)).
                   3254:                              '</font></tt><p><b>'.
1.154     albertel 3255:                              "<a href=\"javascript:openWindow('".
1.473     amueller 3256:                           &Apache::lonnet::clutter($uri).'?symb='.
                   3257:                           &escape($symbp{$rid}).
1.336     albertel 3258:                              "', 'metadatafile', '450', '500', 'no', 'yes');\"".
                   3259:                              " target=\"_self\">$title");
1.57      albertel 3260: 
                   3261:                         if ($thistitle) {
1.473     amueller 3262:                             $r->print(' ('.$thistitle.')');
1.57      albertel 3263:                         }
                   3264:                         $r->print('</a></b></td>');
1.419     bisitz   3265:                         $r->print('<td style="background-color:'.$defbgtwo.';"'.
1.57      albertel 3266:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   3267:                                       '</td>');
                   3268: 
1.419     bisitz   3269:                         $r->print('<td style="background-color:'.$defbgone.';"'.
1.57      albertel 3270:                                       ' rowspan='.$totalparms.
1.238     www      3271:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.548     raeburn  3272:                         foreach my $item (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 3273:                             unless ($firstrow) {
                   3274:                                 $r->print('<tr>');
                   3275:                             } else {
                   3276:                                 undef $firstrow;
                   3277:                             }
1.548     raeburn  3278:                             &print_row($r,$item,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 3279:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  3280:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.553     raeburn  3281:                                        $cgroup,\@usersgroups,$noeditgrp);
1.57      albertel 3282:                         }
                   3283:                     }
                   3284:                 }
                   3285:             } # end foreach ids
1.43      albertel 3286: # -------------------------------------------------- End entry for one resource
1.517     www      3287:             $r->print(&Apache::loncommon::end_data_table);
1.203     www      3288:         } # end of  full
1.57      albertel 3289: #--------------------------------------------------- Entry for parm level map
                   3290:         if ($parmlev eq 'map') {
1.419     bisitz   3291:             my $defbgone = '#E0E099';
                   3292:             my $defbgtwo = '#FFFF99';
                   3293:             my $defbgthree = '#FFBB99';
1.57      albertel 3294: 
                   3295:             my %maplist;
                   3296: 
                   3297:             if ($pschp eq 'all') {
1.446     bisitz   3298:                 %maplist = %allmaps;
1.57      albertel 3299:             } else {
                   3300:                 %maplist = ($pschp => $mapp{$pschp});
                   3301:             }
                   3302: 
                   3303: #-------------------------------------------- for each map, gather information
                   3304:             my $mapid;
1.560     damieng  3305:             foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys(%maplist)) {
1.60      albertel 3306:                 my $maptitle = $maplist{$mapid};
1.57      albertel 3307: 
                   3308: #-----------------------  loop through ids and get all parameter types for map
                   3309: #-----------------------------------------          and associated information
                   3310:                 my %name = ();
                   3311:                 my %part = ();
                   3312:                 my %display = ();
                   3313:                 my %type = ();
                   3314:                 my %default = ();
                   3315:                 my $map = 0;
                   3316: 
1.473     amueller 3317: #        $r->print("Catmarker: @catmarker<br />\n");
1.446     bisitz   3318: 
1.548     raeburn  3319:                 foreach my $id (@ids) {
                   3320:                     ($map)=($id =~ /([\d]*?)\./);
                   3321:                     my $rid = $id;
1.446     bisitz   3322: 
1.57      albertel 3323: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   3324: 
1.560     damieng  3325:                     if ($map eq $mapid) {
1.473     amueller 3326:                         my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 3327: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   3328: 
                   3329: #--------------------------------------------------------------------
                   3330: # @catmarker contains list of all possible parameters including part #s
                   3331: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3332: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3333: # When storing information, store as part 0
                   3334: # When requesting information, request from full part
                   3335: #-------------------------------------------------------------------
1.548     raeburn  3336:                         foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3337:                             my $tempkeyp = $fullkeyp;
                   3338:                             $tempkeyp =~ s/_\w+_/_0_/;
1.473     amueller 3339: 
1.548     raeburn  3340:                             if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3341:                                 $part{$tempkeyp}="0";
                   3342:                                 $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   3343:                                 my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   3344:                                 if ($allparms{$name{$tempkeyp}} ne '') {
                   3345:                                     my $identifier;
                   3346:                                     if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3347:                                         $identifier = $1;
                   3348:                                     }
                   3349:                                     $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3350:                                 } else {
                   3351:                                     $display{$tempkeyp} = $parmdis;
                   3352:                                 }
                   3353:                                 unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3354:                                 $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3355:                                 $display{$tempkeyp} =~ s/_\w+_/_0_/;
                   3356:                                 $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   3357:                                 $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   3358:                               }
                   3359:                         } # end loop through keys
1.560     damieng  3360:                     }
1.57      albertel 3361:                 } # end loop through ids
1.446     bisitz   3362: 
1.57      albertel 3363: #---------------------------------------------------- print header information
1.133     www      3364:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      3365:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.401     bisitz   3366:                 my $tmp="";
1.57      albertel 3367:                 if ($uname) {
1.473     amueller 3368:                     my $person=&Apache::loncommon::plainname($uname,$udom);
1.401     bisitz   3369:                     $tmp.=&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
                   3370:                         &mt('in')." \n";
1.57      albertel 3371:                 } else {
1.401     bisitz   3372:                     $tmp.="<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n";
1.57      albertel 3373:                 }
1.269     raeburn  3374:                 if ($cgroup) {
1.401     bisitz   3375:                     $tmp.=&mt("Group")." <font color=\"red\"><i>$cgroup".
                   3376:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3377:                     $csec = '';
                   3378:                 } elsif ($csec) {
1.401     bisitz   3379:                     $tmp.=&mt("Section")." <font color=\"red\"><i>$csec".
                   3380:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3381:                 }
1.401     bisitz   3382:                 $r->print('<div align="center"><h4>'
                   3383:                          .&mt('Set Defaults for All Resources in [_1]Specifically for [_2][_3]'
1.404     bisitz   3384:                              ,$foldermap.'<br /><font color="red"><i>'.$showtitle.'</i></font><br />'
1.401     bisitz   3385:                              ,$tmp
                   3386:                              ,'<font color="red"><i>'.$coursename.'</i></font>'
                   3387:                              )
                   3388:                          ."<br /></h4>\n"
1.422     bisitz   3389:                 );
1.57      albertel 3390: #---------------------------------------------------------------- print table
1.419     bisitz   3391:                 $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3392:                          .&Apache::loncommon::start_data_table_header_row()
                   3393:                          .'<th>'.&mt('Parameter Name').'</th>'
1.556     raeburn  3394:                          .'<th>'.&mt('Recursive Value').'</th>'
                   3395:                          .'<th>'.&mt('Non-Recursive Value').'</th>'
1.419     bisitz   3396:                          .'<th>'.&mt('Parameter in Effect').'</th>'
                   3397:                          .&Apache::loncommon::end_data_table_header_row()
                   3398:                 );
1.57      albertel 3399: 
1.548     raeburn  3400:                 foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.473     amueller 3401:                     $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3402:                     &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  3403:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
1.553     raeburn  3404:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp);
1.57      albertel 3405:                 }
1.422     bisitz   3406:                 $r->print(&Apache::loncommon::end_data_table().'</p>'
                   3407:                          .'</div>'
                   3408:                 );
1.57      albertel 3409:             } # end each map
                   3410:         } # end of $parmlev eq map
                   3411: #--------------------------------- Entry for parm level general (Course level)
                   3412:         if ($parmlev eq 'general') {
1.473     amueller 3413:             my $defbgone = '#E0E099';
1.419     bisitz   3414:             my $defbgtwo = '#FFFF99';
                   3415:             my $defbgthree = '#FFBB99';
1.57      albertel 3416: 
                   3417: #-------------------------------------------- for each map, gather information
                   3418:             my $mapid="0.0";
                   3419: #-----------------------  loop through ids and get all parameter types for map
                   3420: #-----------------------------------------          and associated information
                   3421:             my %name = ();
                   3422:             my %part = ();
                   3423:             my %display = ();
                   3424:             my %type = ();
                   3425:             my %default = ();
1.446     bisitz   3426: 
1.548     raeburn  3427:             foreach $id (@ids) {
                   3428:                 my $rid = $id;
1.446     bisitz   3429: 
1.196     www      3430:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 3431: 
                   3432: #--------------------------------------------------------------------
                   3433: # @catmarker contains list of all possible parameters including part #s
                   3434: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3435: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3436: # When storing information, store as part 0
                   3437: # When requesting information, request from full part
                   3438: #-------------------------------------------------------------------
1.548     raeburn  3439:                 foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3440:                     my $tempkeyp = $fullkeyp;
                   3441:                     $tempkeyp =~ s/_\w+_/_0_/;
                   3442:                     if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3443:                         $part{$tempkeyp}="0";
                   3444:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   3445:                         my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   3446:                         if ($allparms{$name{$tempkeyp}} ne '') {
                   3447:                             my $identifier;
                   3448:                             if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3449:                                 $identifier = $1;
                   3450:                             }
                   3451:                             $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3452:                         } else {
                   3453:                             $display{$tempkeyp} = $parmdis;
                   3454:                         }
                   3455:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3456:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3457:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
                   3458:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   3459:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
1.560     damieng  3460:                     }
1.57      albertel 3461:                 } # end loop through keys
                   3462:             } # end loop through ids
1.446     bisitz   3463: 
1.57      albertel 3464: #---------------------------------------------------- print header information
1.473     amueller 3465:             my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 3466:             $r->print(<<ENDMAPONE);
1.419     bisitz   3467: <center>
                   3468: <h4>$setdef
1.135     albertel 3469: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 3470: ENDMAPONE
                   3471:             if ($uname) {
1.473     amueller 3472:                 my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 3473:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 3474:             } else {
1.135     albertel 3475:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 3476:             }
1.446     bisitz   3477: 
1.135     albertel 3478:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.306     albertel 3479:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$cgroup</i></font>\n")};
1.135     albertel 3480:             $r->print("</h4>\n");
1.57      albertel 3481: #---------------------------------------------------------------- print table
1.419     bisitz   3482:             $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3483:                      .&Apache::loncommon::start_data_table_header_row()
                   3484:                      .'<th>'.&mt('Parameter Name').'</th>'
                   3485:                      .'<th>'.&mt('Default Value').'</th>'
                   3486:                      .'<th>'.&mt('Parameter in Effect').'</th>'
                   3487:                      .&Apache::loncommon::end_data_table_header_row()
                   3488:             );
1.57      albertel 3489: 
1.548     raeburn  3490:             foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.419     bisitz   3491:                 $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3492:                 &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  3493:                        \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
1.553     raeburn  3494:                                    $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp);
1.57      albertel 3495:             }
1.419     bisitz   3496:             $r->print(&Apache::loncommon::end_data_table()
                   3497:                      .'</p>'
                   3498:                      .'</center>'
                   3499:             );
1.57      albertel 3500:         } # end of $parmlev eq general
1.43      albertel 3501:     }
1.507     www      3502:     $r->print('</form>');
                   3503:     &endSettingsScreen($r);
                   3504:     $r->print(&Apache::loncommon::end_page());
1.57      albertel 3505: } # end sub assessparms
1.30      www      3506: 
1.560     damieng  3507: 
                   3508: 
1.120     www      3509: ##################################################
1.560     damieng  3510: # OVERVIEW MODE
1.207     www      3511: ##################################################
1.124     www      3512: 
1.563     damieng  3513: my $tableopen; # boolean, true if HTML table is already opened
                   3514: 
                   3515: # Returns HTML with the HTML table start tag and header, unless the table is already opened.
                   3516: # @param {boolean} $readonly - true if values cannot be edited (otherwise more columns are added)
                   3517: # @returns {string}
1.124     www      3518: sub tablestart {
1.552     raeburn  3519:     my ($readonly) = @_;
1.124     www      3520:     if ($tableopen) {
1.552     raeburn  3521:         return '';
1.124     www      3522:     } else {
1.552     raeburn  3523:         $tableopen=1;
                   3524:         my $output = &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th>';
                   3525:         if ($readonly) {
                   3526:             $output .= '<th>'.&mt('Current value').'</th>';
                   3527:         } else {
                   3528:             $output .= '<th>'.&mt('Delete').'</th><th>'.&mt('Set to ...').'</th>';
                   3529:         }
                   3530:         $output .= '</tr>';
                   3531:         return $output;
1.124     www      3532:     }
                   3533: }
                   3534: 
1.563     damieng  3535: # Returns HTML with the HTML table end tag, unless the table is not opened.
                   3536: # @returns {string}
1.124     www      3537: sub tableend {
                   3538:     if ($tableopen) {
1.560     damieng  3539:         $tableopen=0;
                   3540:         return &Apache::loncommon::end_data_table();
1.124     www      3541:     } else {
1.560     damieng  3542:         return'';
1.124     www      3543:     }
                   3544: }
                   3545: 
1.563     damieng  3546: # Reads course and user information.
                   3547: # 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).
                   3548: # The key for student data is modified with '[useropt:'.username.':'.userdomain.'].'.
                   3549: # If the context is looking for a list, returns a list with the scalar data and the class list.
                   3550: # @param {string} $crs - course number
                   3551: # @param {string} $dom - course domain
                   3552: # @returns {hash reference|Array}
1.207     www      3553: sub readdata {
                   3554:     my ($crs,$dom)=@_;
                   3555: # Read coursedata
                   3556:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   3557: # Read userdata
                   3558: 
                   3559:     my $classlist=&Apache::loncoursedata::get_classlist();
1.548     raeburn  3560:     foreach my $user (keys(%$classlist)) {
                   3561:         if ($user=~/^($match_username)\:($match_domain)$/) {
                   3562:             my ($tuname,$tudom)=($1,$2);
                   3563:             my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                   3564:             foreach my $userkey (keys(%{$useropt})) {
                   3565:                 if ($userkey=~/^\Q$env{'request.course.id'}\E/) {
1.207     www      3566:                     my $newkey=$userkey;
1.548     raeburn  3567:                     $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   3568:                     $$resourcedata{$newkey}=$$useropt{$userkey};
                   3569:                 }
                   3570:             }
1.473     amueller 3571:         }
                   3572:     }
1.552     raeburn  3573:     if (wantarray) {
                   3574:         return ($resourcedata,$classlist);
                   3575:     } else {
                   3576:         return $resourcedata;
                   3577:     }
1.207     www      3578: }
                   3579: 
                   3580: 
1.563     damieng  3581: # Stores parameter data, using form parameters directly.
                   3582: #
                   3583: # Uses the following form parameters. The variable part in the names is a resourcedata key (except for a modification for user data).
                   3584: # set_* (except settext, setipallow, setipdeny) - set a parameter value
                   3585: # del_* - remove a parameter
                   3586: # datepointer_* - set a date parameter (value is key_* refering to a set of other form parameters)
                   3587: # dateinterval_* - set a date interval parameter (value refers to more form parameters)
                   3588: # key_* - date values
                   3589: # days_* - for date intervals
                   3590: # hours_* - for date intervals
                   3591: # minutes_* - for date intervals
                   3592: # seconds_* - for date intervals
                   3593: # done_* - for date intervals
                   3594: # typeof_* - parameter type
                   3595: # 
                   3596: # @param {Apache2::RequestRec} $r - the Apache request
                   3597: # @param {string} $crs - course number
                   3598: # @param {string} $dom - course domain
1.208     www      3599: sub storedata {
                   3600:     my ($r,$crs,$dom)=@_;
1.207     www      3601: # Set userlevel immediately
                   3602: # Do an intermediate store of course level
                   3603:     my $olddata=&readdata($crs,$dom);
1.124     www      3604:     my %newdata=();
                   3605:     undef %newdata;
                   3606:     my @deldata=();
                   3607:     undef @deldata;
1.504     raeburn  3608:     my ($got_chostname,$chostname,$cmajor,$cminor);
1.546     raeburn  3609:     my $now = time;
1.560     damieng  3610:     foreach my $key (keys(%env)) {
                   3611:         if ($key =~ /^form\.([a-z]+)\_(.+)$/) {
                   3612:             my $cmd=$1;
                   3613:             my $thiskey=$2;
                   3614:             next if ($cmd eq 'settext' || $cmd eq 'setipallow' || $cmd eq 'setipdeny');
                   3615:             my ($tuname,$tudom)=&extractuser($thiskey);
                   3616:             my $tkey=$thiskey;
1.473     amueller 3617:             if ($tuname) {
1.560     damieng  3618:                 $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   3619:             }
                   3620:             if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
1.563     damieng  3621:                 my ($data, $typeof, $text, $name, $valchk, $valmatch, $namematch);
                   3622:                 if ($cmd eq 'set') {
                   3623:                     $data=$env{$key};
                   3624:                     $valmatch = '';
                   3625:                     $valchk = $data;
                   3626:                     $typeof=$env{'form.typeof_'.$thiskey};
                   3627:                     $text = &mt('Saved modified parameter for');
                   3628:                     if ($typeof eq 'string_questiontype') {
                   3629:                         $name = 'type';
                   3630:                     } elsif ($typeof eq 'string_lenient') {
                   3631:                         $name = 'lenient';
                   3632:                         my $stringmatch = &standard_string_matches($typeof);
                   3633:                         if (ref($stringmatch) eq 'ARRAY') {
                   3634:                             foreach my $item (@{$stringmatch}) {
                   3635:                                 if (ref($item) eq 'ARRAY') {
                   3636:                                     my ($regexpname,$pattern) = @{$item};
                   3637:                                     if ($pattern ne '') {
                   3638:                                         if ($data =~ /$pattern/) {
                   3639:                                             $valmatch = $regexpname;
                   3640:                                             $valchk = '';
                   3641:                                             last;
                   3642:                                         }
1.560     damieng  3643:                                     }
1.549     raeburn  3644:                                 }
                   3645:                             }
                   3646:                         }
1.563     damieng  3647:                     } elsif ($typeof eq 'string_discussvote') {
                   3648:                         $name = 'discussvote';
                   3649:                     } elsif ($typeof eq 'string_examcode') {
                   3650:                         $name = 'examcode';
                   3651:                         if (&Apache::lonnet::validCODE($data)) {
                   3652:                             $valchk = 'valid';
                   3653:                         }
                   3654:                     } elsif ($typeof eq 'string_yesno') {
                   3655:                         if ($thiskey =~ /\.retrypartial$/) {
                   3656:                             $name = 'retrypartial';
                   3657:                         }
1.549     raeburn  3658:                     }
1.563     damieng  3659:                 } elsif ($cmd eq 'datepointer') {
                   3660:                     $data=&Apache::lonhtmlcommon::get_date_from_form($env{$key});
                   3661:                     $typeof=$env{'form.typeof_'.$thiskey};
                   3662:                     $text = &mt('Saved modified date for');
                   3663:                     if ($typeof eq 'date_start') {
                   3664:                         if ($thiskey =~ /\.printstartdate$/) {
                   3665:                             $name = 'printstartdate';
                   3666:                             if (($data) && ($data > $now)) {
                   3667:                                 $valchk = 'future';
                   3668:                             }
1.560     damieng  3669:                         }
1.563     damieng  3670:                     } elsif ($typeof eq 'date_end') {
                   3671:                         if ($thiskey =~ /\.printenddate$/) {
                   3672:                             $name = 'printenddate';
                   3673:                             if (($data) && ($data < $now)) {
                   3674:                                 $valchk = 'past';
                   3675:                             }
1.560     damieng  3676:                         }
1.504     raeburn  3677:                     }
1.563     damieng  3678:                 } elsif ($cmd eq 'dateinterval') {
                   3679:                     $data=&get_date_interval_from_form($thiskey);
                   3680:                     if ($thiskey =~ /\.interval$/) {
                   3681:                         $name = 'interval';
                   3682:                         my $intervaltype = &get_intervaltype($name);
                   3683:                         my $intervalmatch = &standard_interval_matches($intervaltype);
                   3684:                         if (ref($intervalmatch) eq 'ARRAY') {
                   3685:                             foreach my $item (@{$intervalmatch}) {
                   3686:                                 if (ref($item) eq 'ARRAY') {
                   3687:                                     my ($regexpname,$pattern) = @{$item};
                   3688:                                     if ($pattern ne '') {
                   3689:                                         if ($data =~ /$pattern/) {
                   3690:                                             $valmatch = $regexpname;
                   3691:                                             $valchk = '';
                   3692:                                             last;
                   3693:                                         }
1.560     damieng  3694:                                     }
1.554     raeburn  3695:                                 }
                   3696:                             }
                   3697:                         }
                   3698:                     }
1.563     damieng  3699:                     $typeof=$env{'form.typeof_'.$thiskey};
                   3700:                     $text = &mt('Saved modified date for');
1.554     raeburn  3701:                 }
1.563     damieng  3702:                 if ($thiskey =~ m{\.(?:sequence|page)___\(rec\)}) {
                   3703:                     $namematch = 'maplevelrecurse';
1.560     damieng  3704:                 }
1.563     damieng  3705:                 if (($name ne '') || ($namematch ne '')) {
                   3706:                     my ($needsrelease,$needsnewer);
                   3707:                     if ($name ne '') {
                   3708:                         $needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk:$valmatch:"};
1.560     damieng  3709:                         if ($needsrelease) {
                   3710:                             unless ($got_chostname) {
1.563     damieng  3711:                                 ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.560     damieng  3712:                                 $got_chostname = 1;
                   3713:                             }
1.563     damieng  3714:                             $needsnewer = &parameter_releasecheck($name,$valchk,$valmatch,undef,
                   3715:                                                                 $needsrelease,
                   3716:                                                                 $cmajor,$cminor);
                   3717:                         }
                   3718:                     }
                   3719:                     if ($namematch ne '') {
                   3720:                         if ($needsnewer) {
                   3721:                             undef($namematch);
1.560     damieng  3722:                         } else {
1.563     damieng  3723:                             my $currneeded;
                   3724:                             if ($needsrelease) {
                   3725:                                 $currneeded = $needsrelease;
                   3726:                             }
                   3727:                             $needsrelease =
                   3728:                                 $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   3729:                             if (($needsrelease) &&
                   3730:                                     (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   3731:                                 unless ($got_chostname) {
                   3732:                                     ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   3733:                                     $got_chostname = 1;
                   3734:                                 }
                   3735:                                 $needsnewer = &parameter_releasecheck(undef,$valchk,$valmatch,
                   3736:                                     $namematch, $needsrelease,$cmajor,$cminor);
                   3737:                             } else {
                   3738:                                 undef($namematch);
                   3739:                             }
1.560     damieng  3740:                         }
1.557     raeburn  3741:                     }
1.563     damieng  3742:                     if ($needsnewer) {
                   3743:                         $r->print('<br />'.&oldversion_warning($name,$namematch,$data,
                   3744:                                                             $chostname,$cmajor,
                   3745:                                                             $cminor,$needsrelease));
                   3746:                         next;
                   3747:                     }
1.504     raeburn  3748:                 }
1.563     damieng  3749:                 if (defined($data) and $$olddata{$thiskey} ne $data) {
                   3750:                     if ($tuname) {
                   3751:                         if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
                   3752:                                             $tkey.'.type' => $typeof},
                   3753:                                     $tudom,$tuname) eq 'ok') {
                   3754:                             &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom);
                   3755:                             $r->print('<br />'.$text.' '.
                   3756:                                 &Apache::loncommon::plainname($tuname,$tudom));
                   3757:                         } else {
                   3758:                             $r->print('<div class="LC_error">'.
                   3759:                                 &mt('Error saving parameters').'</div>');
                   3760:                         }
                   3761:                         &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
1.560     damieng  3762:                     } else {
1.563     damieng  3763:                         $newdata{$thiskey}=$data;
                   3764:                         $newdata{$thiskey.'.type'}=$typeof;
1.560     damieng  3765:                     }
                   3766:                 }
                   3767:             } elsif ($cmd eq 'del') {
                   3768:                 if ($tuname) {
                   3769:                     if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') {
                   3770:                             &log_parmset({$tkey=>''},1,$tuname,$tudom);
                   3771:                         $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   3772:                     } else {
                   3773:                         $r->print('<div class="LC_error">'.
                   3774:                             &mt('Error deleting parameters').'</div>');
                   3775:                     }
                   3776:                     &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   3777:                 } else {
                   3778:                     push (@deldata,$thiskey,$thiskey.'.type');
                   3779:                 }
1.473     amueller 3780:             }
                   3781:         }
                   3782:     }
1.207     www      3783: # Store all course level
1.144     www      3784:     my $delentries=$#deldata+1;
1.548     raeburn  3785:     my @newdatakeys=keys(%newdata);
1.144     www      3786:     my $putentries=$#newdatakeys+1;
                   3787:     if ($delentries) {
1.560     damieng  3788:         if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {
                   3789:             my %loghash=map { $_ => '' } @deldata;
                   3790:             &log_parmset(\%loghash,1);
                   3791:             $r->print('<h2>'.&mt('Deleted [quant,_1,parameter]',$delentries/2).'</h2>');
                   3792:         } else {
                   3793:             $r->print('<div class="LC_error">'.
                   3794:                 &mt('Error deleting parameters').'</div>');
                   3795:         }
                   3796:         &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      3797:     }
                   3798:     if ($putentries) {
1.560     damieng  3799:         if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
                   3800:                     &log_parmset(\%newdata,0);
                   3801:             $r->print('<h3>'.&mt('Saved [quant,_1,parameter]',$putentries/2).'</h3>');
                   3802:         } else {
                   3803:             $r->print('<div class="LC_error">'.
                   3804:                 &mt('Error saving parameters').'</div>');
                   3805:         }
                   3806:         &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      3807:     }
1.208     www      3808: }
1.207     www      3809: 
1.563     damieng  3810: # Returns the username and domain from a key created in readdata from a resourcedata key.
                   3811: #
                   3812: # @param {string} $key - the key
                   3813: # @returns {Array}
1.208     www      3814: sub extractuser {
                   3815:     my $key=shift;
1.350     albertel 3816:     return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
1.208     www      3817: }
1.206     www      3818: 
1.563     damieng  3819: # Parses a parameter key and returns the components.
                   3820: #
                   3821: # @param {string} $key - 
                   3822: # @param {hash reference} $listdata - 
                   3823: # @return {Array} - (student, resource, part, parameter)
1.381     albertel 3824: sub parse_listdata_key {
                   3825:     my ($key,$listdata) = @_;
                   3826:     # split into student/section affected, and
                   3827:     # the realm (folder/resource part and parameter
1.446     bisitz   3828:     my ($student,$realm) =
1.473     amueller 3829:     ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
1.381     albertel 3830:     # if course wide student would be undefined
                   3831:     if (!defined($student)) {
1.560     damieng  3832:         ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.381     albertel 3833:     }
                   3834:     # strip off the .type if it's not the Question type parameter
                   3835:     if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
1.560     damieng  3836:         $realm=~s/\.type//;
1.381     albertel 3837:     }
                   3838:     # split into resource+part and parameter name
1.388     albertel 3839:     my ($res,    $parm) = ($realm=~/^(.*)\.(.*)$/);
                   3840:        ($res, my $part) = ($res  =~/^(.*)\.(.*)$/);
1.381     albertel 3841:     return ($student,$res,$part,$parm);
                   3842: }
                   3843: 
1.563     damieng  3844: # Prints HTML with forms for the given parameter data in overview mode (newoverview or overview).
                   3845: #
                   3846: # @param {Apache2::RequestRec} $r - the Apache request
                   3847: # @param {hash reference} $resourcedata - parameter data returned by readdata
                   3848: # @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
                   3849: # @param {string} $sortorder - realmstudent|studentrealm
                   3850: # @param {string} $caller - name of the calling sub (overview|newoverview)
                   3851: # @param {hash reference} $classlist - from loncoursedata::get_classlist
                   3852: # @returns{integer} - number of $listdata parameters processed
1.208     www      3853: sub listdata {
1.552     raeburn  3854:     my ($r,$resourcedata,$listdata,$sortorder,$caller,$classlist)=@_;
                   3855:     
1.207     www      3856: # Start list output
1.206     www      3857: 
1.122     www      3858:     my $oldsection='';
                   3859:     my $oldrealm='';
                   3860:     my $oldpart='';
1.123     www      3861:     my $pointer=0;
1.124     www      3862:     $tableopen=0;
1.145     www      3863:     my $foundkeys=0;
1.248     albertel 3864:     my %keyorder=&standardkeyorder();
1.381     albertel 3865: 
1.552     raeburn  3866:     my ($secidx,%grouphash);
                   3867:     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   3868:         $secidx = &Apache::loncoursedata::CL_SECTION();
1.553     raeburn  3869:         if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   3870:             %grouphash = &Apache::longroup::coursegroups();
                   3871:         } elsif ($env{'request.course.groups'} ne '') {
                   3872:             map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
                   3873:         }
1.552     raeburn  3874:     }
                   3875: 
1.214     www      3876:     foreach my $thiskey (sort {
1.560     damieng  3877:         my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
                   3878:         my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
1.381     albertel 3879: 
1.560     damieng  3880:         # get the numerical order for the param
                   3881:         $aparm=$keyorder{'parameter_0_'.$aparm};
                   3882:         $bparm=$keyorder{'parameter_0_'.$bparm};
1.381     albertel 3883: 
1.560     damieng  3884:         my $result=0;
1.381     albertel 3885: 
1.560     damieng  3886:         if ($sortorder eq 'realmstudent') {
1.381     albertel 3887:             if ($ares     ne $bres    ) {
1.560     damieng  3888:                 $result = ($ares     cmp $bres);
1.446     bisitz   3889:             } elsif ($astudent ne $bstudent) {
1.560     damieng  3890:                 $result = ($astudent cmp $bstudent);
                   3891:             } elsif ($apart    ne $bpart   ) {
                   3892:                 $result = ($apart    cmp $bpart);
                   3893:             }
                   3894:         } else {
                   3895:             if      ($astudent ne $bstudent) {
                   3896:                 $result = ($astudent cmp $bstudent);
                   3897:             } elsif ($ares     ne $bres    ) {
                   3898:                 $result = ($ares     cmp $bres);
                   3899:             } elsif ($apart    ne $bpart   ) {
                   3900:                 $result = ($apart    cmp $bpart);
                   3901:             }
1.473     amueller 3902:         }
1.446     bisitz   3903: 
1.560     damieng  3904:         if (!$result) {
1.381     albertel 3905:             if (defined($aparm) && defined($bparm)) {
1.560     damieng  3906:                 $result = ($aparm <=> $bparm);
1.381     albertel 3907:             } elsif (defined($aparm)) {
1.560     damieng  3908:                 $result = -1;
1.381     albertel 3909:             } elsif (defined($bparm)) {
1.560     damieng  3910:                 $result = 1;
                   3911:             }
1.473     amueller 3912:         }
1.381     albertel 3913: 
1.560     damieng  3914:         $result;
                   3915:         
                   3916:     } keys(%{$listdata})) { # foreach my $thiskey
1.381     albertel 3917: 
1.560     damieng  3918:         my $readonly;
                   3919:         if ($$listdata{$thiskey.'.type'}) {
                   3920:             my $thistype=$$listdata{$thiskey.'.type'};
                   3921:             if ($$resourcedata{$thiskey.'.type'}) {
                   3922:                 $thistype=$$resourcedata{$thiskey.'.type'};
                   3923:             }
                   3924:             my ($middle,$part,$name)=
                   3925:                 ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
                   3926:             my $section=&mt('All Students');
                   3927:             if ($middle=~/^\[(.*)\]/) {
                   3928:                 my $issection=$1;
                   3929:                 if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
                   3930:                     my ($stuname,$studom) = ($1,$2);
                   3931:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   3932:                         if (ref($classlist) eq 'HASH') {
                   3933:                             if (ref($classlist->{$stuname.':'.$studom}) eq 'ARRAY') {
                   3934:                                 next unless ($classlist->{$stuname.':'.$studom}->[$secidx] eq $env{'request.course.sec'}); 
                   3935:                             }
                   3936:                         }
                   3937:                     }
                   3938:                     $section=&mt('User').": ".&Apache::loncommon::plainname($stuname,$studom);
                   3939:                 } else {
                   3940:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   3941:                         if (exists($grouphash{$issection})) {
                   3942:                             $section=&mt('Group').': '.$issection;
                   3943:                         } elsif ($issection eq $env{'request.course.sec'}) {
                   3944:                             $section = &mt('Section').': '.$issection;
                   3945:                         } else {
                   3946:                             next; 
1.552     raeburn  3947:                         }
1.560     damieng  3948:                     } else {
                   3949:                         $section=&mt('Group/Section').': '.$issection;
1.552     raeburn  3950:                     }
                   3951:                 }
1.560     damieng  3952:                 $middle=~s/^\[(.*)\]//;
                   3953:             } elsif (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   3954:                 $readonly = 1;
                   3955:             }
                   3956:             $middle=~s/\.+$//;
                   3957:             $middle=~s/^\.+//;
                   3958:             my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
                   3959:             if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   3960:                 my $mapurl = $1;
                   3961:                 my $maplevel = $2;
                   3962:                 my $leveltitle = &mt('Folder/Map');
                   3963:                 if ($maplevel eq 'rec') {
                   3964:                     $leveltitle = &mt('Recursive');
                   3965:                 }
                   3966:                 $realm='<span class="LC_parm_scope_folder">'.$leveltitle.': '.&Apache::lonnet::gettitle($mapurl).' <br /><span class="LC_parm_folder">('.$mapurl.')</span></span>';
                   3967:             } elsif ($middle) {
                   3968:                 my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   3969:                 $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   3970:                     ': '.&Apache::lonnet::gettitle($middle).
                   3971:                     ' <br /><span class="LC_parm_symb">('.$url.' in '.$map.' id: '.
                   3972:                     $id.')</span></span>';
                   3973:             }
                   3974:             if ($sortorder eq 'realmstudent') {
                   3975:                 if ($realm ne $oldrealm) {
                   3976:                     $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   3977:                     $oldrealm=$realm;
                   3978:                     $oldsection='';
                   3979:                 }
                   3980:                 if ($section ne $oldsection) {
                   3981:                     $r->print(&tableend()."\n<h2>$section</h2>");
                   3982:                     $oldsection=$section;
                   3983:                     $oldpart='';
                   3984:                 }
1.552     raeburn  3985:             } else {
1.560     damieng  3986:                 if ($section ne $oldsection) {
                   3987:                     $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   3988:                     $oldsection=$section;
                   3989:                     $oldrealm='';
                   3990:                 }
                   3991:                 if ($realm ne $oldrealm) {
                   3992:                     $r->print(&tableend()."\n<h2>$realm</h2>");
                   3993:                     $oldrealm=$realm;
                   3994:                     $oldpart='';
1.552     raeburn  3995:                 }
                   3996:             }
1.560     damieng  3997:             if ($part ne $oldpart) {
                   3998:                 $r->print(&tableend().
                   3999:                     "\n".'<span class="LC_parm_part">'.&mt('Part').": $part</span>");
                   4000:                 $oldpart=$part;
1.556     raeburn  4001:             }
1.560     damieng  4002:     #
                   4003:     # Ready to print
                   4004:     #
1.470     raeburn  4005:             my $parmitem = &standard_parameter_names($name);
1.560     damieng  4006:             $r->print(&tablestart($readonly).
                   4007:                 &Apache::loncommon::start_data_table_row().
                   4008:                 '<td><b>'.&mt($parmitem).
                   4009:                 '</b></td>');
                   4010:             unless ($readonly) {
                   4011:                 $r->print('<td><input type="checkbox" name="del_'.
                   4012:                         $thiskey.'" /></td>');
                   4013:             }
                   4014:             $r->print('<td>');
                   4015:             $foundkeys++;
                   4016:             if (&isdateparm($thistype)) {
                   4017:                 my $jskey='key_'.$pointer;
                   4018:                 my $state;
                   4019:                 $pointer++;
                   4020:                 if ($readonly) {
                   4021:                     $state = 'disabled';
                   4022:                 }
                   4023:                 $r->print(
                   4024:                     &Apache::lonhtmlcommon::date_setter('parmform',
                   4025:                                                         $jskey,
                   4026:                                                         $$resourcedata{$thiskey},
                   4027:                                                         '',1,$state));
                   4028:                 unless  ($readonly) {
                   4029:                     $r->print(
                   4030:     '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
                   4031:     (($$resourcedata{$thiskey}!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$$resourcedata{$thiskey}.'">'.
                   4032:     &mt('Shift all dates based on this date').'</a></span>':'').
                   4033:     &date_sanity_info($$resourcedata{$thiskey})
                   4034:                     );
                   4035:                 }
                   4036:             } elsif ($thistype eq 'date_interval') {
                   4037:                 $r->print(&date_interval_selector($thiskey,$name,
                   4038:                         $$resourcedata{$thiskey},$readonly));
                   4039:             } elsif ($thistype =~ m/^string/) {
                   4040:                 $r->print(&string_selector($thistype,$thiskey,
                   4041:                         $$resourcedata{$thiskey},$name,$readonly));
                   4042:             } else {
                   4043:                 $r->print(&default_selector($thiskey,$$resourcedata{$thiskey},$readonly));
1.552     raeburn  4044:             }
1.560     damieng  4045:             unless ($readonly) {
                   4046:                 $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   4047:                         $thistype.'" />');
1.552     raeburn  4048:             }
1.560     damieng  4049:             $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.473     amueller 4050:         }
1.121     www      4051:     }
1.208     www      4052:     return $foundkeys;
                   4053: }
                   4054: 
1.563     damieng  4055: # Returns a string representing the interval, directly using form data matching the given key.
                   4056: # The returned string may also include information related to proctored exams.
                   4057: # Format: seconds['_done'[':'done button title':']['_proctor'['_'proctor key]]]
                   4058: #
                   4059: # @param {string} $key - suffix for form fields related to the interval
                   4060: # @returns {string}
1.385     albertel 4061: sub get_date_interval_from_form {
                   4062:     my ($key) = @_;
                   4063:     my $seconds = 0;
                   4064:     foreach my $which (['days', 86400],
1.473     amueller 4065:                ['hours', 3600],
                   4066:                ['minutes', 60],
                   4067:                ['seconds',  1]) {
1.560     damieng  4068:         my ($name, $factor) = @{ $which };
                   4069:         if (defined($env{'form.'.$name.'_'.$key})) {
                   4070:             $seconds += $env{'form.'.$name.'_'.$key} * $factor;
                   4071:         }
1.473     amueller 4072:     }
1.560     damieng  4073:     if (($key =~ /\.interval$/) &&
                   4074:             (($env{'form.done_'.$key} eq '_done') || ($env{'form.done_'.$key} eq '_done_proctor'))) {
1.559     raeburn  4075:         if ($env{'form.done_'.$key.'_buttontext'}) {
                   4076:             $env{'form.done_'.$key.'_buttontext'} =~ s/\://g;
                   4077:             $seconds .= '_done:'.$env{'form.done_'.$key.'_buttontext'}.':';
                   4078:             if ($env{'form.done_'.$key} eq '_done_proctor') {
                   4079:                 $seconds .= '_proctor';
                   4080:             }
                   4081:         } else {
                   4082:             $seconds .= $env{'form.done_'.$key}; 
                   4083:         }
                   4084:         if (($env{'form.done_'.$key} eq '_done_proctor') && 
1.560     damieng  4085:                 ($env{'form.done_'.$key.'_proctorkey'})) {
1.558     raeburn  4086:             $seconds .= '_'.$env{'form.done_'.$key.'_proctorkey'};
                   4087:         }
1.554     raeburn  4088:     }
1.385     albertel 4089:     return $seconds;
                   4090: }
                   4091: 
                   4092: 
1.563     damieng  4093: # Returns HTML to enter a text value for a parameter.
                   4094: #
                   4095: # @param {string} $thiskey - parameter key
                   4096: # @param {string} $showval - the current value
                   4097: # @param {boolean} $readonly - true if the field should not be made editable
                   4098: # @returns {string}
1.383     albertel 4099: sub default_selector {
1.552     raeburn  4100:     my ($thiskey, $showval, $readonly) = @_;
                   4101:     my $disabled;
                   4102:     if ($readonly) {
                   4103:         $disabled = ' disabled="disabled"';
                   4104:     }
                   4105:     return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'"'.$disabled.' />';
1.383     albertel 4106: }
                   4107: 
1.563     damieng  4108: # Returns HTML to enter allow/deny rules related to IP addresses.
                   4109: #
                   4110: # @param {string} $thiskey - parameter key
                   4111: # @param {string} $showval - the current value
                   4112: # @param {boolean} $readonly - true if the fields should not be made editable
                   4113: # @returns {string}
1.549     raeburn  4114: sub string_ip_selector {
1.552     raeburn  4115:     my ($thiskey, $showval, $readonly) = @_;
1.549     raeburn  4116:     my %access = (
                   4117:                    allow => [],
                   4118:                    deny  => [],
                   4119:                  );
                   4120:     if ($showval ne '') {
                   4121:         my @current;
                   4122:         if ($showval =~ /,/) {
                   4123:             @current = split(/,/,$showval);
                   4124:         } else {
                   4125:             @current = ($showval);
                   4126:         }
                   4127:         foreach my $item (@current) {
                   4128:             if ($item =~ /^\!([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4129:                 push(@{$access{'deny'}},$1);
                   4130:             } elsif ($item =~ /^([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4131:                 push(@{$access{'allow'}},$item);
                   4132:             }
                   4133:         }
                   4134:     }
                   4135:     if (!@{$access{'allow'}}) {
                   4136:         @{$access{'allow'}} = ('');
                   4137:     }
                   4138:     if (!@{$access{'deny'}}) {
                   4139:         @{$access{'deny'}} = ('');
                   4140:     }
1.552     raeburn  4141:     my ($disabled,$addmore);
                   4142:     if ($disabled) {
                   4143:         $disabled=' disabled="disabled"';
                   4144:     } else {
                   4145:         $addmore = "\n".'<button class="LC_add_ipacc_button">'.&mt('Add more').'</button>';
                   4146:     }
1.549     raeburn  4147:     my $output = '<input type="hidden" name="set_'.$thiskey.'" />
                   4148: <table><tr><th>'.&mt('Allow from').'</th><th>'.&mt('Deny from').'</th></tr><tr>';
                   4149:     foreach my $acctype ('allow','deny') {
                   4150:         $output .= '
                   4151: <td valign="top">
                   4152: <div class="LC_string_ipacc_wrap" id="LC_string_ipacc_'.$acctype.'_'.$thiskey.'">
                   4153:   <div class="LC_string_ipacc_inner">'."\n";
                   4154:         my $num = 0;
                   4155:         foreach my $curr (@{$access{$acctype}}) {
1.552     raeburn  4156:             $output .= '<div><input type="text" name="setip'.$acctype.'_'.$thiskey.'" value="'.$curr.'"'.$disabled.' />';
1.549     raeburn  4157:             if ($num > 0) {
                   4158:                 $output .= '<a href="#" class="LC_remove_ipacc">'.&mt('Remove').'</a>'; 
                   4159:             }
                   4160:             $output .= '</div>'."\n";
                   4161:             $num ++;
                   4162:         }
                   4163:         $output .= '
1.552     raeburn  4164:   </div>'.$addmore.'
1.549     raeburn  4165: </div>
                   4166: </td>';
                   4167:    }
                   4168:    $output .= '
                   4169: </tr>
                   4170: </table>'."\n";
                   4171:     return $output;
                   4172: }
                   4173: 
1.560     damieng  4174: 
                   4175: { # block using some constants related to parameter types (overview mode)
                   4176: 
1.446     bisitz   4177: my %strings =
1.383     albertel 4178:     (
                   4179:      'string_yesno'
                   4180:              => [[ 'yes', 'Yes' ],
1.560     damieng  4181:                  [ 'no', 'No' ]],
1.383     albertel 4182:      'string_problemstatus'
                   4183:              => [[ 'yes', 'Yes' ],
1.473     amueller 4184:          [ 'answer', 'Yes, and show correct answer if they exceed the maximum number of tries.' ],
                   4185:          [ 'no', 'No, don\'t show correct/incorrect feedback.' ],
                   4186:          [ 'no_feedback_ever', 'No, show no feedback at all.' ]],
1.504     raeburn  4187:      'string_questiontype'
                   4188:              => [[ 'problem', 'Standard Problem'],
                   4189:                  [ 'survey', 'Survey'],
                   4190:                  [ 'anonsurveycred', 'Anonymous Survey (credit for submission)'],
1.530     bisitz   4191:                  [ 'exam', 'Bubblesheet Exam'],
1.504     raeburn  4192:                  [ 'anonsurvey', 'Anonymous Survey'],
                   4193:                  [ 'randomizetry', 'New Randomization Each N Tries (default N=1)'],
                   4194:                  [ 'practice', 'Practice'],
                   4195:                  [ 'surveycred', 'Survey (credit for submission)']],
1.514     raeburn  4196:      'string_lenient'
                   4197:              => [['yes', 'Yes' ],
                   4198:                  [ 'no', 'No' ],
1.549     raeburn  4199:                  [ 'default', 'Default - only bubblesheet grading is lenient' ],
                   4200:                  [ 'weighted', 'Yes, weighted (optionresponse in checkbox mode)' ]],
1.521     raeburn  4201:      'string_discussvote'
                   4202:              => [['yes','Yes'],
                   4203:                  ['notended','Yes, unless discussion ended'],
                   4204:                  ['no','No']],
1.549     raeburn  4205:      'string_ip'
                   4206:              => [['_allowfrom_','Hostname(s), or IP(s) from which access is allowed'],
                   4207:                  ['_denyfrom_',], 'Hostname(s) or IP(s) from which access is disallowed'], 
1.383     albertel 4208:      );
                   4209: 
1.549     raeburn  4210: my %stringmatches = (
                   4211:          'string_lenient'
                   4212:               => [['weighted','^\-?[.\d]+,\-?[.\d]+,\-?[.\d]+,\-?[.\d]+$'],],
                   4213:          'string_ip'
                   4214:               => [['_allowfrom_','[^\!]+'],
                   4215:                   ['_denyfrom_','\!']],
                   4216:     );
                   4217: 
                   4218: my %stringtypes = (
                   4219:                     type         => 'string_questiontype',
                   4220:                     lenient      => 'string_lenient',
                   4221:                     retrypartial => 'string_yesno',
                   4222:                     discussvote  => 'string_discussvote',
                   4223:                     examcode     => 'string_examcode',
                   4224:                     acc          => 'string_ip',
                   4225:                   );
                   4226: 
1.563     damieng  4227: # Returns the possible values and titles for a given string type, or undef if there are none.
                   4228: # Used by courseprefs.
                   4229: #
                   4230: # @param {string} $string_type - a parameter type for strings
                   4231: # @returns {array reference} - 2D array, containing values and English titles
1.505     raeburn  4232: sub standard_string_options {
                   4233:     my ($string_type) = @_;
                   4234:     if (ref($strings{$string_type}) eq 'ARRAY') {
                   4235:         return $strings{$string_type};
                   4236:     }
                   4237:     return;
                   4238: }
1.383     albertel 4239: 
1.563     damieng  4240: # Returns regular expressions to match kinds of string types, or undef if there are none.
                   4241: #
                   4242: # @param {string} $string_type - a parameter type for strings
                   4243: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.549     raeburn  4244: sub standard_string_matches {
                   4245:     my ($string_type) = @_;
                   4246:     if (ref($stringmatches{$string_type}) eq 'ARRAY') {
                   4247:         return $stringmatches{$string_type};
                   4248:     }
                   4249:     return;
                   4250: }
                   4251: 
1.563     damieng  4252: # Returns a parameter type for a given parameter with a string type, or undef if not known.
                   4253: #
                   4254: # @param {string} $name - parameter name
                   4255: # @returns {string}
1.549     raeburn  4256: sub get_stringtype {
                   4257:     my ($name) = @_;
                   4258:     if (exists($stringtypes{$name})) {
                   4259:         return $stringtypes{$name};
                   4260:     }
                   4261:     return;
                   4262: }
                   4263: 
1.563     damieng  4264: # Returns HTML to edit a string parameter.
                   4265: #
                   4266: # @param {string} $thistype - parameter type
                   4267: # @param {string} $thiskey - parameter key
                   4268: # @param {string} $showval - parameter current value
                   4269: # @param {string} $name - parameter name
                   4270: # @param {boolean} $readonly - true if the values should not be made editable
                   4271: # @returns {string}
1.383     albertel 4272: sub string_selector {
1.552     raeburn  4273:     my ($thistype, $thiskey, $showval, $name, $readonly) = @_;
1.446     bisitz   4274: 
1.383     albertel 4275:     if (!exists($strings{$thistype})) {
1.552     raeburn  4276:         return &default_selector($thiskey,$showval,$readonly);
1.383     albertel 4277:     }
                   4278: 
1.504     raeburn  4279:     my %skiptype;
1.514     raeburn  4280:     if (($thistype eq 'string_questiontype') || 
1.560     damieng  4281:             ($thistype eq 'string_lenient') ||
                   4282:             ($thistype eq 'string_discussvote') ||
                   4283:             ($thistype eq 'string_ip') ||
                   4284:             ($name eq 'retrypartial')) {
1.504     raeburn  4285:         my ($got_chostname,$chostname,$cmajor,$cminor); 
                   4286:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   4287:             next unless (ref($possibilities) eq 'ARRAY');
1.514     raeburn  4288:             my ($parmval, $description) = @{ $possibilities };
1.549     raeburn  4289:             my $parmmatch;
                   4290:             if (ref($stringmatches{$thistype}) eq 'ARRAY') {
                   4291:                 foreach my $item (@{$stringmatches{$thistype}}) {
                   4292:                     if (ref($item) eq 'ARRAY') {
                   4293:                         if ($parmval eq $item->[0]) {
                   4294:                             $parmmatch = $parmval;
                   4295:                             $parmval = '';
                   4296:                             last;
                   4297:                         }
                   4298:                     }
                   4299:                 }
                   4300:             }
                   4301:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"}; 
1.504     raeburn  4302:             if ($needsrelease) {
                   4303:                 unless ($got_chostname) {
1.514     raeburn  4304:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.504     raeburn  4305:                     $got_chostname = 1;
                   4306:                 }
1.557     raeburn  4307:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.549     raeburn  4308:                                                        $needsrelease,$cmajor,$cminor);
1.504     raeburn  4309:                 if ($needsnewer) {
1.549     raeburn  4310:                     if ($parmmatch ne '') {
                   4311:                         $skiptype{$parmmatch} = 1;
                   4312:                     } elsif ($parmval ne '') {
                   4313:                         $skiptype{$parmval} = 1;
                   4314:                     }
1.504     raeburn  4315:                 }
                   4316:             }
                   4317:         }
                   4318:     }
1.549     raeburn  4319: 
                   4320:     if ($thistype eq 'string_ip') {
1.552     raeburn  4321:         return &string_ip_selector($thiskey,$showval,$readonly); 
1.549     raeburn  4322:     }
1.504     raeburn  4323: 
1.552     raeburn  4324:     my ($result,$disabled);
                   4325: 
                   4326:     if ($readonly) {
                   4327:         $disabled = ' disabled="disabled"';
                   4328:     }
1.504     raeburn  4329:     my $numinrow = 3;
                   4330:     if ($thistype eq 'string_problemstatus') {
                   4331:         $numinrow = 2;
                   4332:     } elsif ($thistype eq 'string_questiontype') {
                   4333:         if (keys(%skiptype) > 0) {
                   4334:              $numinrow = 4;
                   4335:         }
                   4336:     }
                   4337:     my $rem;
                   4338:     if (ref($strings{$thistype}) eq 'ARRAY') {
                   4339:         my $i=0;
                   4340:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   4341:             next unless (ref($possibilities) eq 'ARRAY');
                   4342:             my ($name, $description) = @{ $possibilities };
1.549     raeburn  4343:             next if ($skiptype{$name});
1.504     raeburn  4344:             $rem = $i%($numinrow);
                   4345:             if ($rem == 0) {
                   4346:                 if ($i > 0) {
                   4347:                     $result .= '</tr>';
                   4348:                 }
                   4349:                 $result .= '<tr>';
                   4350:             }
1.549     raeburn  4351:             my $colspan;
                   4352:             if ($i == @{ $strings{$thistype} }-1) {
                   4353:                 $rem = @{ $strings{$thistype} }%($numinrow);
                   4354:                 if ($rem) {
                   4355:                     my $colsleft = $numinrow - $rem;
                   4356:                     if ($colsleft) {
                   4357:                         $colspan = $colsleft+1;
                   4358:                         $colspan = ' colspan="'.$colspan.'"';
                   4359:                     }
                   4360:                 }
                   4361:             }
                   4362:             my ($add,$onchange,$css_class);
                   4363:             if ($thistype eq 'string_lenient') {
                   4364:                 if ($name eq 'weighted') {
                   4365:                     my $display;
                   4366:                     my %relatives = &Apache::lonlocal::texthash(
                   4367:                                         corrchkd     => 'Correct (checked)',
                   4368:                                         corrunchkd   => 'Correct (unchecked)',
                   4369:                                         incorrchkd   => 'Incorrect (checked)',
                   4370:                                         incorrunchkd => 'Incorrect (unchecked)',
                   4371:                     );
                   4372:                     my %textval = (
                   4373:                                     corrchkd     => '1.0',
                   4374:                                     corrunchkd   => '1.0',
                   4375:                                     incorrchkd   => '0.0',
                   4376:                                     incorrunchkd => '0.0',
                   4377:                     );
                   4378:                     if ($showval =~ /^([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)$/) {
                   4379:                         $textval{'corrchkd'} = $1;
                   4380:                         $textval{'corrunchkd'} = $2;
                   4381:                         $textval{'incorrchkd'} = $3;
                   4382:                         $textval{'incorrunchkd'} = $4;
                   4383:                         $display = 'inline';
                   4384:                         $showval = $name;
                   4385:                     } else {
                   4386:                         $display = 'none';
                   4387:                     }
                   4388:                     $add = ' <div id="LC_parmtext_'.$thiskey.'" style="display:'.$display.'"><table>'.
                   4389:                            '<tr><th colspan="2">'.&mt("Foil's submission status").'</th><th>'.&mt('Points').'</th></tr>';  
                   4390:                     foreach my $reltype ('corrchkd','corrunchkd','incorrchkd','incorrunchkd') {
                   4391:                         $add .= '<tr><td>&nbsp;</td><td>'.$relatives{$reltype}.'</td>'."\n".
                   4392:                                 '<td><input type="text" name="settext_'.$thiskey.'"'.
1.552     raeburn  4393:                                 ' value="'.$textval{$reltype}.'" size="3"'.$disabled.' />'.
1.549     raeburn  4394:                                 '</td></tr>';
                   4395:                     }
                   4396:                     $add .= '</table></div>'."\n";
                   4397:                 }
                   4398:                 $onchange = ' onclick="javascript:toggleParmTextbox(this.form,'."'$thiskey'".');"';
                   4399:                 $css_class = ' class="LC_lenient_radio"';
                   4400:             }
                   4401:             $result .= '<td class="LC_left_item"'.$colspan.'>'.
1.504     raeburn  4402:                        '<span class="LC_nobreak"><label>'.
                   4403:                        '<input type="radio" name="set_'.$thiskey.
1.552     raeburn  4404:                        '" value="'.$name.'"'.$onchange.$css_class.$disabled;
1.504     raeburn  4405:             if ($showval eq $name) {
                   4406:                 $result .= ' checked="checked"';
                   4407:             }
1.549     raeburn  4408:             $result .= ' />'.&mt($description).'</label>'.$add.'</span></td>';
1.504     raeburn  4409:             $i++;
                   4410:         }
                   4411:         $result .= '</tr>';
1.473     amueller 4412:     }
1.504     raeburn  4413:     if ($result) {
                   4414:         $result = '<table border="0">'.$result.'</table>';
1.383     albertel 4415:     }
                   4416:     return $result;
                   4417: }
                   4418: 
1.554     raeburn  4419: my %intervals =
                   4420:     (
                   4421:      'date_interval'
                   4422:              => [[ 'done', 'Yes' ],
1.558     raeburn  4423:                  [ 'done_proctor', 'Yes, with proctor key'],                  
1.554     raeburn  4424:                  [ '', 'No' ]],
                   4425:     );
                   4426: 
                   4427: my %intervalmatches = (
                   4428:          'date_interval'
1.559     raeburn  4429:               => [['done','\d+_done(|\:[^\:]+\:)$'],
                   4430:                   ['done_proctor','\d+_done(|\:[^\:]+\:)_proctor_']],
1.554     raeburn  4431:     );
                   4432: 
                   4433: my %intervaltypes = (
                   4434:                       interval => 'date_interval',
                   4435:     );
                   4436: 
1.563     damieng  4437: # Returns regular expressions to match kinds of interval type, or undef if there are none.
                   4438: #
                   4439: # @param {string} $interval_type - a parameter type for intervals
                   4440: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.554     raeburn  4441: sub standard_interval_matches {
                   4442:     my ($interval_type) = @_;
                   4443:     if (ref($intervalmatches{$interval_type}) eq 'ARRAY') {
                   4444:         return $intervalmatches{$interval_type};
                   4445:     }
                   4446:     return;
                   4447: }
                   4448: 
1.563     damieng  4449: # Returns a parameter type for a given parameter with an interval type, or undef if not known.
                   4450: #
                   4451: # @param {string} $name - parameter name
                   4452: # @returns {string}
1.554     raeburn  4453: sub get_intervaltype {
                   4454:     my ($name) = @_;
                   4455:     if (exists($intervaltypes{$name})) {
                   4456:         return $intervaltypes{$name};
                   4457:     }
                   4458:     return;
                   4459: }
                   4460: 
1.563     damieng  4461: # Returns the possible values and titles for a given interval type, or undef if there are none.
                   4462: # Used by courseprefs.
                   4463: #
                   4464: # @param {string} $interval_type - a parameter type for intervals
                   4465: # @returns {array reference} - 2D array, containing values and English titles
1.554     raeburn  4466: sub standard_interval_options {
                   4467:     my ($interval_type) = @_;
                   4468:     if (ref($intervals{$interval_type}) eq 'ARRAY') {
                   4469:         return $intervals{$interval_type};
                   4470:     }
                   4471:     return;
                   4472: }
                   4473: 
1.563     damieng  4474: # Returns HTML to edit a date interval parameter.
                   4475: #
                   4476: # @param {string} $thiskey - parameter key
                   4477: # @param {string} $name - parameter name
                   4478: # @param {string} $showval - parameter current value
                   4479: # @param {boolean} $readonly - true if the values should not be made editable
                   4480: # @returns {string}
1.554     raeburn  4481: sub date_interval_selector {
                   4482:     my ($thiskey, $name, $showval, $readonly) = @_;
                   4483:     my ($result,%skipval);
                   4484:     if ($name eq 'interval') {
                   4485:         my $intervaltype = &get_intervaltype($name);
                   4486:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   4487:         foreach my $possibilities (@{ $intervals{$intervaltype} }) {
                   4488:             next unless (ref($possibilities) eq 'ARRAY');
                   4489:             my ($parmval, $description) = @{ $possibilities };
                   4490:             my $parmmatch;
                   4491:             if (ref($intervalmatches{$intervaltype}) eq 'ARRAY') {
                   4492:                 foreach my $item (@{$intervalmatches{$intervaltype}}) {
                   4493:                     if (ref($item) eq 'ARRAY') {
                   4494:                         if ($parmval eq $item->[0]) {
                   4495:                             $parmmatch = $parmval;
                   4496:                             $parmval = '';
                   4497:                             last;
                   4498:                         }
                   4499:                     }
                   4500:                 }
                   4501:             }
                   4502:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"};
                   4503:             if ($needsrelease) {
                   4504:                 unless ($got_chostname) {
                   4505:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
                   4506:                     $got_chostname = 1;
                   4507:                 }
1.557     raeburn  4508:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.554     raeburn  4509:                                                        $needsrelease,$cmajor,$cminor);
                   4510:                 if ($needsnewer) {
                   4511:                     if ($parmmatch ne '') {
                   4512:                         $skipval{$parmmatch} = 1;
                   4513:                     } elsif ($parmval ne '') {
                   4514:                         $skipval{$parmval} = 1;
                   4515:                     }
                   4516:                 }
                   4517:             }
                   4518:         }
                   4519:     }
                   4520: 
                   4521:     my $currval = $showval;
                   4522:     foreach my $which (['days', 86400, 31],
                   4523:                ['hours', 3600, 23],
                   4524:                ['minutes', 60, 59],
                   4525:                ['seconds',  1, 59]) {
1.560     damieng  4526:         my ($name, $factor, $max) = @{ $which };
                   4527:         my $amount = int($showval/$factor);
                   4528:         $showval  %= $factor;
                   4529:         my %select = ((map {$_ => $_} (0..$max)),
                   4530:                 'select_form_order' => [0..$max]);
                   4531:         $result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey,
                   4532:                             \%select,'',$readonly);
                   4533:         $result .= ' '.&mt($name);
1.554     raeburn  4534:     }
                   4535:     if ($name eq 'interval') {
                   4536:         unless ($skipval{'done'}) {
                   4537:             my $checkedon = '';
1.558     raeburn  4538:             my $checkedproc = '';
                   4539:             my $currproctorkey = '';
                   4540:             my $currprocdisplay = 'hidden';
1.559     raeburn  4541:             my $currdonetext = &mt('Done');
1.554     raeburn  4542:             my $checkedoff = ' checked="checked"';
1.559     raeburn  4543:             if ($currval =~ /^(?:\d+)_done$/) {
                   4544:                 $checkedon = ' checked="checked"';
                   4545:                 $checkedoff = '';
                   4546:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:$/) {
                   4547:                 $currdonetext = $1;
1.554     raeburn  4548:                 $checkedon = ' checked="checked"';
                   4549:                 $checkedoff = '';
1.558     raeburn  4550:             } elsif ($currval =~ /^(?:\d+)_done_proctor_(.+)$/) {
                   4551:                 $currproctorkey = $1;
                   4552:                 $checkedproc = ' checked="checked"';
                   4553:                 $checkedoff = '';
                   4554:                 $currprocdisplay = 'text';
1.559     raeburn  4555:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:_proctor_(.+)$/) {
                   4556:                 $currdonetext = $1;
                   4557:                 $currproctorkey = $2;
                   4558:                 $checkedproc = ' checked="checked"';
                   4559:                 $checkedoff = '';
                   4560:                 $currprocdisplay = 'text';
1.554     raeburn  4561:             }
1.558     raeburn  4562:             my $onclick = ' onclick="toggleSecret(this.form,'."'done_','$thiskey'".');"';
                   4563:             $result .= '<br /><span class="LC_nobreak">'.&mt('Include "done" button').
                   4564:                        '<label><input type="radio" value="" name="done_'.$thiskey.'"'.$checkedoff.$onclick.' />'.
                   4565:                        &mt('No').'</label>'.('&nbsp;'x2).
                   4566:                        '<label><input type="radio" value="_done" name="done_'.$thiskey.'"'.$checkedon.$onclick.' />'.
                   4567:                        &mt('Yes').'</label>'.('&nbsp;'x2).
                   4568:                        '<label><input type="radio" value="_done_proctor" name="done_'.$thiskey.'"'.$checkedproc.$onclick.' />'.
                   4569:                        &mt('Yes, with proctor key').'</label>'.
                   4570:                        '<input type="'.$currprocdisplay.'" id="done_'.$thiskey.'_proctorkey" '.
1.559     raeburn  4571:                        'name="done_'.$thiskey.'_proctorkey" value="'.&HTML::Entities::encode($currproctorkey,'"<>&').'" /></span><br />'.
                   4572:                        '<span class="LC_nobreak">'.&mt('Button text').': '.
                   4573:                        '<input type="text" name="done_'.$thiskey.'_buttontext" value="'.&HTML::Entities::encode($currdonetext,'"<>&').'" /></span>';
1.554     raeburn  4574:         }
                   4575:     }
                   4576:     unless ($readonly) {
                   4577:         $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
                   4578:     }
                   4579:     return $result;
                   4580: }
                   4581: 
1.563     damieng  4582: # Returns HTML with a warning if a parameter requires a more recent version of LON-CAPA.
                   4583: #
                   4584: # @param {string} $name - parameter name
                   4585: # @param {string} $namematch - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   4586: # @param {string} $value - parameter value
                   4587: # @param {string} $chostname - course server name
                   4588: # @param {integer} $cmajor - major version number
                   4589: # @param {integer} $cminor - minor version number
                   4590: # @param {string} $needsrelease - release version needed (major.minor)
                   4591: # @returns {string}
1.549     raeburn  4592: sub oldversion_warning {
1.557     raeburn  4593:     my ($name,$namematch,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_;
                   4594:     my $standard_name = &standard_parameter_names($name);
                   4595:     if ($namematch) {
                   4596:         my $level = &standard_parameter_levels($namematch);
                   4597:         my $msg = '';
                   4598:         if ($level) {
                   4599:             $msg = &mt('[_1] was [_2]not[_3] set at the level of: [_4].',
                   4600:                        $standard_name,'<b>','</b>','"'.$level.'"');
                   4601:         } else {
                   4602:             $msg = &mt('[_1] was [_2]not[_3] set.',
                   4603:                       $standard_name,'<b>','</b>');
                   4604:         }
                   4605:         return '<p class="LC_warning">'.$msg.'<br />'.
                   4606:                &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   4607:                    $cmajor.'.'.$cminor,$chostname,
                   4608:                    $needsrelease).
                   4609:                    '</p>';
                   4610:     }
1.549     raeburn  4611:     my $desc;
                   4612:     my $stringtype = &get_stringtype($name);
                   4613:     if ($stringtype ne '') {
                   4614:         if ($name eq 'examcode') {
                   4615:             $desc = $value;
                   4616:         } elsif (ref($strings{$stringtypes{$name}}) eq 'ARRAY') {
                   4617:             foreach my $possibilities (@{ $strings{$stringtypes{$name}} }) {
                   4618:                 next unless (ref($possibilities) eq 'ARRAY');
                   4619:                 my ($parmval, $description) = @{ $possibilities };
                   4620:                 my $parmmatch;
                   4621:                 if (ref($stringmatches{$stringtypes{$name}}) eq 'ARRAY') {
                   4622:                     foreach my $item (@{$stringmatches{$stringtypes{$name}}}) {
                   4623:                         if (ref($item) eq 'ARRAY') {
                   4624:                             my ($regexpname,$pattern) = @{$item};
                   4625:                             if ($parmval eq $regexpname) {
                   4626:                                 if ($value =~ /$pattern/) {
                   4627:                                     $desc = $description; 
                   4628:                                     $parmmatch = 1;
                   4629:                                     last;
                   4630:                                 }
                   4631:                             }
                   4632:                         }
                   4633:                     }
                   4634:                     last if ($parmmatch);
                   4635:                 } elsif ($parmval eq $value) {
                   4636:                     $desc = $description;
                   4637:                     last;
                   4638:                 }
                   4639:             }
                   4640:         }
                   4641:     } elsif (($name eq 'printstartdate') || ($name eq 'printenddate')) {
                   4642:         my $now = time;
                   4643:         if ($value =~ /^\d+$/) {
                   4644:             if ($name eq 'printstartdate') {
                   4645:                 if ($value > $now) {
                   4646:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   4647:                 }
                   4648:             } elsif ($name eq 'printenddate') {
                   4649:                 if ($value < $now) {
                   4650:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   4651:                 }
                   4652:             }
                   4653:         }
                   4654:     }
                   4655:     return '<p class="LC_warning">'.
1.557     raeburn  4656:        &mt('[_1] was [_2]not[_3] set to [_4].',
                   4657:            $standard_name,'<b>','</b>','"'.$desc.'"').'<br />'.
                   4658:        &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   4659:        $cmajor.'.'.$cminor,$chostname,
                   4660:        $needsrelease).
                   4661:        '</p>';
1.549     raeburn  4662: }
                   4663: 
1.560     damieng  4664: } # end of block using some constants related to parameter types
                   4665: 
1.549     raeburn  4666: 
1.563     damieng  4667: 
                   4668: # Shifts all start and end dates in the current course by $shift.
1.389     www      4669: #
1.563     damieng  4670: # @param {integer} $shift - time to shift, in seconds
                   4671: # @returns {string} - error name or 'ok'
1.389     www      4672: sub dateshift {
                   4673:     my ($shift)=@_;
                   4674:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4675:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   4676:     my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   4677: # ugly retro fix for broken version of types
1.548     raeburn  4678:     foreach my $key (keys(%data)) {
1.389     www      4679:         if ($key=~/\wtype$/) {
                   4680:             my $newkey=$key;
                   4681:             $newkey=~s/type$/\.type/;
                   4682:             $data{$newkey}=$data{$key};
                   4683:             delete $data{$key};
                   4684:         }
                   4685:     }
1.391     www      4686:     my %storecontent=();
1.389     www      4687: # go through all parameters and look for dates
1.548     raeburn  4688:     foreach my $key (keys(%data)) {
1.389     www      4689:        if ($data{$key.'.type'}=~/^date_(start|end)$/) {
                   4690:           my $newdate=$data{$key}+$shift;
1.391     www      4691:           $storecontent{$key}=$newdate;
1.389     www      4692:        }
                   4693:     }
1.391     www      4694:     my $reply=&Apache::lonnet::cput
                   4695:                 ('resourcedata',\%storecontent,$dom,$crs);
                   4696:     if ($reply eq 'ok') {
                   4697:        &log_parmset(\%storecontent);
                   4698:     }
                   4699:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
                   4700:     return $reply;
1.389     www      4701: }
                   4702: 
1.563     damieng  4703: # Overview mode UI to edit course parameters.
                   4704: #
                   4705: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      4706: sub newoverview {
1.280     albertel 4707:     my ($r) = @_;
                   4708: 
1.208     www      4709:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4710:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  4711:     my $crstype =  $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 4712:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 4713:         text=>"Overview Mode"});
1.523     raeburn  4714: 
                   4715:     my %loaditems = (
1.549     raeburn  4716:                       'onload'   => "showHide_courseContent(); resize_scrollbox('mapmenuscroll','1','1'); showHideLenient();",
1.523     raeburn  4717:                     );
                   4718:     my $js = '
                   4719: <script type="text/javascript">
                   4720: // <![CDATA[
                   4721: '.
                   4722:             &Apache::lonhtmlcommon::resize_scrollbox_js('params')."\n".
                   4723:             &showhide_js()."\n".
1.549     raeburn  4724:             &toggleparmtextbox_js()."\n".
                   4725:             &validateparms_js()."\n".
                   4726:             &ipacc_boxes_js()."\n".
1.558     raeburn  4727:             &done_proctor_js()."\n".
1.523     raeburn  4728: '// ]]>
                   4729: </script>
                   4730: ';
1.549     raeburn  4731: 
1.523     raeburn  4732:     my $start_page = &Apache::loncommon::start_page('Set Parameters',$js,
                   4733:                                                     {'add_entries' => \%loaditems,});
1.298     albertel 4734:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      4735:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  4736:     &startSettingsScreen($r,'parmset',$crstype);
1.208     www      4737:     $r->print(<<ENDOVER);
1.549     raeburn  4738: <form method="post" action="/adm/parmset?action=newoverview" name="parmform" onsubmit="return validateParms();">
1.208     www      4739: ENDOVER
1.211     www      4740:     my @ids=();
                   4741:     my %typep=();
                   4742:     my %keyp=();
                   4743:     my %allparms=();
                   4744:     my %allparts=();
                   4745:     my %allmaps=();
                   4746:     my %mapp=();
                   4747:     my %symbp=();
                   4748:     my %maptitles=();
                   4749:     my %uris=();
                   4750:     my %keyorder=&standardkeyorder();
                   4751:     my %defkeytype=();
                   4752: 
                   4753:     my %alllevs=();
                   4754:     $alllevs{'Resource Level'}='full';
1.215     www      4755:     $alllevs{'Map/Folder Level'}='map';
1.211     www      4756:     $alllevs{'Course Level'}='general';
                   4757: 
                   4758:     my $csec=$env{'form.csec'};
1.269     raeburn  4759:     my $cgroup=$env{'form.cgroup'};
1.211     www      4760: 
                   4761:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   4762:     my $pschp=$env{'form.pschp'};
1.506     www      4763: 
1.211     www      4764:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      4765:     if (!@psprt) { $psprt[0]='all'; }
1.211     www      4766: 
1.446     bisitz   4767:     my @selected_sections =
1.473     amueller 4768:     &Apache::loncommon::get_env_multiple('form.Section');
1.211     www      4769:     @selected_sections = ('all') if (! @selected_sections);
1.374     albertel 4770:     foreach my $sec (@selected_sections) {
                   4771:         if ($sec eq 'all') {
1.211     www      4772:             @selected_sections = ('all');
                   4773:         }
                   4774:     }
1.552     raeburn  4775:     if ($env{'request.course.sec'} ne '') {
                   4776:         @selected_sections = ($env{'request.course.sec'});
                   4777:     }
1.269     raeburn  4778:     my @selected_groups =
                   4779:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      4780: 
                   4781:     my $pssymb='';
                   4782:     my $parmlev='';
1.446     bisitz   4783: 
1.211     www      4784:     unless ($env{'form.parmlev'}) {
                   4785:         $parmlev = 'map';
                   4786:     } else {
                   4787:         $parmlev = $env{'form.parmlev'};
                   4788:     }
                   4789: 
1.446     bisitz   4790:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 4791:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   4792:                 \%keyorder,\%defkeytype);
1.211     www      4793: 
1.374     albertel 4794:     if (grep {$_ eq 'all'} (@psprt)) {
1.481     amueller 4795:         @psprt = keys(%allparts);
1.374     albertel 4796:     }
1.211     www      4797: # Menu to select levels, etc
                   4798: 
1.456     bisitz   4799:     $r->print('<div class="LC_Box">');
1.445     neumanie 4800:     #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452     bisitz   4801:     $r->print('<div>');
1.523     raeburn  4802:     $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.211     www      4803:     &levelmenu($r,\%alllevs,$parmlev);
                   4804:     if ($parmlev ne 'general') {
1.447     bisitz   4805:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.483     amueller 4806:         &mapmenu($r,\%allmaps,$pschp,\%maptitles,\%symbp);
1.211     www      4807:     }
1.447     bisitz   4808:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 4809:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   4810:     $r->print('</div></div>');
1.446     bisitz   4811: 
1.456     bisitz   4812:     $r->print('<div class="LC_Box">');
1.452     bisitz   4813:     $r->print('<div>');
1.562     damieng  4814:     &displaymenu($r,\%allparms,\@pscat,\%keyorder); # FIXME: wrong parameters, could make keysindisplayorderCategory crash because $keyorder is undefined
1.453     schualex 4815:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   4816:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.553     raeburn  4817:     my $sectionselector = &sectionmenu(\@selected_sections);
                   4818:     my $groupselector = &groupmenu(\@selected_groups);
1.481     amueller 4819:     $r->print('<table>'.
1.553     raeburn  4820:               '<tr><th>'.&mt('Parts').'</th>');
                   4821:     if ($sectionselector) {
                   4822:         $r->print('<th>'.&mt('Section(s)').'</th>');
                   4823:     }
                   4824:     if ($groupselector) {
                   4825:         $r->print('<th>'.&mt('Group(s)').'</th>');
                   4826:     }
                   4827:     $r->print('</tr><tr><td>');
1.211     www      4828:     &partmenu($r,\%allparts,\@psprt);
1.553     raeburn  4829:     $r->print('</td>');
                   4830:     if ($sectionselector) { 
                   4831:         $r->print('<td>'.$sectionselector.'</td>');
                   4832:     }
                   4833:     if ($groupselector) {
                   4834:         $r->print('<td>'.$groupselector.'</td>');
                   4835:     }
                   4836:     $r->print('</tr></table>');
1.447     bisitz   4837:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 4838:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   4839:     $r->print('</div></div>');
                   4840: 
1.456     bisitz   4841:     $r->print('<div class="LC_Box">');
1.452     bisitz   4842:     $r->print('<div>');
1.214     www      4843:     my $sortorder=$env{'form.sortorder'};
                   4844:     unless ($sortorder) { $sortorder='realmstudent'; }
                   4845:     &sortmenu($r,$sortorder);
1.445     neumanie 4846:     $r->print('</div></div>');
1.446     bisitz   4847: 
1.214     www      4848:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446     bisitz   4849: 
1.211     www      4850: # Build the list data hash from the specified parms
                   4851: 
                   4852:     my $listdata;
                   4853:     %{$listdata}=();
                   4854: 
                   4855:     foreach my $cat (@pscat) {
1.269     raeburn  4856:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   4857:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      4858:     }
                   4859: 
1.212     www      4860:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      4861: 
1.481     amueller 4862:         if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      4863: 
                   4864: # Read modified data
                   4865: 
1.481     amueller 4866:         my $resourcedata=&readdata($crs,$dom);
1.211     www      4867: 
                   4868: # List data
                   4869: 
1.552     raeburn  4870:         &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview');
1.211     www      4871:     }
                   4872:     $r->print(&tableend().
1.473     amueller 4873:          ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'').
1.507     www      4874:           '</form>');
                   4875:     &endSettingsScreen($r);
                   4876:     $r->print(&Apache::loncommon::end_page());
1.208     www      4877: }
                   4878: 
1.563     damieng  4879: # Fills $listdata with parameter information.
                   4880: # Keys use the format course id.[section id].part.name and course id.[section id].part.name.type.
                   4881: # The non-type value is always 1.
                   4882: #
                   4883: # @param {string} $cat - parameter name
                   4884: # @param {string} $pschp - selected map id, or 'all'
                   4885: # @param {string} $parmlev - selected level value (full|map|general), or ''
                   4886: # @param {hash reference} $listdata - the parameter data that will be modified
                   4887: # @param {array reference} $psprt - selected parts
                   4888: # @param {array reference} $selections - selected sections
                   4889: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
                   4890: # @param {hash reference} $allmaps - hash map id -> map src
                   4891: # @param {array reference} $ids - resource ids
                   4892: # @param {hash reference} $symbp - hash map id or resource id -> map src.'___(all)' for a map or resource symb for a resource
1.269     raeburn  4893: sub secgroup_lister {
                   4894:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   4895:     foreach my $item (@{$selections}) {
                   4896:         foreach my $part (@{$psprt}) {
                   4897:             my $rootparmkey=$env{'request.course.id'};
                   4898:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   4899:                 $rootparmkey.='.['.$item.']';
                   4900:             }
                   4901:             if ($parmlev eq 'general') {
                   4902: # course-level parameter
                   4903:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   4904:                 $$listdata{$newparmkey}=1;
                   4905:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   4906:             } elsif ($parmlev eq 'map') {
                   4907: # map-level parameter
1.548     raeburn  4908:                 foreach my $mapid (keys(%{$allmaps})) {
1.269     raeburn  4909:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   4910:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   4911:                     $$listdata{$newparmkey}=1;
                   4912:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
1.556     raeburn  4913:                     $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(rec).'.$part.'.'.$cat;
                   4914:                     $$listdata{$newparmkey}=1;
                   4915:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
1.269     raeburn  4916:                 }
                   4917:             } else {
                   4918: # resource-level parameter
                   4919:                 foreach my $rid (@{$ids}) {
                   4920:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   4921:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   4922:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   4923:                     $$listdata{$newparmkey}=1;
                   4924:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   4925:                 }
                   4926:             }
                   4927:         }
                   4928:     }
                   4929: }
                   4930: 
1.563     damieng  4931: # UI to edit parameter settings starting with a list of all existing parameters.
                   4932: # (called by setoverview action)
                   4933: #
                   4934: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      4935: sub overview {
1.280     albertel 4936:     my ($r) = @_;
1.208     www      4937:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4938:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  4939:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.549     raeburn  4940:     my $js = '<script type="text/javascript">'."\n".
                   4941:              '// <![CDATA['."\n".
                   4942:              &toggleparmtextbox_js()."\n".
                   4943:              &validateparms_js()."\n".
                   4944:              &ipacc_boxes_js()."\n".
1.558     raeburn  4945:              &done_proctor_js()."\n".
1.549     raeburn  4946:              '// ]]>'."\n".
                   4947:              '</script>'."\n";
1.414     droeschl 4948:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 4949:     text=>"Overview Mode"});
1.549     raeburn  4950:     my %loaditems = (
                   4951:                       'onload'   => "showHideLenient();",
                   4952:                     );
                   4953: 
                   4954:     my $start_page=&Apache::loncommon::start_page('Modify Parameters',$js,{'add_entries' => \%loaditems,});
1.298     albertel 4955:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      4956:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  4957:     &startSettingsScreen($r,'parmset',$crstype);
1.549     raeburn  4958:     $r->print('<form method="post" action="/adm/parmset?action=setoverview" name="parmform" onsubmit="return validateParms();">');
1.507     www      4959: 
1.208     www      4960: # Store modified
                   4961: 
                   4962:     &storedata($r,$crs,$dom);
                   4963: 
                   4964: # Read modified data
                   4965: 
1.552     raeburn  4966:     my ($resourcedata,$classlist)=&readdata($crs,$dom);
1.208     www      4967: 
1.214     www      4968: 
                   4969:     my $sortorder=$env{'form.sortorder'};
                   4970:     unless ($sortorder) { $sortorder='realmstudent'; }
                   4971:     &sortmenu($r,$sortorder);
                   4972: 
1.208     www      4973: # List data
                   4974: 
1.552     raeburn  4975:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist);
1.145     www      4976:     $r->print(&tableend().'<p>'.
1.527     bisitz   4977:     ($foundkeys?'<input type="submit" value="'.&mt('Save').'" />':'<span class="LC_info">'.&mt('There are no parameters.').'</span>').'</p></form>'.
1.473     amueller 4978:           &Apache::loncommon::end_page());
1.120     www      4979: }
1.121     www      4980: 
1.560     damieng  4981: # Unused sub.
1.563     damieng  4982: #
                   4983: # @param {Apache2::RequestRec} $r - the Apache request
1.333     albertel 4984: sub clean_parameters {
                   4985:     my ($r) = @_;
                   4986:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4987:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   4988: 
1.414     droeschl 4989:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
1.473     amueller 4990:         text=>"Clean Parameters"});
1.333     albertel 4991:     my $start_page=&Apache::loncommon::start_page('Clean Parameters');
                   4992:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
                   4993:     $r->print(<<ENDOVER);
                   4994: $start_page
                   4995: $breadcrumbs
                   4996: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
                   4997: ENDOVER
                   4998: # Store modified
                   4999: 
                   5000:     &storedata($r,$crs,$dom);
                   5001: 
                   5002: # Read modified data
                   5003: 
                   5004:     my $resourcedata=&readdata($crs,$dom);
                   5005: 
                   5006: # List data
                   5007: 
                   5008:     $r->print('<h3>'.
1.473     amueller 5009:           &mt('These parameters refer to resources that do not exist.').
                   5010:           '</h3>'.
                   5011:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
                   5012:           '<br />');
1.333     albertel 5013:     $r->print(&Apache::loncommon::start_data_table().
1.473     amueller 5014:           '<tr>'.
                   5015:           '<th>'.&mt('Delete').'</th>'.
                   5016:           '<th>'.&mt('Parameter').'</th>'.
                   5017:           '</tr>');
1.333     albertel 5018:     foreach my $thiskey (sort(keys(%{$resourcedata}))) {
1.560     damieng  5019:         next if (!exists($resourcedata->{$thiskey.'.type'})
                   5020:             && $thiskey=~/\.type$/);
                   5021:         my %data = &parse_key($thiskey);
                   5022:         if (1) { #exists($data{'realm_exists'})
                   5023:             #&& !$data{'realm_exists'}) {
                   5024:             $r->print(&Apache::loncommon::start_data_table_row().
                   5025:                 '<tr>'.
                   5026:                 '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>'              );
                   5027: 
                   5028:             $r->print('<td>');
                   5029:             my $display_value = $resourcedata->{$thiskey};
                   5030:             if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
                   5031:             $display_value =
                   5032:                 &Apache::lonlocal::locallocaltime($display_value);
                   5033:             }
1.470     raeburn  5034:             my $parmitem = &standard_parameter_names($data{'parameter_name'});
                   5035:             $parmitem = &mt($parmitem);
1.560     damieng  5036:             $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
                   5037:                 $parmitem,$resourcedata->{$thiskey}));
                   5038:             $r->print('<br />');
                   5039:             if ($data{'scope_type'} eq 'all') {
                   5040:                 $r->print(&mt('All users'));
                   5041:             } elsif ($data{'scope_type'} eq 'user') {
                   5042:                 $r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
                   5043:             } elsif ($data{'scope_type'} eq 'section') {
                   5044:                 $r->print(&mt('Section: [_1]',$data{'scope'}));
                   5045:             } elsif ($data{'scope_type'} eq 'group') {
                   5046:                 $r->print(&mt('Group: [_1]',$data{'scope'}));
                   5047:             }
                   5048:             $r->print('<br />');
                   5049:             if ($data{'realm_type'} eq 'all') {
                   5050:                 $r->print(&mt('All Resources'));
                   5051:             } elsif ($data{'realm_type'} eq 'folder') {
                   5052:                 $r->print(&mt('Folder: [_1]'),$data{'realm'});
                   5053:             } elsif ($data{'realm_type'} eq 'symb') {
                   5054:             my ($map,$resid,$url) =
                   5055:                 &Apache::lonnet::decode_symb($data{'realm'});
                   5056:             $r->print(&mt('Resource: [_1]with ID: [_2]in folder [_3]',
                   5057:                         $url.' <br />&nbsp;&nbsp;&nbsp;',
                   5058:                         $resid.' <br />&nbsp;&nbsp;&nbsp;',$map));
                   5059:             }
                   5060:             $r->print(' <br />&nbsp;&nbsp;&nbsp;'.&mt('Part: [_1]',$data{'parameter_part'}));
                   5061:             $r->print('</td></tr>');
                   5062: 
1.473     amueller 5063:         }
1.333     albertel 5064:     }
                   5065:     $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.473     amueller 5066:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.
1.507     www      5067:           '</p></form>');
                   5068:     &endSettingsScreen($r);
                   5069:     $r->print(&Apache::loncommon::end_page());
1.333     albertel 5070: }
                   5071: 
1.563     damieng  5072: # UI to shift all dates (called by dateshift1 action).
                   5073: # Used by overview mode.
                   5074: #
                   5075: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5076: sub date_shift_one {
                   5077:     my ($r) = @_;
                   5078:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5079:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5080:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.390     www      5081: 
1.414     droeschl 5082:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5083:         text=>"Shifting Dates"});
1.390     www      5084:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5085:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5086:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5087:     &startSettingsScreen($r,'parmset',$crstype);
1.538     bisitz   5088:     $r->print('<form name="shiftform" method="post" action="">'.
1.390     www      5089:               '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
                   5090:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
                   5091:               '<tr><td>'.&mt('Shifted date:').'</td><td>'.
1.541     bisitz   5092:                     &Apache::lonhtmlcommon::date_setter('shiftform',
1.390     www      5093:                                                         'timeshifted',
                   5094:                                                         $env{'form.timebase'},,
                   5095:                                                         '').
                   5096:               '</td></tr></table>'.
                   5097:               '<input type="hidden" name="action" value="dateshift2" />'.
                   5098:               '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
                   5099:               '<input type="submit" value="'.&mt('Shift all dates accordingly').'" /></form>');
1.507     www      5100:     &endSettingsScreen($r);
1.390     www      5101:     $r->print(&Apache::loncommon::end_page());
                   5102: }
                   5103: 
1.563     damieng  5104: # UI to shift all dates (second form).
                   5105: #
                   5106: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5107: sub date_shift_two {
                   5108:     my ($r) = @_;
                   5109:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5110:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5111:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 5112:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5113:         text=>"Shifting Dates"});
1.390     www      5114:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5115:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5116:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5117:     &startSettingsScreen($r,'parmset',$crstype);
1.390     www      5118:     my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
1.543     bisitz   5119:     $r->print('<h2>'.&mt('Shift Dates').'</h2>'.
                   5120:               '<p>'.&mt('Shifting all dates such that [_1] becomes [_2]',
1.390     www      5121:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
1.543     bisitz   5122:               &Apache::lonlocal::locallocaltime($timeshifted)).'</p>');
1.390     www      5123:     my $delta=$timeshifted-$env{'form.timebase'};
                   5124:     &dateshift($delta);
1.543     bisitz   5125:     $r->print(
                   5126:         &Apache::lonhtmlcommon::confirm_success(&mt('Done')).
                   5127:         '<br /><br />'.
                   5128:         &Apache::lonhtmlcommon::actionbox(
                   5129:             ['<a href="/adm/parmset">'.&mt('Content and Problem Settings').'</a>']));
1.507     www      5130:     &endSettingsScreen($r);
1.390     www      5131:     $r->print(&Apache::loncommon::end_page());
                   5132: }
                   5133: 
1.563     damieng  5134: # Returns the different components of a resourcedata key.
                   5135: # Keys: scope_type, scope, realm_type, realm, realm_title,
                   5136: #       realm_exists, parameter_part, parameter_name.
                   5137: # Was used by clean_parameters (which is unused).
                   5138: #
                   5139: # @param {string} $key - the parameter key
                   5140: # @returns {hash}
1.333     albertel 5141: sub parse_key {
                   5142:     my ($key) = @_;
                   5143:     my %data;
                   5144:     my ($middle,$part,$name)=
1.473     amueller 5145:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.333     albertel 5146:     $data{'scope_type'} = 'all';
                   5147:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  5148:         $data{'scope'} = $1;
                   5149:         if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
                   5150:             $data{'scope_type'} = 'user';
                   5151:             $data{'scope'} = [$1,$2];
                   5152:         } else {
                   5153:             #FIXME check for group scope
                   5154:             $data{'scope_type'} = 'section';
                   5155:         }
                   5156:         $middle=~s/^\[(.*)\]//;
1.333     albertel 5157:     }
                   5158:     $middle=~s/\.+$//;
                   5159:     $middle=~s/^\.+//;
                   5160:     $data{'realm_type'}='all';
                   5161:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.560     damieng  5162:         $data{'realm'} = $1;
                   5163:         $data{'realm_type'} = 'folder';
                   5164:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5165:         ($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
1.333     albertel 5166:     } elsif ($middle) {
1.560     damieng  5167:         $data{'realm'} = $middle;
                   5168:         $data{'realm_type'} = 'symb';
                   5169:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5170:         my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
                   5171:         $data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
1.333     albertel 5172:     }
1.446     bisitz   5173: 
1.333     albertel 5174:     $data{'parameter_part'} = $part;
                   5175:     $data{'parameter_name'} = $name;
                   5176: 
                   5177:     return %data;
                   5178: }
                   5179: 
1.239     raeburn  5180: 
1.563     damieng  5181: # Calls loncommon::start_page with the "Settings" title.
1.416     jms      5182: sub header {
1.507     www      5183:     return &Apache::loncommon::start_page('Settings');
1.416     jms      5184: }
1.193     albertel 5185: 
                   5186: 
                   5187: 
1.560     damieng  5188: ##################################################
                   5189: # MAIN MENU
                   5190: ##################################################
                   5191: 
1.563     damieng  5192: # Content and problem settings main menu.
                   5193: #
                   5194: # @param {Apache2::RequestRec} $r - the Apache request
                   5195: # @param {boolean} $parm_permission - true if the user has permission to edit the current course or section
1.193     albertel 5196: sub print_main_menu {
                   5197:     my ($r,$parm_permission)=@_;
                   5198:     #
1.414     droeschl 5199:     $r->print(&header());
1.507     www      5200:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Content and Problem Settings'));
1.531     raeburn  5201:     my $crstype = &Apache::loncommon::course_type();
                   5202:     my $lc_crstype = lc($crstype);
                   5203: 
                   5204:     &startSettingsScreen($r,'parmset',$crstype);
1.193     albertel 5205:     $r->print(<<ENDMAINFORMHEAD);
                   5206: <form method="post" enctype="multipart/form-data"
                   5207:       action="/adm/parmset" name="studentform">
                   5208: ENDMAINFORMHEAD
                   5209: #
1.195     albertel 5210:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5211:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 5212:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366     albertel 5213:     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.520     raeburn  5214:     my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});
                   5215:     if ((!$dcm) && ($env{'request.course.sec'} ne '')) {
                   5216:         $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.
                   5217:                                         '/'.$env{'request.course.sec'});
                   5218:     }
1.268     albertel 5219: 
1.193     albertel 5220:     my @menu =
1.507     www      5221:         ( { categorytitle=>"Content Settings for this $crstype",
1.473     amueller 5222:         items => [
                   5223:           { linktext => 'Portfolio Metadata',
                   5224:             url => '/adm/parmset?action=setrestrictmeta',
                   5225:             permission => $parm_permission,
1.477     raeburn  5226:             linktitle => "Restrict metadata for this $lc_crstype." ,
1.473     amueller 5227:             icon =>'contact-new.png'   ,
                   5228:             },
                   5229:           { linktext => 'Reset Student Access Times',
                   5230:             url => '/adm/helper/resettimes.helper',
                   5231:             permission => $mgr,
1.477     raeburn  5232:             linktitle => "Reset access times for folders/maps, resources or the $lc_crstype."  ,
1.473     amueller 5233:             icon => 'start-here.png'  ,
                   5234:             },
1.520     raeburn  5235:           { linktext => 'Blocking Communication/Resource Access',
                   5236:             url => '/adm/setblock',
                   5237:             permission => $dcm,
                   5238:             linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',
                   5239:             icon => 'comblock.png',
                   5240:             },
1.473     amueller 5241:           { linktext => 'Set Parameter Setting Default Actions',
                   5242:             url => '/adm/parmset?action=setdefaults',
                   5243:             permission => $parm_permission,
                   5244:             linktitle =>'Set default actions for parameters.'  ,
                   5245:             icon => 'folder-new.png'  ,
                   5246:             }]},
                   5247:       { categorytitle => 'New and Existing Parameter Settings for Resources',
                   5248:         items => [
                   5249:           { linktext => 'Edit Resource Parameters - Helper Mode',
                   5250:             url => '/adm/helper/parameter.helper',
                   5251:             permission => $parm_permission,
                   5252:             linktitle =>'Set/Modify resource parameters in helper mode.'  ,
                   5253:             icon => 'dialog-information.png'  ,
                   5254:             #help => 'Parameter_Helper',
                   5255:             },
                   5256:           { linktext => 'Edit Resource Parameters - Overview Mode',
                   5257:             url => '/adm/parmset?action=newoverview',
                   5258:             permission => $parm_permission,
                   5259:             linktitle =>'Set/Modify resource parameters in overview mode.'  ,
                   5260:             icon => 'edit-find.png'  ,
                   5261:             #help => 'Parameter_Overview',
                   5262:             },
                   5263:           { linktext => 'Edit Resource Parameters - Table Mode',
                   5264:             url => '/adm/parmset?action=settable',
                   5265:             permission => $parm_permission,
                   5266:             linktitle =>'Set/Modify resource parameters in table mode.'  ,
                   5267:             icon => 'edit-copy.png'  ,
                   5268:             #help => 'Table_Mode',
                   5269:             }]},
1.417     droeschl 5270:            { categorytitle => 'Existing Parameter Settings for Resources',
1.473     amueller 5271:          items => [
                   5272:           { linktext => 'Modify Resource Parameters - Overview Mode',
                   5273:             url => '/adm/parmset?action=setoverview',
                   5274:             permission => $parm_permission,
                   5275:             linktitle =>'Set/Modify existing resource parameters in overview mode.'  ,
                   5276:             icon => 'preferences-desktop-wallpaper.png'  ,
                   5277:             #help => 'Parameter_Overview',
                   5278:             },
                   5279:           { linktext => 'Change Log',
                   5280:             url => '/adm/parmset?action=parameterchangelog',
                   5281:             permission => $parm_permission,
1.477     raeburn  5282:             linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,
1.487     wenzelju 5283:             icon => 'document-properties.png',
1.473     amueller 5284:             }]}
1.193     albertel 5285:           );
1.414     droeschl 5286:     $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.539     raeburn  5287:     $r->print('</form>');
1.507     www      5288:     &endSettingsScreen($r);
1.539     raeburn  5289:     $r->print(&Apache::loncommon::end_page());
1.193     albertel 5290:     return;
                   5291: }
1.414     droeschl 5292: 
1.416     jms      5293: 
                   5294: 
1.560     damieng  5295: ##################################################
                   5296: # PORTFOLIO METADATA
                   5297: ##################################################
                   5298: 
1.563     damieng  5299: # Prints HTML to edit an item of portfolio metadata. The HTML contains several td elements (no tr).
                   5300: # It looks like field titles are not localized.
                   5301: #
                   5302: # @param {Apache2::RequestRec} $r - the Apache request
                   5303: # @param {string} $field_name - metadata field name
                   5304: # @param {string} $field_text - metadata field title, in English unless manually added
                   5305: # @param {boolean} $added_flag - true if the field was manually added
1.252     banghart 5306: sub output_row {
1.347     banghart 5307:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 5308:     my $output;
1.263     banghart 5309:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   5310:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 5311:     if (!defined($options)) {
1.254     banghart 5312:         $options = 'active,stuadd';
1.261     banghart 5313:         $values = '';
1.252     banghart 5314:     }
1.337     banghart 5315:     if (!($options =~ /deleted/)) {
                   5316:         my @options= ( ['active', 'Show to student'],
1.418     schafran 5317:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 5318:                     ['choices','Provide choices for students to select from']);
1.473     amueller 5319: #           ['onlyone','Student may select only one choice']);
1.337     banghart 5320:         if ($added_flag) {
                   5321:             push @options,['deleted', 'Delete Metadata Field'];
                   5322:         }
1.351     banghart 5323:        $output = &Apache::loncommon::start_data_table_row();
1.451     bisitz   5324:         $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351     banghart 5325:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 5326:         foreach my $opt (@options) {
1.560     damieng  5327:             my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   5328:             $output .= &Apache::loncommon::continue_data_table_row();
                   5329:             $output .= '<td>'.('&nbsp;' x 5).'<label>
                   5330:                     <input type="checkbox" name="'.
                   5331:                     $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   5332:                     &mt($opt->[1]).'</label></td>';
                   5333:             $output .= &Apache::loncommon::end_data_table_row();
                   5334:         }
1.351     banghart 5335:         $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   5336:         $output .= '<td>'.('&nbsp;' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351     banghart 5337:         $output .= &Apache::loncommon::end_data_table_row();
                   5338:         my $multiple_checked;
                   5339:         my $single_checked;
                   5340:         if ($options =~ m/onlyone/) {
1.422     bisitz   5341:             $multiple_checked = '';
1.423     bisitz   5342:             $single_checked = ' checked="checked"';
1.351     banghart 5343:         } else {
1.423     bisitz   5344:             $multiple_checked = ' checked="checked"';
1.422     bisitz   5345:             $single_checked = '';
1.351     banghart 5346:         }
1.560     damieng  5347:         $output .= &Apache::loncommon::continue_data_table_row();
                   5348:         $output .= '<td>'.('&nbsp;' x 10).'
                   5349:                     <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
                   5350:                     '.&mt('Student may select multiple choices from list').'</td>';
                   5351:         $output .= &Apache::loncommon::end_data_table_row();
                   5352:         $output .= &Apache::loncommon::continue_data_table_row();
                   5353:         $output .= '<td>'.('&nbsp;' x 10).'
                   5354:                     <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />
                   5355:                     '.&mt('Student may select only one choice from list').'</td>';
                   5356:         $output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 5357:     }
                   5358:     return ($output);
                   5359: }
1.416     jms      5360: 
                   5361: 
1.560     damieng  5362: # UI to order portfolio metadata fields.
1.563     damieng  5363: # Currently useless because addmetafield does not work.
                   5364: #
                   5365: # @param {Apache2::RequestRec} $r - the Apache request
1.340     banghart 5366: sub order_meta_fields {
                   5367:     my ($r)=@_;
                   5368:     my $idx = 1;
                   5369:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5370:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5371:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};;
1.341     banghart 5372:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.560     damieng  5373:     &Apache::lonhtmlcommon::add_breadcrumb(
                   5374:         {href=>'/adm/parmset?action=addmetadata',
1.473     amueller 5375:         text=>"Add Metadata Field"});
1.560     damieng  5376:     &Apache::lonhtmlcommon::add_breadcrumb(
                   5377:         {href=>"/adm/parmset?action=setrestrictmeta",
                   5378:         text=>"Restrict Metadata"},
                   5379:         {text=>"Order Metadata"});
1.345     banghart 5380:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.531     raeburn  5381:     &startSettingsScreen($r,'parmset',$crstype);
1.340     banghart 5382:     if ($env{'form.storeorder'}) {
                   5383:         my $newpos = $env{'form.newpos'} - 1;
                   5384:         my $currentpos = $env{'form.currentpos'} - 1;
                   5385:         my @neworder = ();
1.548     raeburn  5386:         my @oldorder = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 5387:         my $i;
1.341     banghart 5388:         if ($newpos > $currentpos) {
1.340     banghart 5389:         # moving stuff up
                   5390:             for ($i=0;$i<$currentpos;$i++) {
1.560     damieng  5391:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 5392:             }
                   5393:             for ($i=$currentpos;$i<$newpos;$i++) {
1.560     damieng  5394:                 $neworder[$i]=$oldorder[$i+1];
1.340     banghart 5395:             }
                   5396:             $neworder[$newpos]=$oldorder[$currentpos];
                   5397:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
1.560     damieng  5398:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 5399:             }
                   5400:         } else {
                   5401:         # moving stuff down
1.473     amueller 5402:             for ($i=0;$i<$newpos;$i++) {
                   5403:                 $neworder[$i]=$oldorder[$i];
                   5404:             }
                   5405:             $neworder[$newpos]=$oldorder[$currentpos];
                   5406:             for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   5407:                 $neworder[$i]=$oldorder[$i-1];
                   5408:             }
                   5409:             for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   5410:                 $neworder[$i]=$oldorder[$i];
                   5411:             }
1.340     banghart 5412:         }
1.560     damieng  5413:         my $ordered_fields = join ",", @neworder;
1.343     banghart 5414:         my $put_result = &Apache::lonnet::put('environment',
1.560     damieng  5415:                         {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   5416:         &Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 5417:     }
1.357     raeburn  5418:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 5419:     my $ordered_fields;
1.548     raeburn  5420:     my @fields_in_order = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 5421:     if (!@fields_in_order) {
                   5422:         # no order found, pick sorted order then create metadata.addedorder key.
1.548     raeburn  5423:         foreach my $key (sort(keys(%$fields))) {
1.340     banghart 5424:             push @fields_in_order, $key;
1.341     banghart 5425:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 5426:         }
1.341     banghart 5427:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   5428:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   5429:     }
1.340     banghart 5430:     $r->print('<table>');
                   5431:     my $num_fields = scalar(@fields_in_order);
                   5432:     foreach my $key (@fields_in_order) {
                   5433:         $r->print('<tr><td>');
                   5434:         $r->print('<form method="post" action="">');
1.537     bisitz   5435:         $r->print('<select name="newpos" onchange="this.form.submit()">');
1.340     banghart 5436:         for (my $i = 1;$i le $num_fields;$i ++) {
                   5437:             if ($i eq $idx) {
                   5438:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   5439:             } else {
                   5440:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   5441:             }
                   5442:         }
                   5443:         $r->print('</select></td><td>');
                   5444:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   5445:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   5446:         $r->print('</form>');
                   5447:         $r->print($$fields{$key}.'</td></tr>');
                   5448:         $idx ++;
                   5449:     }
                   5450:     $r->print('</table>');
1.507     www      5451:     &endSettingsScreen($r);
1.340     banghart 5452:     return 'ok';
                   5453: }
1.416     jms      5454: 
                   5455: 
1.563     damieng  5456: # Returns HTML with a Continue button redirecting to the initial portfolio metadata screen.
                   5457: # @returns {string}
1.359     banghart 5458: sub continue {
                   5459:     my $output;
                   5460:     $output .= '<form action="" method="post">';
                   5461:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
                   5462:     $output .= '<input type="submit" value="Continue" />';
                   5463:     return ($output);
                   5464: }
1.416     jms      5465: 
                   5466: 
1.563     damieng  5467: # UI to add a metadata field.
                   5468: # Currenly does not work because of an HTML error (the field is not visible).
                   5469: #
                   5470: # @param {Apache2::RequestRec} $r - the Apache request
1.334     banghart 5471: sub addmetafield {
                   5472:     my ($r)=@_;
1.414     droeschl 5473:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 5474:         text=>"Add Metadata Field"});
1.334     banghart 5475:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   5476:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 5477:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5478:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5479:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   5480:     &startSettingsScreen($r,'parmset',$crstype);
1.339     banghart 5481:     if (exists($env{'form.undelete'})) {
1.358     banghart 5482:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 5483:         foreach my $meta_field(@meta_fields) {
                   5484:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   5485:             $options =~ s/deleted//;
                   5486:             $options =~ s/,,/,/;
                   5487:             my $put_result = &Apache::lonnet::put('environment',
                   5488:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446     bisitz   5489: 
1.339     banghart 5490:             $r->print('Undeleted Metadata Field <strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}."</strong> with result ".$put_result.'<br />');
                   5491:         }
1.359     banghart 5492:         $r->print(&continue());
1.339     banghart 5493:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 5494:         my $meta_field = $env{'form.fieldname'};
                   5495:         my $display_field = $env{'form.fieldname'};
                   5496:         $meta_field =~ s/\W/_/g;
1.338     banghart 5497:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 5498:         my $put_result = &Apache::lonnet::put('environment',
                   5499:                             {'metadata.'.$meta_field.'.values'=>"",
                   5500:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   5501:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.359     banghart 5502:         $r->print('Added new Metadata Field <strong>'.$env{'form.fieldname'}."</strong> with result ".$put_result.'<br />');
                   5503:         $r->print(&continue());
1.335     banghart 5504:     } else {
1.357     raeburn  5505:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 5506:         if ($fields) {
                   5507:             $r->print('You may undelete previously deleted fields.<br />Check those you wish to undelete and click Undelete.<br />');
                   5508:             $r->print('<form method="post" action="">');
                   5509:             foreach my $key(keys(%$fields)) {
1.358     banghart 5510:                 $r->print('<input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'<br /');
1.339     banghart 5511:             }
                   5512:             $r->print('<input type="submit" name="undelete" value="Undelete" />');
                   5513:             $r->print('</form>');
                   5514:         }
1.563     damieng  5515:         $r->print('<hr /><strong>Or</strong> you may enter a new metadata field name.<form method="post" action="/adm/parmset?action=addmetadata"'); # FIXME: HTML error, input will not be displayed !
1.335     banghart 5516:         $r->print('<input type="text" name="fieldname" /><br />');
                   5517:         $r->print('<input type="submit" value="Add Metadata Field" />');
1.334     banghart 5518:     }
1.361     albertel 5519:     $r->print('</form>');
1.507     www      5520:     &endSettingsScreen($r);
1.334     banghart 5521: }
1.416     jms      5522: 
                   5523: 
                   5524: 
1.560     damieng  5525: # Display or save portfolio metadata.
1.563     damieng  5526: #
                   5527: # @param {Apache2::RequestRec} $r - the Apache request
1.259     banghart 5528: sub setrestrictmeta {
1.240     banghart 5529:     my ($r)=@_;
1.242     banghart 5530:     my $next_meta;
1.244     banghart 5531:     my $output;
1.245     banghart 5532:     my $item_num;
1.246     banghart 5533:     my $put_result;
1.414     droeschl 5534:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
1.473     amueller 5535:         text=>"Restrict Metadata"});
1.280     albertel 5536:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 5537:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 5538:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5539:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5540:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   5541:     &startSettingsScreen($r,'parmset',$crstype);
1.259     banghart 5542:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 5543:     my $save_field = '';
1.259     banghart 5544:     if ($env{'form.restrictmeta'}) {
1.254     banghart 5545:         foreach my $field (sort(keys(%env))) {
1.252     banghart 5546:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 5547:                 my $options;
1.252     banghart 5548:                 my $meta_field = $1;
                   5549:                 my $meta_key = $2;
1.253     banghart 5550:                 if ($save_field ne $meta_field) {
1.252     banghart 5551:                     $save_field = $meta_field;
1.473     amueller 5552:                     if ($env{'form.'.$meta_field.'_stuadd'}) {
                   5553:                         $options.='stuadd,';
                   5554:                     }
                   5555:                     if ($env{'form.'.$meta_field.'_choices'}) {
                   5556:                         $options.='choices,';
                   5557:                     }
                   5558:                     if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
                   5559:                         $options.='onlyone,';
                   5560:                     }
                   5561:                     if ($env{'form.'.$meta_field.'_active'}) {
                   5562:                         $options.='active,';
                   5563:                     }
                   5564:                     if ($env{'form.'.$meta_field.'_deleted'}) {
                   5565:                         $options.='deleted,';
                   5566:                     }
1.259     banghart 5567:                     my $name = $save_field;
1.560     damieng  5568:                     $put_result = &Apache::lonnet::put('environment',
                   5569:                         {'metadata.'.$meta_field.'.options'=>$options,
                   5570:                         'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
                   5571:                         },$dom,$crs);
1.252     banghart 5572:                 }
                   5573:             }
                   5574:         }
                   5575:     }
1.296     albertel 5576:     &Apache::lonnet::coursedescription($env{'request.course.id'},
1.473     amueller 5577:                        {'freshen_cache' => 1});
1.335     banghart 5578:     # Get the default metadata fields
1.258     albertel 5579:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 5580:     # Now get possible added metadata fields
1.357     raeburn  5581:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.346     banghart 5582:     my $row_alt = 1;
1.347     banghart 5583:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 5584:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 5585:         if ($field ne 'courserestricted') {
1.346     banghart 5586:             $row_alt = $row_alt ? 0 : 1;
1.560     damieng  5587:             $output.= &output_row($r, $field, $metadata_fields{$field});
                   5588:         }
1.255     banghart 5589:     }
1.351     banghart 5590:     my $buttons = (<<ENDButtons);
                   5591:         <input type="submit" name="restrictmeta" value="Save" />
                   5592:         </form><br />
                   5593:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
                   5594:         <input type="submit" name="restrictmeta" value="Add a Metadata Field" />
                   5595:         </form>
                   5596:         <br />
                   5597:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
                   5598:         <input type="submit" name="restrictmeta" value="Order Metadata Fields" />
                   5599: ENDButtons
1.337     banghart 5600:     my $added_flag = 1;
1.335     banghart 5601:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.346     banghart 5602:         $row_alt = $row_alt ? 0 : 1;
1.563     damieng  5603:         $output.= &output_row($r, $field, $$added_metadata_fields{$field},$added_flag, $row_alt); # FIXME: wrong parameters
1.335     banghart 5604:     }
1.347     banghart 5605:     $output .= &Apache::loncommon::end_data_table();
1.446     bisitz   5606:     $r->print(<<ENDenv);
1.259     banghart 5607:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 5608:         $output
1.351     banghart 5609:         $buttons
1.340     banghart 5610:         </form>
1.244     banghart 5611: ENDenv
1.507     www      5612:     &endSettingsScreen($r);
1.280     albertel 5613:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 5614:     return 'ok';
                   5615: }
1.416     jms      5616: 
                   5617: 
1.563     damieng  5618: # Returns metadata fields that have been manually added.
                   5619: #
                   5620: # @param {string} $cid - course id
                   5621: # @returns {hash reference} - hash field name -> field title (not localized)
1.335     banghart 5622: sub get_added_meta_fieldnames {
1.357     raeburn  5623:     my ($cid) = @_;
1.335     banghart 5624:     my %fields;
                   5625:     foreach my $key(%env) {
1.357     raeburn  5626:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 5627:             my $field_name = $1;
                   5628:             my ($display_field_name) = $env{$key};
                   5629:             $fields{$field_name} = $display_field_name;
                   5630:         }
                   5631:     }
                   5632:     return \%fields;
                   5633: }
1.416     jms      5634: 
                   5635: 
1.563     damieng  5636: # Returns metadata fields that have been manually added and deleted.
                   5637: #
                   5638: # @param {string} $cid - course id
                   5639: # @returns {hash reference} - hash field name -> field title (not localized)
1.339     banghart 5640: sub get_deleted_meta_fieldnames {
1.357     raeburn  5641:     my ($cid) = @_;
1.339     banghart 5642:     my %fields;
                   5643:     foreach my $key(%env) {
1.357     raeburn  5644:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 5645:             my $field_name = $1;
                   5646:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   5647:                 my ($display_field_name) = $env{$key};
                   5648:                 $fields{$field_name} = $display_field_name;
                   5649:             }
                   5650:         }
                   5651:     }
                   5652:     return \%fields;
                   5653: }
1.560     damieng  5654: 
                   5655: 
                   5656: ##################################################
                   5657: # PARAMETER SETTINGS DEFAULT ACTIONS
                   5658: ##################################################
                   5659: 
                   5660: # UI to change parameter setting default actions
1.563     damieng  5661: #
                   5662: # @param {Apache2::RequestRec} $r - the Apache request
1.220     www      5663: sub defaultsetter {
1.280     albertel 5664:     my ($r) = @_;
                   5665: 
1.414     droeschl 5666:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
1.473     amueller 5667:         text=>"Set Defaults"});
1.531     raeburn  5668:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5669:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5670:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.446     bisitz   5671:     my $start_page =
1.531     raeburn  5672:         &Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 5673:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.507     www      5674:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5675:     &startSettingsScreen($r,'parmset',$crstype);
1.507     www      5676:     $r->print('<form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">');
1.280     albertel 5677: 
1.221     www      5678:     my @ids=();
                   5679:     my %typep=();
                   5680:     my %keyp=();
                   5681:     my %allparms=();
                   5682:     my %allparts=();
                   5683:     my %allmaps=();
                   5684:     my %mapp=();
                   5685:     my %symbp=();
                   5686:     my %maptitles=();
                   5687:     my %uris=();
                   5688:     my %keyorder=&standardkeyorder();
                   5689:     my %defkeytype=();
                   5690: 
1.446     bisitz   5691:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 5692:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   5693:                 \%keyorder,\%defkeytype);
1.224     www      5694:     if ($env{'form.storerules'}) {
1.560     damieng  5695:         my %newrules=();
                   5696:         my @delrules=();
                   5697:         my %triggers=();
                   5698:         foreach my $key (keys(%env)) {
1.225     albertel 5699:             if ($key=~/^form\.(\w+)\_action$/) {
1.560     damieng  5700:                 my $tempkey=$1;
                   5701:                 my $action=$env{$key};
1.226     www      5702:                 if ($action) {
1.560     damieng  5703:                     $newrules{$tempkey.'_action'}=$action;
                   5704:                     if ($action ne 'default') {
                   5705:                         my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   5706:                         $triggers{$whichparm}.=$tempkey.':';
                   5707:                     }
                   5708:                     $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
                   5709:                     if (&isdateparm($defkeytype{$tempkey})) {
                   5710:                         $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
                   5711:                         $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   5712:                         $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   5713:                         $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   5714:                     } else {
                   5715:                         $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
                   5716:                         $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
                   5717:                     }
                   5718:                 } else {
                   5719:                     push(@delrules,$tempkey.'_action');
                   5720:                     push(@delrules,$tempkey.'_type');
                   5721:                     push(@delrules,$tempkey.'_hours');
                   5722:                     push(@delrules,$tempkey.'_min');
                   5723:                     push(@delrules,$tempkey.'_sec');
                   5724:                     push(@delrules,$tempkey.'_value');
                   5725:                 }
1.473     amueller 5726:             }
                   5727:         }
1.560     damieng  5728:         foreach my $key (keys(%allparms)) {
                   5729:             $newrules{$key.'_triggers'}=$triggers{$key};
1.473     amueller 5730:         }
1.560     damieng  5731:         &Apache::lonnet::put('parmdefactions',\%newrules,$cdom,$cnum);
                   5732:         &Apache::lonnet::del('parmdefactions',\@delrules,$cdom,$cnum);
                   5733:         &resetrulescache();
1.224     www      5734:     }
1.227     www      5735:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
1.473     amueller 5736:                        'hours' => 'Hours',
                   5737:                        'min' => 'Minutes',
                   5738:                        'sec' => 'Seconds',
                   5739:                        'yes' => 'Yes',
                   5740:                        'no' => 'No');
1.222     www      5741:     my @standardoptions=('','default');
                   5742:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   5743:     my @dateoptions=('','default');
                   5744:     my @datedisplay=('',&mt('Default value when manually setting'));
                   5745:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  5746:         unless ($tempkey) { next; }
                   5747:         push @standardoptions,'when_setting_'.$tempkey;
                   5748:         push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   5749:         if (&isdateparm($defkeytype{$tempkey})) {
                   5750:             push @dateoptions,'later_than_'.$tempkey;
                   5751:             push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   5752:             push @dateoptions,'earlier_than_'.$tempkey;
                   5753:             push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   5754:         }
1.222     www      5755:     }
1.563     damieng  5756:     $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   5757:         &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 5758:     $r->print("\n".&Apache::loncommon::start_data_table().
1.473     amueller 5759:           &Apache::loncommon::start_data_table_header_row().
                   5760:           "<th>".&mt('Rule for parameter').'</th><th>'.
                   5761:           &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   5762:           &Apache::loncommon::end_data_table_header_row());
1.221     www      5763:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  5764:         unless ($tempkey) { next; }
                   5765:         $r->print("\n".&Apache::loncommon::start_data_table_row().
                   5766:             "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
                   5767:         my $action=&rulescache($tempkey.'_action');
                   5768:         $r->print('<select name="'.$tempkey.'_action">');
                   5769:         if (&isdateparm($defkeytype{$tempkey})) {
                   5770:             for (my $i=0;$i<=$#dateoptions;$i++) {
                   5771:             if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   5772:             $r->print("\n<option value='$dateoptions[$i]'".
                   5773:                 ($dateoptions[$i] eq $action?' selected="selected"':'').
                   5774:                 ">$datedisplay[$i]</option>");
                   5775:             }
                   5776:         } else {
                   5777:             for (my $i=0;$i<=$#standardoptions;$i++) {
                   5778:             if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   5779:             $r->print("\n<option value='$standardoptions[$i]'".
                   5780:                 ($standardoptions[$i] eq $action?' selected="selected"':'').
                   5781:                 ">$standarddisplay[$i]</option>");
                   5782:             }
1.473     amueller 5783:         }
1.560     damieng  5784:         $r->print('</select>');
                   5785:         unless (&isdateparm($defkeytype{$tempkey})) {
                   5786:             $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   5787:                 '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
1.473     amueller 5788:         }
1.560     damieng  5789:         $r->print("\n</td><td>\n");
1.222     www      5790: 
1.221     www      5791:         if (&isdateparm($defkeytype{$tempkey})) {
1.560     damieng  5792:             my $days=&rulescache($tempkey.'_days');
                   5793:             my $hours=&rulescache($tempkey.'_hours');
                   5794:             my $min=&rulescache($tempkey.'_min');
                   5795:             my $sec=&rulescache($tempkey.'_sec');
                   5796:             $r->print(<<ENDINPUTDATE);
                   5797:     <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
                   5798:     <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   5799:     <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   5800:     <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.564     raeburn  5801: ENDINPUTDATE
1.560     damieng  5802:         } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
                   5803:                 my $yeschecked='';
                   5804:                 my $nochecked='';
                   5805:                 if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   5806:                 if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
                   5807: 
                   5808:             $r->print(<<ENDYESNO);
                   5809:     <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   5810:     <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.564     raeburn  5811: ENDYESNO
1.221     www      5812:         } else {
1.560     damieng  5813:             $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
                   5814:         }
1.318     albertel 5815:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      5816:     }
1.318     albertel 5817:     $r->print(&Apache::loncommon::end_data_table().
1.473     amueller 5818:           "\n".'<input type="submit" name="storerules" value="'.
1.507     www      5819:           &mt('Save').'" /></form>'."\n");
                   5820:     &endSettingsScreen($r);
                   5821:     $r->print(&Apache::loncommon::end_page());
1.220     www      5822:     return;
                   5823: }
1.193     albertel 5824: 
1.560     damieng  5825: ##################################################
                   5826: # PARAMETER CHANGES LOG
                   5827: ##################################################
                   5828: 
1.563     damieng  5829: # Returns some info for a parameter log entry.
                   5830: # Returned entries:
                   5831: # $realm - HTML title for the parameter level and resource
                   5832: # $section - parameter section
                   5833: # $name - parameter name
                   5834: # $part - parameter part
                   5835: # $what - $part.'.'.$name
                   5836: # $middle - resource symb ?
                   5837: # $uname - user name (same as given)
                   5838: # $udom - user domain (same as given)
                   5839: # $issection - section or group name
                   5840: # $realmdescription - title for the parameter level and resource (without using HTML)
                   5841: #
                   5842: # FIXME: remove unused fields.
                   5843: #
                   5844: # @param {string} $key - parameter log key
                   5845: # @param {string} $uname - user name
                   5846: # @param {string} $udom - user domain
                   5847: # @param {string} $exeuser - unused
                   5848: # @param {string} $exedomain - unused
                   5849: # @param {boolean} $typeflag - .type log entry
                   5850: # @returns {Array}
1.290     www      5851: sub components {
1.330     albertel 5852:     my ($key,$uname,$udom,$exeuser,$exedomain,$typeflag)=@_;
                   5853: 
                   5854:     if ($typeflag) {
1.560     damieng  5855:         $key=~s/\.type$//;
1.290     www      5856:     }
1.330     albertel 5857: 
                   5858:     my ($middle,$part,$name)=
1.560     damieng  5859:         ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.291     www      5860:     my $issection;
1.330     albertel 5861: 
1.290     www      5862:     my $section=&mt('All Students');
                   5863:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  5864:         $issection=$1;
                   5865:         $section=&mt('Group/Section').': '.$issection;
                   5866:         $middle=~s/^\[(.*)\]//;
1.290     www      5867:     }
                   5868:     $middle=~s/\.+$//;
                   5869:     $middle=~s/^\.+//;
1.291     www      5870:     if ($uname) {
1.560     damieng  5871:         $section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   5872:         $issection='';
1.291     www      5873:     }
1.316     albertel 5874:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446     bisitz   5875:     my $realmdescription=&mt('all resources');
1.556     raeburn  5876:     if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   5877:         my $mapurl = $1;
                   5878:         my $maplevel = $2;
                   5879:         my $leveltitle = &mt('Folder/Map');
                   5880:         if ($maplevel eq 'rec') {
                   5881:             $leveltitle = &mt('Recursive');
                   5882:         }
1.560     damieng  5883:         $realm='<span class="LC_parm_scope_folder">'.$leveltitle.
                   5884:             ': '.&Apache::lonnet::gettitle($mapurl).' <span class="LC_parm_folder"><br />('.
                   5885:             $mapurl.')</span></span>';
                   5886:         $realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($mapurl);
                   5887:     } elsif ($middle) {
                   5888:         my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   5889:         $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   5890:             ': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.
                   5891:             ' in '.$map.' id: '.$id.')</span></span>';
                   5892:         $realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      5893:     }
1.291     www      5894:     my $what=$part.'.'.$name;
1.330     albertel 5895:     return ($realm,$section,$name,$part,
1.473     amueller 5896:         $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      5897: }
1.293     www      5898: 
1.563     damieng  5899: my %standard_parms; # hash parameter name -> parameter title (not localized)
                   5900: my %standard_parms_types; # hash parameter name -> parameter type
1.416     jms      5901: 
1.563     damieng  5902: # Reads parameter info from packages.tab into %standard_parms.
1.328     albertel 5903: sub load_parameter_names {
                   5904:     open(my $config,"<$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
                   5905:     while (my $configline=<$config>) {
1.560     damieng  5906:         if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   5907:         chomp($configline);
                   5908:         my ($short,$plain)=split(/:/,$configline);
                   5909:         my (undef,$name,$type)=split(/\&/,$short,3);
                   5910:         if ($type eq 'display') {
                   5911:             $standard_parms{$name} = $plain;
1.469     raeburn  5912:         } elsif ($type eq 'type') {
1.560     damieng  5913:                 $standard_parms_types{$name} = $plain;
1.469     raeburn  5914:         }
1.328     albertel 5915:     }
                   5916:     close($config);
                   5917:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   5918:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
                   5919: }
                   5920: 
1.563     damieng  5921: # Returns a parameter title for standard parameters, the name for others.
                   5922: #
                   5923: # @param {string} $name - parameter name
                   5924: # @returns {string}
1.292     www      5925: sub standard_parameter_names {
                   5926:     my ($name)=@_;
1.328     albertel 5927:     if (!%standard_parms) {
1.560     damieng  5928:         &load_parameter_names();
1.328     albertel 5929:     }
1.292     www      5930:     if ($standard_parms{$name}) {
1.560     damieng  5931:         return $standard_parms{$name};
1.446     bisitz   5932:     } else {
1.560     damieng  5933:         return $name;
1.292     www      5934:     }
                   5935: }
1.290     www      5936: 
1.563     damieng  5937: # Returns a parameter type for standard parameters, undef for others.
                   5938: #
                   5939: # @param {string} $name - parameter name
                   5940: # @returns {string}
1.469     raeburn  5941: sub standard_parameter_types {
                   5942:     my ($name)=@_;
                   5943:     if (!%standard_parms_types) {
                   5944:         &load_parameter_names();
                   5945:     }
                   5946:     if ($standard_parms_types{$name}) {
                   5947:         return $standard_parms_types{$name};
                   5948:     }
                   5949:     return;
                   5950: }
1.309     www      5951: 
1.563     damieng  5952: # Returns a parameter level title (not localized) from the parameter level name.
                   5953: #
                   5954: # @param {string} $name - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   5955: # @returns {string}
1.557     raeburn  5956: sub standard_parameter_levels {
                   5957:     my ($name)=@_;
                   5958:     my %levels = (
                   5959:                     'resourcelevel'   => 'a single resource',
                   5960:                     'maplevel'        => 'the enclosing map/folder', 
                   5961:                     'maplevelrecurse' => 'the enclosing map/folder (recursive into sub-folders)',
                   5962:                     'courselevel'     => 'the general (course) level',
                   5963:                  );
                   5964:     if ($levels{$name}) {
                   5965:         return $levels{$name};
                   5966:     }
                   5967:     return;
                   5968: }
                   5969: 
1.560     damieng  5970: # Display log for parameter changes, blog postings, user notification changes.
1.563     damieng  5971: #
                   5972: # @param {Apache2::RequestRec} $r - the Apache request
1.285     albertel 5973: sub parm_change_log {
1.284     www      5974:     my ($r)=@_;
1.531     raeburn  5975:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5976:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5977:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'}
1.414     droeschl 5978:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.473     amueller 5979:     text=>"Parameter Change Log"});
1.522     raeburn  5980:     my $js = '<script type="text/javascript">'."\n".
                   5981:              '// <![CDATA['."\n".
                   5982:              &Apache::loncommon::display_filter_js('parmslog')."\n".
                   5983:              '// ]]>'."\n".
                   5984:              '</script>'."\n";
                   5985:     $r->print(&Apache::loncommon::start_page('Parameter Change Log',$js));
1.327     albertel 5986:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
1.531     raeburn  5987:     &startSettingsScreen($r,'parmset',$crstype);
                   5988:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',$cdom,$cnum);
1.311     albertel 5989: 
1.301     www      5990:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 5991: 
1.522     raeburn  5992:     $r->print('<div class="LC_left_float">'.
                   5993:               '<fieldset><legend>'.&mt('Display of Changes').'</legend>'.
                   5994:               '<form action="/adm/parmset?action=parameterchangelog"
1.327     albertel 5995:                      method="post" name="parameterlog">');
1.446     bisitz   5996: 
1.311     albertel 5997:     my %saveable_parameters = ('show' => 'scalar',);
                   5998:     &Apache::loncommon::store_course_settings('parameter_log',
                   5999:                                               \%saveable_parameters);
                   6000:     &Apache::loncommon::restore_course_settings('parameter_log',
                   6001:                                                 \%saveable_parameters);
1.522     raeburn  6002:     $r->print(&Apache::loncommon::display_filter('parmslog').'&nbsp;'."\n".
                   6003:               '<input type="submit" value="'.&mt('Display').'" />'.
                   6004:               '</form></fieldset></div><br clear="all" />');
1.301     www      6005: 
1.531     raeburn  6006:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.301     www      6007:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
1.473     amueller 6008:           '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
                   6009:           &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th><th>'.&mt('Announce').'</th>'.
                   6010:           &Apache::loncommon::end_data_table_header_row());
1.309     www      6011:     my $shown=0;
1.349     www      6012:     my $folder='';
                   6013:     if ($env{'form.displayfilter'} eq 'currentfolder') {
1.560     damieng  6014:         my $last='';
                   6015:         if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   6016:                 &GDBM_READER(),0640)) {
                   6017:             $last=$hash{'last_known'};
                   6018:             untie(%hash);
                   6019:         }
                   6020:         if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
                   6021:     }
                   6022:     foreach my $id (sort {
                   6023:                 if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   6024:                     return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   6025:                 }
                   6026:                 my $aid = (split('00000',$a))[-1];
                   6027:                 my $bid = (split('00000',$b))[-1];
                   6028:                 return $bid<=>$aid;
1.473     amueller 6029:             } (keys(%parmlog))) {
1.294     www      6030:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.560     damieng  6031:         my $count = 0;
                   6032:         my $time =
                   6033:             &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
                   6034:         my $plainname =
                   6035:             &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   6036:                         $parmlog{$id}{'exe_udom'});
                   6037:         my $about_me_link =
                   6038:             &Apache::loncommon::aboutmewrapper($plainname,
                   6039:                             $parmlog{$id}{'exe_uname'},
                   6040:                             $parmlog{$id}{'exe_udom'});
                   6041:         my $send_msg_link='';
                   6042:         if ((($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
                   6043:             || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
                   6044:             $send_msg_link ='<br />'.
                   6045:             &Apache::loncommon::messagewrapper(&mt('Send message'),
                   6046:                             $parmlog{$id}{'exe_uname'},
                   6047:                             $parmlog{$id}{'exe_udom'});
                   6048:         }
                   6049:         my $row_start=&Apache::loncommon::start_data_table_row();
                   6050:         my $makenewrow=0;
                   6051:         my %istype=();
                   6052:         my $output;
                   6053:         foreach my $changed (reverse(sort(@changes))) {
                   6054:                 my $value=$parmlog{$id}{'logentry'}{$changed};
                   6055:             my $typeflag = ($changed =~/\.type$/ &&
                   6056:                     !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 6057:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
1.560     damieng  6058:                 &components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},undef,undef,$typeflag);
                   6059:             if ($env{'request.course.sec'} ne '') {
                   6060:                 next if (($issection ne '') && ($issection ne $env{'request.course.sec'}));
                   6061:                 if ($uname ne '') {
                   6062:                     my $stusection = &Apache::lonnet::getsection($uname,$udom,$env{'request.course.id'});
                   6063:                     next if (($stusection ne '-1') && ($stusection ne $env{'request.course.sec'})); 
                   6064:                 }
                   6065:             }
                   6066:             if ($env{'form.displayfilter'} eq 'currentfolder') {
                   6067:                 if ($folder) {
                   6068:                     if ($middle!~/^\Q$folder\E/) { next; }
                   6069:                 }
                   6070:             }
                   6071:             if ($typeflag) {
                   6072:                 $istype{$parmname}=$value;
                   6073:                 if (!$env{'form.includetypes'}) { next; }
                   6074:             }
                   6075:             $count++;
                   6076:             if ($makenewrow) {
                   6077:                 $output .= $row_start;
                   6078:             } else {
                   6079:                 $makenewrow=1;
                   6080:             }
1.470     raeburn  6081:             my $parmitem = &standard_parameter_names($parmname);
1.560     damieng  6082:             $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
                   6083:                 &mt($parmitem).'</td><td>'.
                   6084:                 ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
                   6085:             my $stillactive=0;
                   6086:             if ($parmlog{$id}{'delflag'}) {
                   6087:                 $output .= &mt('Deleted');
                   6088:             } else {
                   6089:                 if ($typeflag) {
1.470     raeburn  6090:                     my $parmitem = &standard_parameter_names($value); 
                   6091:                     $parmitem = &mt($parmitem);
1.560     damieng  6092:                     $output .= &mt('Type: [_1]',$parmitem);
                   6093:                 } else {
                   6094:                     my ($level,@all)=&parmval_by_symb($what,$middle,
                   6095:                         &Apache::lonnet::metadata($middle,$what),
                   6096:                         $uname,$udom,$issection,$issection,$courseopt);
1.469     raeburn  6097:                     my $showvalue = $value;
                   6098:                     if ($istype{$parmname} eq '') {
                   6099:                         my $type = &standard_parameter_types($parmname);
                   6100:                         if ($type ne '') {
                   6101:                             if (&isdateparm($type)) {
                   6102:                                 $showvalue =
                   6103:                                     &Apache::lonlocal::locallocaltime($value);
                   6104:                             }
                   6105:                         }
                   6106:                     } else {
1.560     damieng  6107:                         if (&isdateparm($istype{$parmname})) {
                   6108:                             $showvalue = &Apache::lonlocal::locallocaltime($value);
                   6109:                         }
1.469     raeburn  6110:                     }
                   6111:                     $output .= $showvalue;
1.560     damieng  6112:                     if ($value ne $all[$level]) {
                   6113:                         $output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
                   6114:                     } else {
                   6115:                         $stillactive=1;
                   6116:                     }
                   6117:                 }
1.473     amueller 6118:             }
1.560     damieng  6119:             $output .= '</td><td>';
                   6120:                 
                   6121:             if ($stillactive) {
1.470     raeburn  6122:                 my $parmitem = &standard_parameter_names($parmname);
                   6123:                 $parmitem = &mt($parmitem);
1.560     damieng  6124:                 my $title=&mt('Changed [_1]',$parmitem);
1.471     raeburn  6125:                 my $description=&mt('Changed [_1] for [_2] to [_3]',
1.560     damieng  6126:                     $parmitem,$realmdescription,
1.473     amueller 6127:                     (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
1.560     damieng  6128:                 if (($uname) && ($udom)) {
                   6129:                     $output .=
                   6130:                     &Apache::loncommon::messagewrapper('Notify User',
                   6131:                                     $uname,$udom,$title,
                   6132:                                     $description);
                   6133:                 } else {
                   6134:                     $output .=
                   6135:                     &Apache::lonrss::course_blog_link($id,$title,
                   6136:                                     $description);
                   6137:                 }
                   6138:             }
                   6139:             $output .= '</td>'.&Apache::loncommon::end_data_table_row();
1.473     amueller 6140:         }
1.560     damieng  6141:         if ($env{'form.displayfilter'} eq 'containing') {
                   6142:             my $wholeentry=$about_me_link.':'.
                   6143:             $parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   6144:             $output;
                   6145:             if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
1.473     amueller 6146:         }
1.349     www      6147:         if ($count) {
1.560     damieng  6148:             $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
                   6149:                         <td rowspan="'.$count.'">'.$about_me_link.
                   6150:             '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   6151:                         ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   6152:             $send_msg_link.'</td>'.$output);
                   6153:             $shown++;
                   6154:         }
                   6155:         if (!($env{'form.show'} eq &mt('all')
                   6156:             || $shown<=$env{'form.show'})) { last; }
1.286     www      6157:     }
1.301     www      6158:     $r->print(&Apache::loncommon::end_data_table());
1.507     www      6159:     &endSettingsScreen($r);
1.284     www      6160:     $r->print(&Apache::loncommon::end_page());
                   6161: }
                   6162: 
1.560     damieng  6163: ##################################################
                   6164: # MISC !
                   6165: ##################################################
                   6166: 
1.563     damieng  6167: # Stores slot information.
1.560     damieng  6168: # Used by table UI
1.563     damieng  6169: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   6170: #
                   6171: # @param {string} $slot_name - slot name
                   6172: # @param {string} $cdom - course domain
                   6173: # @param {string} $cnum - course number
                   6174: # @param {string} $symb - resource symb
                   6175: # @param {string} $uname - user name
                   6176: # @param {string} $udom - user domain
                   6177: # @returns {string} - 'ok' or error name
1.437     raeburn  6178: sub update_slots {
                   6179:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   6180:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   6181:     if (!keys(%slot)) {
                   6182:         return 'error: slot does not exist';
                   6183:     }
                   6184:     my $max=$slot{'maxspace'};
                   6185:     if (!defined($max)) { $max=99999; }
                   6186: 
                   6187:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   6188:                                        "^$slot_name\0");
                   6189:     my ($tmp)=%consumed;
                   6190:     if ($tmp=~/^error: 2 / ) {
                   6191:         return 'error: unable to determine current slot status';
                   6192:     }
                   6193:     my $last=0;
                   6194:     foreach my $key (keys(%consumed)) {
                   6195:         my $num=(split('\0',$key))[1];
                   6196:         if ($num > $last) { $last=$num; }
                   6197:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   6198:             return 'ok';
                   6199:         }
                   6200:     }
                   6201: 
                   6202:     if (scalar(keys(%consumed)) >= $max) {
                   6203:         return 'error: no space left in slot';
                   6204:     }
                   6205:     my $wanted=$last+1;
                   6206: 
                   6207:     my %reservation=('name'      => $uname.':'.$udom,
                   6208:                      'timestamp' => time,
                   6209:                      'symb'      => $symb);
                   6210: 
                   6211:     my $success=&Apache::lonnet::newput('slot_reservations',
                   6212:                                         {"$slot_name\0$wanted" =>
                   6213:                                              \%reservation},
                   6214:                                         $cdom, $cnum);
1.438     raeburn  6215:     if ($success eq 'ok') {
                   6216:         my %storehash = (
                   6217:                           symb    => $symb,
                   6218:                           slot    => $slot_name,
                   6219:                           action  => 'reserve',
                   6220:                           context => 'parameter',
                   6221:                         );
1.526     raeburn  6222:         &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  6223:                                    '',$uname,$udom,$cnum,$cdom);
1.438     raeburn  6224: 
1.526     raeburn  6225:         &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  6226:                                    '',$uname,$udom,$uname,$udom);
1.438     raeburn  6227:     }
1.437     raeburn  6228:     return $success;
                   6229: }
                   6230: 
1.563     damieng  6231: # Deletes a slot reservation.
1.560     damieng  6232: # Used by table UI
1.563     damieng  6233: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   6234: #
                   6235: # @param {string} $slot_name - slot name
                   6236: # @param {string} $cdom - course domain
                   6237: # @param {string} $cnum - course number
                   6238: # @param {string} $uname - user name
                   6239: # @param {string} $udom - user domain
                   6240: # @param {string} $symb - resource symb
                   6241: # @returns {string} - 'ok' or error name
1.437     raeburn  6242: sub delete_slots {
                   6243:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   6244:     my $delresult;
                   6245:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   6246:                                          $cnum, "^$slot_name\0");
                   6247:     if (&Apache::lonnet::error(%consumed)) {
                   6248:         return 'error: unable to determine current slot status';
                   6249:     }
                   6250:     my ($tmp)=%consumed;
                   6251:     if ($tmp=~/^error: 2 /) {
                   6252:         return 'error: unable to determine current slot status';
                   6253:     }
                   6254:     foreach my $key (keys(%consumed)) {
                   6255:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   6256:             my $num=(split('\0',$key))[1];
                   6257:             my $entry = $slot_name.'\0'.$num;
                   6258:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   6259:                                               $cdom,$cnum);
                   6260:             if ($delresult eq 'ok') {
                   6261:                 my %storehash = (
                   6262:                                   symb    => $symb,
                   6263:                                   slot    => $slot_name,
                   6264:                                   action  => 'release',
                   6265:                                   context => 'parameter',
                   6266:                                 );
1.526     raeburn  6267:                 &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  6268:                                            1,$uname,$udom,$cnum,$cdom);
1.526     raeburn  6269:                 &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  6270:                                            1,$uname,$udom,$uname,$udom);
1.437     raeburn  6271:             }
                   6272:         }
                   6273:     }
                   6274:     return $delresult;
                   6275: }
                   6276: 
1.563     damieng  6277: # Returns true if there is a current course.
1.560     damieng  6278: # Used by handler
1.563     damieng  6279: #
                   6280: # @returns {boolean}
1.355     albertel 6281: sub check_for_course_info {
                   6282:     my $navmap = Apache::lonnavmaps::navmap->new();
                   6283:     return 1 if ($navmap);
                   6284:     return 0;
                   6285: }
                   6286: 
1.563     damieng  6287: # Returns the current course host and host LON-CAPA version.
                   6288: #
                   6289: # @returns {Array} - (course hostname, major version number, minor version number)
1.514     raeburn  6290: sub parameter_release_vars { 
1.504     raeburn  6291:    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6292:    my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   6293:    my $chostname = &Apache::lonnet::hostname($chome);
                   6294:    my ($cmajor,$cminor) = 
                   6295:        split(/\./,&Apache::lonnet::get_server_loncaparev($cdom,$chome));
                   6296:    return ($chostname,$cmajor,$cminor);
                   6297: }
                   6298: 
1.563     damieng  6299: # Checks if the course host version can handle a parameter required version,
                   6300: # and if it does, stores the release needed for the course.
                   6301: #
                   6302: # @param {string} $name - parameter name
                   6303: # @param {string} $value - parameter value
                   6304: # @param {string} $valmatch - name of the test used for checking the value
                   6305: # @param {string} $namematch - name of the test used for checking the name
                   6306: # @param {string} $needsrelease - version needed by the parameter, major.minor
                   6307: # @param {integer} $cmajor - course major version number
                   6308: # @param {integer} $cminor - course minor version number
                   6309: # @returns {boolean} - true if a newer version is needed
1.514     raeburn  6310: sub parameter_releasecheck {
1.557     raeburn  6311:     my ($name,$value,$valmatch,$namematch,$needsrelease,$cmajor,$cminor) = @_;
1.504     raeburn  6312:     my $needsnewer;
                   6313:     my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
                   6314:     if (($cmajor < $needsmajor) || 
                   6315:         ($cmajor == $needsmajor && $cminor < $needsminor)) {
                   6316:         $needsnewer = 1;
1.557     raeburn  6317:     } elsif ($name) {
                   6318:         if ($valmatch) {
                   6319:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.'::'.$valmatch.':'});
                   6320:         } elsif ($value) { 
                   6321:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.':'.$value.'::'});
                   6322:         }
                   6323:     } elsif ($namematch) {
                   6324:         &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter::::'.$namematch});
1.504     raeburn  6325:     }
                   6326:     return $needsnewer;
                   6327: }
                   6328: 
1.560     damieng  6329: ##################################################
                   6330: # HANDLER
                   6331: ##################################################
                   6332: 
                   6333: # Main handler for lonparmset.
                   6334: # Sub called based on request parameters action and command:
                   6335: # no command or action: print_main_menu
                   6336: # command 'set': assessparms (direct access to table mode for a resource)
                   6337: #                (this can also be accessed simply with the symb parameter)
                   6338: # action 'setoverview': overview (display all existing parameter settings)
                   6339: # action 'addmetadata': addmetafield (called to add a portfolio metadata field)
                   6340: # action 'ordermetadata': order_meta_fields (called to order portfolio metadata fields)
                   6341: # action 'setrestrictmeta': setrestrictmeta (display or save portfolio metadata)
                   6342: # action 'newoverview': newoverview (overview mode)
                   6343: # action 'setdefaults': defaultsetter (UI to change parameter setting default actions)
                   6344: # action 'settable': assessparms (table mode)
                   6345: # action 'parameterchangelog': parm_change_log (display log for parameter changes,
                   6346: #                              blog postings, user notification changes)
                   6347: # action 'cleanparameters': clean_parameters (unused)
                   6348: # action 'dateshift1': date_shift_one (overview mode, shift all dates)
                   6349: # action 'dateshift2': date_shift_two (overview mode, shift all dates)
1.30      www      6350: sub handler {
1.43      albertel 6351:     my $r=shift;
1.30      www      6352: 
1.376     albertel 6353:     &reset_caches();
                   6354: 
1.414     droeschl 6355:     &Apache::loncommon::content_type($r,'text/html');
                   6356:     $r->send_http_header;
                   6357:     return OK if $r->header_only;
                   6358: 
1.193     albertel 6359:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.473     amueller 6360:                         ['action','state',
1.205     www      6361:                                              'pres_marker',
                   6362:                                              'pres_value',
1.206     www      6363:                                              'pres_type',
1.506     www      6364:                                              'filter','part',
1.390     www      6365:                                              'udom','uname','symb','serial','timebase']);
1.131     www      6366: 
1.83      bowersj2 6367: 
1.193     albertel 6368:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 6369:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
1.507     www      6370:                         text=>"Content and Problem Settings",
1.473     amueller 6371:                         faq=>10,
                   6372:                         bug=>'Instructor Interface',
1.442     droeschl 6373:                                             help =>
                   6374:                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203     www      6375: 
1.30      www      6376: # ----------------------------------------------------- Needs to be in a course
1.194     albertel 6377:     my $parm_permission =
1.473     amueller 6378:     (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||
                   6379:      &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
                   6380:                   $env{'request.course.sec'}));
1.355     albertel 6381:     my $exists = &check_for_course_info();
                   6382: 
                   6383:     if ($env{'request.course.id'} &&  $parm_permission && $exists) {
1.193     albertel 6384:         #
                   6385:         # Main switch on form.action and form.state, as appropriate
                   6386:         #
                   6387:         # Check first if coming from someone else headed directly for
                   6388:         #  the table mode
                   6389:         if ((($env{'form.command'} eq 'set') && ($env{'form.url'})
1.560     damieng  6390:                 && (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   6391:             &assessparms($r);
1.193     albertel 6392:         } elsif (! exists($env{'form.action'})) {
                   6393:             &print_main_menu($r,$parm_permission);
1.414     droeschl 6394:         } elsif ($env{'form.action'} eq 'setoverview') {
1.560     damieng  6395:             &overview($r);
                   6396:         } elsif ($env{'form.action'} eq 'addmetadata') {
                   6397:             &addmetafield($r);
                   6398:         } elsif ($env{'form.action'} eq 'ordermetadata') {
                   6399:             &order_meta_fields($r);
1.414     droeschl 6400:         } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.560     damieng  6401:             &setrestrictmeta($r);
1.414     droeschl 6402:         } elsif ($env{'form.action'} eq 'newoverview') {
1.560     damieng  6403:             &newoverview($r);
1.414     droeschl 6404:         } elsif ($env{'form.action'} eq 'setdefaults') {
1.560     damieng  6405:             &defaultsetter($r);
                   6406:         } elsif ($env{'form.action'} eq 'settable') {
                   6407:             &assessparms($r);
1.414     droeschl 6408:         } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.560     damieng  6409:             &parm_change_log($r);
1.414     droeschl 6410:         } elsif ($env{'form.action'} eq 'cleanparameters') {
1.560     damieng  6411:             &clean_parameters($r);
1.414     droeschl 6412:         } elsif ($env{'form.action'} eq 'dateshift1') {
1.390     www      6413:             &date_shift_one($r);
1.414     droeschl 6414:         } elsif ($env{'form.action'} eq 'dateshift2') {
1.390     www      6415:             &date_shift_two($r);
1.446     bisitz   6416:         }
1.43      albertel 6417:     } else {
1.1       www      6418: # ----------------------------- Not in a course, or not allowed to modify parms
1.560     damieng  6419:         if ($exists) {
                   6420:             $env{'user.error.msg'}=
                   6421:             "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   6422:         } else {
                   6423:             $env{'user.error.msg'}=
                   6424:             "/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   6425:         }
                   6426:         return HTTP_NOT_ACCEPTABLE;
1.43      albertel 6427:     }
1.376     albertel 6428:     &reset_caches();
                   6429: 
1.43      albertel 6430:     return OK;
1.1       www      6431: }
                   6432: 
                   6433: 1;
                   6434: __END__
                   6435: 
                   6436: 

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