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

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

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