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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.567   ! raeburn     4: # $Id: lonparmset.pm,v 1.566 2016/08/10 21:05:42 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);
1.567   ! raeburn  4143:     if ($readonly) {
1.552     raeburn  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'".');"';
1.567   ! raeburn  4564:             my $disabled;
        !          4565:             if ($readonly) {
        !          4566:                 $disabled = ' disabled="disabled"';
        !          4567:             }
1.558     raeburn  4568:             $result .= '<br /><span class="LC_nobreak">'.&mt('Include "done" button').
1.567   ! raeburn  4569:                        '<label><input type="radio" value="" name="done_'.$thiskey.'"'.$checkedoff.$onclick.$disabled.' />'.
1.558     raeburn  4570:                        &mt('No').'</label>'.('&nbsp;'x2).
1.567   ! raeburn  4571:                        '<label><input type="radio" value="_done" name="done_'.$thiskey.'"'.$checkedon.$onclick.$disabled.' />'.
1.558     raeburn  4572:                        &mt('Yes').'</label>'.('&nbsp;'x2).
1.567   ! raeburn  4573:                        '<label><input type="radio" value="_done_proctor" name="done_'.$thiskey.'"'.$checkedproc.$onclick.$disabled.' />'.
1.558     raeburn  4574:                        &mt('Yes, with proctor key').'</label>'.
                   4575:                        '<input type="'.$currprocdisplay.'" id="done_'.$thiskey.'_proctorkey" '.
1.567   ! raeburn  4576:                        'name="done_'.$thiskey.'_proctorkey" value="'.&HTML::Entities::encode($currproctorkey,'"<>&').'"'.$disabled.' /></span><br />'.
1.559     raeburn  4577:                        '<span class="LC_nobreak">'.&mt('Button text').': '.
1.567   ! raeburn  4578:                        '<input type="text" name="done_'.$thiskey.'_buttontext" value="'.&HTML::Entities::encode($currdonetext,'"<>&').'"'.$disabled.' /></span>';
1.554     raeburn  4579:         }
                   4580:     }
                   4581:     unless ($readonly) {
                   4582:         $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
                   4583:     }
                   4584:     return $result;
                   4585: }
                   4586: 
1.563     damieng  4587: # Returns HTML with a warning if a parameter requires a more recent version of LON-CAPA.
                   4588: #
                   4589: # @param {string} $name - parameter name
                   4590: # @param {string} $namematch - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   4591: # @param {string} $value - parameter value
                   4592: # @param {string} $chostname - course server name
                   4593: # @param {integer} $cmajor - major version number
                   4594: # @param {integer} $cminor - minor version number
                   4595: # @param {string} $needsrelease - release version needed (major.minor)
                   4596: # @returns {string}
1.549     raeburn  4597: sub oldversion_warning {
1.557     raeburn  4598:     my ($name,$namematch,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_;
                   4599:     my $standard_name = &standard_parameter_names($name);
                   4600:     if ($namematch) {
                   4601:         my $level = &standard_parameter_levels($namematch);
                   4602:         my $msg = '';
                   4603:         if ($level) {
                   4604:             $msg = &mt('[_1] was [_2]not[_3] set at the level of: [_4].',
                   4605:                        $standard_name,'<b>','</b>','"'.$level.'"');
                   4606:         } else {
                   4607:             $msg = &mt('[_1] was [_2]not[_3] set.',
                   4608:                       $standard_name,'<b>','</b>');
                   4609:         }
                   4610:         return '<p class="LC_warning">'.$msg.'<br />'.
                   4611:                &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   4612:                    $cmajor.'.'.$cminor,$chostname,
                   4613:                    $needsrelease).
                   4614:                    '</p>';
                   4615:     }
1.549     raeburn  4616:     my $desc;
                   4617:     my $stringtype = &get_stringtype($name);
                   4618:     if ($stringtype ne '') {
                   4619:         if ($name eq 'examcode') {
                   4620:             $desc = $value;
                   4621:         } elsif (ref($strings{$stringtypes{$name}}) eq 'ARRAY') {
                   4622:             foreach my $possibilities (@{ $strings{$stringtypes{$name}} }) {
                   4623:                 next unless (ref($possibilities) eq 'ARRAY');
                   4624:                 my ($parmval, $description) = @{ $possibilities };
                   4625:                 my $parmmatch;
                   4626:                 if (ref($stringmatches{$stringtypes{$name}}) eq 'ARRAY') {
                   4627:                     foreach my $item (@{$stringmatches{$stringtypes{$name}}}) {
                   4628:                         if (ref($item) eq 'ARRAY') {
                   4629:                             my ($regexpname,$pattern) = @{$item};
                   4630:                             if ($parmval eq $regexpname) {
                   4631:                                 if ($value =~ /$pattern/) {
                   4632:                                     $desc = $description; 
                   4633:                                     $parmmatch = 1;
                   4634:                                     last;
                   4635:                                 }
                   4636:                             }
                   4637:                         }
                   4638:                     }
                   4639:                     last if ($parmmatch);
                   4640:                 } elsif ($parmval eq $value) {
                   4641:                     $desc = $description;
                   4642:                     last;
                   4643:                 }
                   4644:             }
                   4645:         }
                   4646:     } elsif (($name eq 'printstartdate') || ($name eq 'printenddate')) {
                   4647:         my $now = time;
                   4648:         if ($value =~ /^\d+$/) {
                   4649:             if ($name eq 'printstartdate') {
                   4650:                 if ($value > $now) {
                   4651:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   4652:                 }
                   4653:             } elsif ($name eq 'printenddate') {
                   4654:                 if ($value < $now) {
                   4655:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   4656:                 }
                   4657:             }
                   4658:         }
                   4659:     }
                   4660:     return '<p class="LC_warning">'.
1.557     raeburn  4661:        &mt('[_1] was [_2]not[_3] set to [_4].',
                   4662:            $standard_name,'<b>','</b>','"'.$desc.'"').'<br />'.
                   4663:        &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   4664:        $cmajor.'.'.$cminor,$chostname,
                   4665:        $needsrelease).
                   4666:        '</p>';
1.549     raeburn  4667: }
                   4668: 
1.560     damieng  4669: } # end of block using some constants related to parameter types
                   4670: 
1.549     raeburn  4671: 
1.563     damieng  4672: 
                   4673: # Shifts all start and end dates in the current course by $shift.
1.389     www      4674: #
1.563     damieng  4675: # @param {integer} $shift - time to shift, in seconds
                   4676: # @returns {string} - error name or 'ok'
1.389     www      4677: sub dateshift {
                   4678:     my ($shift)=@_;
                   4679:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4680:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   4681:     my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   4682: # ugly retro fix for broken version of types
1.548     raeburn  4683:     foreach my $key (keys(%data)) {
1.389     www      4684:         if ($key=~/\wtype$/) {
                   4685:             my $newkey=$key;
                   4686:             $newkey=~s/type$/\.type/;
                   4687:             $data{$newkey}=$data{$key};
                   4688:             delete $data{$key};
                   4689:         }
                   4690:     }
1.391     www      4691:     my %storecontent=();
1.389     www      4692: # go through all parameters and look for dates
1.548     raeburn  4693:     foreach my $key (keys(%data)) {
1.389     www      4694:        if ($data{$key.'.type'}=~/^date_(start|end)$/) {
                   4695:           my $newdate=$data{$key}+$shift;
1.391     www      4696:           $storecontent{$key}=$newdate;
1.389     www      4697:        }
                   4698:     }
1.391     www      4699:     my $reply=&Apache::lonnet::cput
                   4700:                 ('resourcedata',\%storecontent,$dom,$crs);
                   4701:     if ($reply eq 'ok') {
                   4702:        &log_parmset(\%storecontent);
                   4703:     }
                   4704:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
                   4705:     return $reply;
1.389     www      4706: }
                   4707: 
1.563     damieng  4708: # Overview mode UI to edit course parameters.
                   4709: #
                   4710: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      4711: sub newoverview {
1.280     albertel 4712:     my ($r) = @_;
                   4713: 
1.208     www      4714:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4715:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  4716:     my $crstype =  $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 4717:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 4718:         text=>"Overview Mode"});
1.523     raeburn  4719: 
                   4720:     my %loaditems = (
1.549     raeburn  4721:                       'onload'   => "showHide_courseContent(); resize_scrollbox('mapmenuscroll','1','1'); showHideLenient();",
1.523     raeburn  4722:                     );
                   4723:     my $js = '
                   4724: <script type="text/javascript">
                   4725: // <![CDATA[
                   4726: '.
                   4727:             &Apache::lonhtmlcommon::resize_scrollbox_js('params')."\n".
                   4728:             &showhide_js()."\n".
1.549     raeburn  4729:             &toggleparmtextbox_js()."\n".
                   4730:             &validateparms_js()."\n".
                   4731:             &ipacc_boxes_js()."\n".
1.558     raeburn  4732:             &done_proctor_js()."\n".
1.523     raeburn  4733: '// ]]>
                   4734: </script>
                   4735: ';
1.549     raeburn  4736: 
1.523     raeburn  4737:     my $start_page = &Apache::loncommon::start_page('Set Parameters',$js,
                   4738:                                                     {'add_entries' => \%loaditems,});
1.298     albertel 4739:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      4740:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  4741:     &startSettingsScreen($r,'parmset',$crstype);
1.208     www      4742:     $r->print(<<ENDOVER);
1.549     raeburn  4743: <form method="post" action="/adm/parmset?action=newoverview" name="parmform" onsubmit="return validateParms();">
1.208     www      4744: ENDOVER
1.211     www      4745:     my @ids=();
                   4746:     my %typep=();
                   4747:     my %keyp=();
                   4748:     my %allparms=();
                   4749:     my %allparts=();
                   4750:     my %allmaps=();
                   4751:     my %mapp=();
                   4752:     my %symbp=();
                   4753:     my %maptitles=();
                   4754:     my %uris=();
                   4755:     my %keyorder=&standardkeyorder();
                   4756:     my %defkeytype=();
                   4757: 
                   4758:     my %alllevs=();
                   4759:     $alllevs{'Resource Level'}='full';
1.215     www      4760:     $alllevs{'Map/Folder Level'}='map';
1.211     www      4761:     $alllevs{'Course Level'}='general';
                   4762: 
                   4763:     my $csec=$env{'form.csec'};
1.269     raeburn  4764:     my $cgroup=$env{'form.cgroup'};
1.211     www      4765: 
                   4766:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   4767:     my $pschp=$env{'form.pschp'};
1.506     www      4768: 
1.211     www      4769:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      4770:     if (!@psprt) { $psprt[0]='all'; }
1.211     www      4771: 
1.446     bisitz   4772:     my @selected_sections =
1.473     amueller 4773:     &Apache::loncommon::get_env_multiple('form.Section');
1.211     www      4774:     @selected_sections = ('all') if (! @selected_sections);
1.374     albertel 4775:     foreach my $sec (@selected_sections) {
                   4776:         if ($sec eq 'all') {
1.211     www      4777:             @selected_sections = ('all');
                   4778:         }
                   4779:     }
1.552     raeburn  4780:     if ($env{'request.course.sec'} ne '') {
                   4781:         @selected_sections = ($env{'request.course.sec'});
                   4782:     }
1.269     raeburn  4783:     my @selected_groups =
                   4784:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      4785: 
                   4786:     my $pssymb='';
                   4787:     my $parmlev='';
1.446     bisitz   4788: 
1.211     www      4789:     unless ($env{'form.parmlev'}) {
                   4790:         $parmlev = 'map';
                   4791:     } else {
                   4792:         $parmlev = $env{'form.parmlev'};
                   4793:     }
                   4794: 
1.446     bisitz   4795:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 4796:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   4797:                 \%keyorder,\%defkeytype);
1.211     www      4798: 
1.374     albertel 4799:     if (grep {$_ eq 'all'} (@psprt)) {
1.481     amueller 4800:         @psprt = keys(%allparts);
1.374     albertel 4801:     }
1.211     www      4802: # Menu to select levels, etc
                   4803: 
1.456     bisitz   4804:     $r->print('<div class="LC_Box">');
1.445     neumanie 4805:     #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452     bisitz   4806:     $r->print('<div>');
1.523     raeburn  4807:     $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.211     www      4808:     &levelmenu($r,\%alllevs,$parmlev);
                   4809:     if ($parmlev ne 'general') {
1.447     bisitz   4810:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.483     amueller 4811:         &mapmenu($r,\%allmaps,$pschp,\%maptitles,\%symbp);
1.211     www      4812:     }
1.447     bisitz   4813:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 4814:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   4815:     $r->print('</div></div>');
1.446     bisitz   4816: 
1.456     bisitz   4817:     $r->print('<div class="LC_Box">');
1.452     bisitz   4818:     $r->print('<div>');
1.562     damieng  4819:     &displaymenu($r,\%allparms,\@pscat,\%keyorder); # FIXME: wrong parameters, could make keysindisplayorderCategory crash because $keyorder is undefined
1.453     schualex 4820:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   4821:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.553     raeburn  4822:     my $sectionselector = &sectionmenu(\@selected_sections);
                   4823:     my $groupselector = &groupmenu(\@selected_groups);
1.481     amueller 4824:     $r->print('<table>'.
1.553     raeburn  4825:               '<tr><th>'.&mt('Parts').'</th>');
                   4826:     if ($sectionselector) {
                   4827:         $r->print('<th>'.&mt('Section(s)').'</th>');
                   4828:     }
                   4829:     if ($groupselector) {
                   4830:         $r->print('<th>'.&mt('Group(s)').'</th>');
                   4831:     }
                   4832:     $r->print('</tr><tr><td>');
1.211     www      4833:     &partmenu($r,\%allparts,\@psprt);
1.553     raeburn  4834:     $r->print('</td>');
                   4835:     if ($sectionselector) { 
                   4836:         $r->print('<td>'.$sectionselector.'</td>');
                   4837:     }
                   4838:     if ($groupselector) {
                   4839:         $r->print('<td>'.$groupselector.'</td>');
                   4840:     }
                   4841:     $r->print('</tr></table>');
1.447     bisitz   4842:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 4843:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   4844:     $r->print('</div></div>');
                   4845: 
1.456     bisitz   4846:     $r->print('<div class="LC_Box">');
1.452     bisitz   4847:     $r->print('<div>');
1.214     www      4848:     my $sortorder=$env{'form.sortorder'};
                   4849:     unless ($sortorder) { $sortorder='realmstudent'; }
                   4850:     &sortmenu($r,$sortorder);
1.445     neumanie 4851:     $r->print('</div></div>');
1.446     bisitz   4852: 
1.214     www      4853:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446     bisitz   4854: 
1.211     www      4855: # Build the list data hash from the specified parms
                   4856: 
                   4857:     my $listdata;
                   4858:     %{$listdata}=();
                   4859: 
                   4860:     foreach my $cat (@pscat) {
1.269     raeburn  4861:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   4862:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      4863:     }
                   4864: 
1.212     www      4865:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      4866: 
1.481     amueller 4867:         if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      4868: 
                   4869: # Read modified data
                   4870: 
1.481     amueller 4871:         my $resourcedata=&readdata($crs,$dom);
1.211     www      4872: 
                   4873: # List data
                   4874: 
1.552     raeburn  4875:         &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview');
1.211     www      4876:     }
                   4877:     $r->print(&tableend().
1.473     amueller 4878:          ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'').
1.507     www      4879:           '</form>');
                   4880:     &endSettingsScreen($r);
                   4881:     $r->print(&Apache::loncommon::end_page());
1.208     www      4882: }
                   4883: 
1.563     damieng  4884: # Fills $listdata with parameter information.
                   4885: # Keys use the format course id.[section id].part.name and course id.[section id].part.name.type.
                   4886: # The non-type value is always 1.
                   4887: #
                   4888: # @param {string} $cat - parameter name
1.566     damieng  4889: # @param {string} $pschp - selected map pc, or 'all'
1.563     damieng  4890: # @param {string} $parmlev - selected level value (full|map|general), or ''
                   4891: # @param {hash reference} $listdata - the parameter data that will be modified
                   4892: # @param {array reference} $psprt - selected parts
                   4893: # @param {array reference} $selections - selected sections
                   4894: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.566     damieng  4895: # @param {hash reference} $allmaps - hash map pc -> map src
                   4896: # @param {array reference} $ids - resource and map ids
                   4897: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.269     raeburn  4898: sub secgroup_lister {
                   4899:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   4900:     foreach my $item (@{$selections}) {
                   4901:         foreach my $part (@{$psprt}) {
                   4902:             my $rootparmkey=$env{'request.course.id'};
                   4903:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   4904:                 $rootparmkey.='.['.$item.']';
                   4905:             }
                   4906:             if ($parmlev eq 'general') {
                   4907: # course-level parameter
                   4908:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   4909:                 $$listdata{$newparmkey}=1;
                   4910:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   4911:             } elsif ($parmlev eq 'map') {
                   4912: # map-level parameter
1.548     raeburn  4913:                 foreach my $mapid (keys(%{$allmaps})) {
1.269     raeburn  4914:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   4915:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   4916:                     $$listdata{$newparmkey}=1;
                   4917:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
1.556     raeburn  4918:                     $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(rec).'.$part.'.'.$cat;
                   4919:                     $$listdata{$newparmkey}=1;
                   4920:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
1.269     raeburn  4921:                 }
                   4922:             } else {
                   4923: # resource-level parameter
                   4924:                 foreach my $rid (@{$ids}) {
                   4925:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   4926:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   4927:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   4928:                     $$listdata{$newparmkey}=1;
                   4929:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   4930:                 }
                   4931:             }
                   4932:         }
                   4933:     }
                   4934: }
                   4935: 
1.563     damieng  4936: # UI to edit parameter settings starting with a list of all existing parameters.
                   4937: # (called by setoverview action)
                   4938: #
                   4939: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      4940: sub overview {
1.280     albertel 4941:     my ($r) = @_;
1.208     www      4942:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4943:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  4944:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.549     raeburn  4945:     my $js = '<script type="text/javascript">'."\n".
                   4946:              '// <![CDATA['."\n".
                   4947:              &toggleparmtextbox_js()."\n".
                   4948:              &validateparms_js()."\n".
                   4949:              &ipacc_boxes_js()."\n".
1.558     raeburn  4950:              &done_proctor_js()."\n".
1.549     raeburn  4951:              '// ]]>'."\n".
                   4952:              '</script>'."\n";
1.414     droeschl 4953:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 4954:     text=>"Overview Mode"});
1.549     raeburn  4955:     my %loaditems = (
                   4956:                       'onload'   => "showHideLenient();",
                   4957:                     );
                   4958: 
                   4959:     my $start_page=&Apache::loncommon::start_page('Modify Parameters',$js,{'add_entries' => \%loaditems,});
1.298     albertel 4960:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      4961:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  4962:     &startSettingsScreen($r,'parmset',$crstype);
1.549     raeburn  4963:     $r->print('<form method="post" action="/adm/parmset?action=setoverview" name="parmform" onsubmit="return validateParms();">');
1.507     www      4964: 
1.208     www      4965: # Store modified
                   4966: 
                   4967:     &storedata($r,$crs,$dom);
                   4968: 
                   4969: # Read modified data
                   4970: 
1.552     raeburn  4971:     my ($resourcedata,$classlist)=&readdata($crs,$dom);
1.208     www      4972: 
1.214     www      4973: 
                   4974:     my $sortorder=$env{'form.sortorder'};
                   4975:     unless ($sortorder) { $sortorder='realmstudent'; }
                   4976:     &sortmenu($r,$sortorder);
                   4977: 
1.208     www      4978: # List data
                   4979: 
1.552     raeburn  4980:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist);
1.145     www      4981:     $r->print(&tableend().'<p>'.
1.527     bisitz   4982:     ($foundkeys?'<input type="submit" value="'.&mt('Save').'" />':'<span class="LC_info">'.&mt('There are no parameters.').'</span>').'</p></form>'.
1.473     amueller 4983:           &Apache::loncommon::end_page());
1.120     www      4984: }
1.121     www      4985: 
1.560     damieng  4986: # Unused sub.
1.563     damieng  4987: #
                   4988: # @param {Apache2::RequestRec} $r - the Apache request
1.333     albertel 4989: sub clean_parameters {
                   4990:     my ($r) = @_;
                   4991:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4992:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   4993: 
1.414     droeschl 4994:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
1.473     amueller 4995:         text=>"Clean Parameters"});
1.333     albertel 4996:     my $start_page=&Apache::loncommon::start_page('Clean Parameters');
                   4997:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
                   4998:     $r->print(<<ENDOVER);
                   4999: $start_page
                   5000: $breadcrumbs
                   5001: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
                   5002: ENDOVER
                   5003: # Store modified
                   5004: 
                   5005:     &storedata($r,$crs,$dom);
                   5006: 
                   5007: # Read modified data
                   5008: 
                   5009:     my $resourcedata=&readdata($crs,$dom);
                   5010: 
                   5011: # List data
                   5012: 
                   5013:     $r->print('<h3>'.
1.473     amueller 5014:           &mt('These parameters refer to resources that do not exist.').
                   5015:           '</h3>'.
                   5016:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
                   5017:           '<br />');
1.333     albertel 5018:     $r->print(&Apache::loncommon::start_data_table().
1.473     amueller 5019:           '<tr>'.
                   5020:           '<th>'.&mt('Delete').'</th>'.
                   5021:           '<th>'.&mt('Parameter').'</th>'.
                   5022:           '</tr>');
1.333     albertel 5023:     foreach my $thiskey (sort(keys(%{$resourcedata}))) {
1.560     damieng  5024:         next if (!exists($resourcedata->{$thiskey.'.type'})
                   5025:             && $thiskey=~/\.type$/);
                   5026:         my %data = &parse_key($thiskey);
                   5027:         if (1) { #exists($data{'realm_exists'})
                   5028:             #&& !$data{'realm_exists'}) {
                   5029:             $r->print(&Apache::loncommon::start_data_table_row().
                   5030:                 '<tr>'.
                   5031:                 '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>'              );
                   5032: 
                   5033:             $r->print('<td>');
                   5034:             my $display_value = $resourcedata->{$thiskey};
                   5035:             if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
                   5036:             $display_value =
                   5037:                 &Apache::lonlocal::locallocaltime($display_value);
                   5038:             }
1.470     raeburn  5039:             my $parmitem = &standard_parameter_names($data{'parameter_name'});
                   5040:             $parmitem = &mt($parmitem);
1.560     damieng  5041:             $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
                   5042:                 $parmitem,$resourcedata->{$thiskey}));
                   5043:             $r->print('<br />');
                   5044:             if ($data{'scope_type'} eq 'all') {
                   5045:                 $r->print(&mt('All users'));
                   5046:             } elsif ($data{'scope_type'} eq 'user') {
                   5047:                 $r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
                   5048:             } elsif ($data{'scope_type'} eq 'section') {
                   5049:                 $r->print(&mt('Section: [_1]',$data{'scope'}));
                   5050:             } elsif ($data{'scope_type'} eq 'group') {
                   5051:                 $r->print(&mt('Group: [_1]',$data{'scope'}));
                   5052:             }
                   5053:             $r->print('<br />');
                   5054:             if ($data{'realm_type'} eq 'all') {
                   5055:                 $r->print(&mt('All Resources'));
                   5056:             } elsif ($data{'realm_type'} eq 'folder') {
                   5057:                 $r->print(&mt('Folder: [_1]'),$data{'realm'});
                   5058:             } elsif ($data{'realm_type'} eq 'symb') {
                   5059:             my ($map,$resid,$url) =
                   5060:                 &Apache::lonnet::decode_symb($data{'realm'});
                   5061:             $r->print(&mt('Resource: [_1]with ID: [_2]in folder [_3]',
                   5062:                         $url.' <br />&nbsp;&nbsp;&nbsp;',
                   5063:                         $resid.' <br />&nbsp;&nbsp;&nbsp;',$map));
                   5064:             }
                   5065:             $r->print(' <br />&nbsp;&nbsp;&nbsp;'.&mt('Part: [_1]',$data{'parameter_part'}));
                   5066:             $r->print('</td></tr>');
                   5067: 
1.473     amueller 5068:         }
1.333     albertel 5069:     }
                   5070:     $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.473     amueller 5071:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.
1.507     www      5072:           '</p></form>');
                   5073:     &endSettingsScreen($r);
                   5074:     $r->print(&Apache::loncommon::end_page());
1.333     albertel 5075: }
                   5076: 
1.563     damieng  5077: # UI to shift all dates (called by dateshift1 action).
                   5078: # Used by overview mode.
                   5079: #
                   5080: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5081: sub date_shift_one {
                   5082:     my ($r) = @_;
                   5083:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5084:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5085:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.390     www      5086: 
1.414     droeschl 5087:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5088:         text=>"Shifting Dates"});
1.390     www      5089:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5090:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5091:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5092:     &startSettingsScreen($r,'parmset',$crstype);
1.538     bisitz   5093:     $r->print('<form name="shiftform" method="post" action="">'.
1.390     www      5094:               '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
                   5095:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
                   5096:               '<tr><td>'.&mt('Shifted date:').'</td><td>'.
1.541     bisitz   5097:                     &Apache::lonhtmlcommon::date_setter('shiftform',
1.390     www      5098:                                                         'timeshifted',
                   5099:                                                         $env{'form.timebase'},,
                   5100:                                                         '').
                   5101:               '</td></tr></table>'.
                   5102:               '<input type="hidden" name="action" value="dateshift2" />'.
                   5103:               '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
                   5104:               '<input type="submit" value="'.&mt('Shift all dates accordingly').'" /></form>');
1.507     www      5105:     &endSettingsScreen($r);
1.390     www      5106:     $r->print(&Apache::loncommon::end_page());
                   5107: }
                   5108: 
1.563     damieng  5109: # UI to shift all dates (second form).
                   5110: #
                   5111: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5112: sub date_shift_two {
                   5113:     my ($r) = @_;
                   5114:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5115:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5116:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 5117:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5118:         text=>"Shifting Dates"});
1.390     www      5119:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5120:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5121:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5122:     &startSettingsScreen($r,'parmset',$crstype);
1.390     www      5123:     my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
1.543     bisitz   5124:     $r->print('<h2>'.&mt('Shift Dates').'</h2>'.
                   5125:               '<p>'.&mt('Shifting all dates such that [_1] becomes [_2]',
1.390     www      5126:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
1.543     bisitz   5127:               &Apache::lonlocal::locallocaltime($timeshifted)).'</p>');
1.390     www      5128:     my $delta=$timeshifted-$env{'form.timebase'};
                   5129:     &dateshift($delta);
1.543     bisitz   5130:     $r->print(
                   5131:         &Apache::lonhtmlcommon::confirm_success(&mt('Done')).
                   5132:         '<br /><br />'.
                   5133:         &Apache::lonhtmlcommon::actionbox(
                   5134:             ['<a href="/adm/parmset">'.&mt('Content and Problem Settings').'</a>']));
1.507     www      5135:     &endSettingsScreen($r);
1.390     www      5136:     $r->print(&Apache::loncommon::end_page());
                   5137: }
                   5138: 
1.563     damieng  5139: # Returns the different components of a resourcedata key.
                   5140: # Keys: scope_type, scope, realm_type, realm, realm_title,
                   5141: #       realm_exists, parameter_part, parameter_name.
                   5142: # Was used by clean_parameters (which is unused).
                   5143: #
                   5144: # @param {string} $key - the parameter key
                   5145: # @returns {hash}
1.333     albertel 5146: sub parse_key {
                   5147:     my ($key) = @_;
                   5148:     my %data;
                   5149:     my ($middle,$part,$name)=
1.473     amueller 5150:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.333     albertel 5151:     $data{'scope_type'} = 'all';
                   5152:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  5153:         $data{'scope'} = $1;
                   5154:         if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
                   5155:             $data{'scope_type'} = 'user';
                   5156:             $data{'scope'} = [$1,$2];
                   5157:         } else {
                   5158:             #FIXME check for group scope
                   5159:             $data{'scope_type'} = 'section';
                   5160:         }
                   5161:         $middle=~s/^\[(.*)\]//;
1.333     albertel 5162:     }
                   5163:     $middle=~s/\.+$//;
                   5164:     $middle=~s/^\.+//;
                   5165:     $data{'realm_type'}='all';
                   5166:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.560     damieng  5167:         $data{'realm'} = $1;
                   5168:         $data{'realm_type'} = 'folder';
                   5169:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5170:         ($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
1.333     albertel 5171:     } elsif ($middle) {
1.560     damieng  5172:         $data{'realm'} = $middle;
                   5173:         $data{'realm_type'} = 'symb';
                   5174:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5175:         my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
                   5176:         $data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
1.333     albertel 5177:     }
1.446     bisitz   5178: 
1.333     albertel 5179:     $data{'parameter_part'} = $part;
                   5180:     $data{'parameter_name'} = $name;
                   5181: 
                   5182:     return %data;
                   5183: }
                   5184: 
1.239     raeburn  5185: 
1.563     damieng  5186: # Calls loncommon::start_page with the "Settings" title.
1.416     jms      5187: sub header {
1.507     www      5188:     return &Apache::loncommon::start_page('Settings');
1.416     jms      5189: }
1.193     albertel 5190: 
                   5191: 
                   5192: 
1.560     damieng  5193: ##################################################
                   5194: # MAIN MENU
                   5195: ##################################################
                   5196: 
1.563     damieng  5197: # Content and problem settings main menu.
                   5198: #
                   5199: # @param {Apache2::RequestRec} $r - the Apache request
                   5200: # @param {boolean} $parm_permission - true if the user has permission to edit the current course or section
1.193     albertel 5201: sub print_main_menu {
                   5202:     my ($r,$parm_permission)=@_;
                   5203:     #
1.414     droeschl 5204:     $r->print(&header());
1.507     www      5205:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Content and Problem Settings'));
1.531     raeburn  5206:     my $crstype = &Apache::loncommon::course_type();
                   5207:     my $lc_crstype = lc($crstype);
                   5208: 
                   5209:     &startSettingsScreen($r,'parmset',$crstype);
1.193     albertel 5210:     $r->print(<<ENDMAINFORMHEAD);
                   5211: <form method="post" enctype="multipart/form-data"
                   5212:       action="/adm/parmset" name="studentform">
                   5213: ENDMAINFORMHEAD
                   5214: #
1.195     albertel 5215:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5216:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 5217:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366     albertel 5218:     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.520     raeburn  5219:     my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});
                   5220:     if ((!$dcm) && ($env{'request.course.sec'} ne '')) {
                   5221:         $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.
                   5222:                                         '/'.$env{'request.course.sec'});
                   5223:     }
1.268     albertel 5224: 
1.193     albertel 5225:     my @menu =
1.507     www      5226:         ( { categorytitle=>"Content Settings for this $crstype",
1.473     amueller 5227:         items => [
                   5228:           { linktext => 'Portfolio Metadata',
                   5229:             url => '/adm/parmset?action=setrestrictmeta',
                   5230:             permission => $parm_permission,
1.477     raeburn  5231:             linktitle => "Restrict metadata for this $lc_crstype." ,
1.473     amueller 5232:             icon =>'contact-new.png'   ,
                   5233:             },
                   5234:           { linktext => 'Reset Student Access Times',
                   5235:             url => '/adm/helper/resettimes.helper',
                   5236:             permission => $mgr,
1.477     raeburn  5237:             linktitle => "Reset access times for folders/maps, resources or the $lc_crstype."  ,
1.473     amueller 5238:             icon => 'start-here.png'  ,
                   5239:             },
1.520     raeburn  5240:           { linktext => 'Blocking Communication/Resource Access',
                   5241:             url => '/adm/setblock',
                   5242:             permission => $dcm,
                   5243:             linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',
                   5244:             icon => 'comblock.png',
                   5245:             },
1.473     amueller 5246:           { linktext => 'Set Parameter Setting Default Actions',
                   5247:             url => '/adm/parmset?action=setdefaults',
                   5248:             permission => $parm_permission,
                   5249:             linktitle =>'Set default actions for parameters.'  ,
                   5250:             icon => 'folder-new.png'  ,
                   5251:             }]},
                   5252:       { categorytitle => 'New and Existing Parameter Settings for Resources',
                   5253:         items => [
                   5254:           { linktext => 'Edit Resource Parameters - Helper Mode',
                   5255:             url => '/adm/helper/parameter.helper',
                   5256:             permission => $parm_permission,
                   5257:             linktitle =>'Set/Modify resource parameters in helper mode.'  ,
                   5258:             icon => 'dialog-information.png'  ,
                   5259:             #help => 'Parameter_Helper',
                   5260:             },
                   5261:           { linktext => 'Edit Resource Parameters - Overview Mode',
                   5262:             url => '/adm/parmset?action=newoverview',
                   5263:             permission => $parm_permission,
                   5264:             linktitle =>'Set/Modify resource parameters in overview mode.'  ,
                   5265:             icon => 'edit-find.png'  ,
                   5266:             #help => 'Parameter_Overview',
                   5267:             },
                   5268:           { linktext => 'Edit Resource Parameters - Table Mode',
                   5269:             url => '/adm/parmset?action=settable',
                   5270:             permission => $parm_permission,
                   5271:             linktitle =>'Set/Modify resource parameters in table mode.'  ,
                   5272:             icon => 'edit-copy.png'  ,
                   5273:             #help => 'Table_Mode',
                   5274:             }]},
1.417     droeschl 5275:            { categorytitle => 'Existing Parameter Settings for Resources',
1.473     amueller 5276:          items => [
                   5277:           { linktext => 'Modify Resource Parameters - Overview Mode',
                   5278:             url => '/adm/parmset?action=setoverview',
                   5279:             permission => $parm_permission,
                   5280:             linktitle =>'Set/Modify existing resource parameters in overview mode.'  ,
                   5281:             icon => 'preferences-desktop-wallpaper.png'  ,
                   5282:             #help => 'Parameter_Overview',
                   5283:             },
                   5284:           { linktext => 'Change Log',
                   5285:             url => '/adm/parmset?action=parameterchangelog',
                   5286:             permission => $parm_permission,
1.477     raeburn  5287:             linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,
1.487     wenzelju 5288:             icon => 'document-properties.png',
1.473     amueller 5289:             }]}
1.193     albertel 5290:           );
1.414     droeschl 5291:     $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.539     raeburn  5292:     $r->print('</form>');
1.507     www      5293:     &endSettingsScreen($r);
1.539     raeburn  5294:     $r->print(&Apache::loncommon::end_page());
1.193     albertel 5295:     return;
                   5296: }
1.414     droeschl 5297: 
1.416     jms      5298: 
                   5299: 
1.560     damieng  5300: ##################################################
                   5301: # PORTFOLIO METADATA
                   5302: ##################################################
                   5303: 
1.563     damieng  5304: # Prints HTML to edit an item of portfolio metadata. The HTML contains several td elements (no tr).
                   5305: # It looks like field titles are not localized.
                   5306: #
                   5307: # @param {Apache2::RequestRec} $r - the Apache request
                   5308: # @param {string} $field_name - metadata field name
                   5309: # @param {string} $field_text - metadata field title, in English unless manually added
                   5310: # @param {boolean} $added_flag - true if the field was manually added
1.252     banghart 5311: sub output_row {
1.347     banghart 5312:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 5313:     my $output;
1.263     banghart 5314:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   5315:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 5316:     if (!defined($options)) {
1.254     banghart 5317:         $options = 'active,stuadd';
1.261     banghart 5318:         $values = '';
1.252     banghart 5319:     }
1.337     banghart 5320:     if (!($options =~ /deleted/)) {
                   5321:         my @options= ( ['active', 'Show to student'],
1.418     schafran 5322:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 5323:                     ['choices','Provide choices for students to select from']);
1.473     amueller 5324: #           ['onlyone','Student may select only one choice']);
1.337     banghart 5325:         if ($added_flag) {
                   5326:             push @options,['deleted', 'Delete Metadata Field'];
                   5327:         }
1.351     banghart 5328:        $output = &Apache::loncommon::start_data_table_row();
1.451     bisitz   5329:         $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351     banghart 5330:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 5331:         foreach my $opt (@options) {
1.560     damieng  5332:             my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   5333:             $output .= &Apache::loncommon::continue_data_table_row();
                   5334:             $output .= '<td>'.('&nbsp;' x 5).'<label>
                   5335:                     <input type="checkbox" name="'.
                   5336:                     $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   5337:                     &mt($opt->[1]).'</label></td>';
                   5338:             $output .= &Apache::loncommon::end_data_table_row();
                   5339:         }
1.351     banghart 5340:         $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   5341:         $output .= '<td>'.('&nbsp;' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351     banghart 5342:         $output .= &Apache::loncommon::end_data_table_row();
                   5343:         my $multiple_checked;
                   5344:         my $single_checked;
                   5345:         if ($options =~ m/onlyone/) {
1.422     bisitz   5346:             $multiple_checked = '';
1.423     bisitz   5347:             $single_checked = ' checked="checked"';
1.351     banghart 5348:         } else {
1.423     bisitz   5349:             $multiple_checked = ' checked="checked"';
1.422     bisitz   5350:             $single_checked = '';
1.351     banghart 5351:         }
1.560     damieng  5352:         $output .= &Apache::loncommon::continue_data_table_row();
                   5353:         $output .= '<td>'.('&nbsp;' x 10).'
                   5354:                     <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
                   5355:                     '.&mt('Student may select multiple choices from list').'</td>';
                   5356:         $output .= &Apache::loncommon::end_data_table_row();
                   5357:         $output .= &Apache::loncommon::continue_data_table_row();
                   5358:         $output .= '<td>'.('&nbsp;' x 10).'
                   5359:                     <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />
                   5360:                     '.&mt('Student may select only one choice from list').'</td>';
                   5361:         $output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 5362:     }
                   5363:     return ($output);
                   5364: }
1.416     jms      5365: 
                   5366: 
1.560     damieng  5367: # UI to order portfolio metadata fields.
1.563     damieng  5368: # Currently useless because addmetafield does not work.
                   5369: #
                   5370: # @param {Apache2::RequestRec} $r - the Apache request
1.340     banghart 5371: sub order_meta_fields {
                   5372:     my ($r)=@_;
                   5373:     my $idx = 1;
                   5374:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5375:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5376:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};;
1.341     banghart 5377:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.560     damieng  5378:     &Apache::lonhtmlcommon::add_breadcrumb(
                   5379:         {href=>'/adm/parmset?action=addmetadata',
1.473     amueller 5380:         text=>"Add Metadata Field"});
1.560     damieng  5381:     &Apache::lonhtmlcommon::add_breadcrumb(
                   5382:         {href=>"/adm/parmset?action=setrestrictmeta",
                   5383:         text=>"Restrict Metadata"},
                   5384:         {text=>"Order Metadata"});
1.345     banghart 5385:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.531     raeburn  5386:     &startSettingsScreen($r,'parmset',$crstype);
1.340     banghart 5387:     if ($env{'form.storeorder'}) {
                   5388:         my $newpos = $env{'form.newpos'} - 1;
                   5389:         my $currentpos = $env{'form.currentpos'} - 1;
                   5390:         my @neworder = ();
1.548     raeburn  5391:         my @oldorder = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 5392:         my $i;
1.341     banghart 5393:         if ($newpos > $currentpos) {
1.340     banghart 5394:         # moving stuff up
                   5395:             for ($i=0;$i<$currentpos;$i++) {
1.560     damieng  5396:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 5397:             }
                   5398:             for ($i=$currentpos;$i<$newpos;$i++) {
1.560     damieng  5399:                 $neworder[$i]=$oldorder[$i+1];
1.340     banghart 5400:             }
                   5401:             $neworder[$newpos]=$oldorder[$currentpos];
                   5402:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
1.560     damieng  5403:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 5404:             }
                   5405:         } else {
                   5406:         # moving stuff down
1.473     amueller 5407:             for ($i=0;$i<$newpos;$i++) {
                   5408:                 $neworder[$i]=$oldorder[$i];
                   5409:             }
                   5410:             $neworder[$newpos]=$oldorder[$currentpos];
                   5411:             for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   5412:                 $neworder[$i]=$oldorder[$i-1];
                   5413:             }
                   5414:             for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   5415:                 $neworder[$i]=$oldorder[$i];
                   5416:             }
1.340     banghart 5417:         }
1.560     damieng  5418:         my $ordered_fields = join ",", @neworder;
1.343     banghart 5419:         my $put_result = &Apache::lonnet::put('environment',
1.560     damieng  5420:                         {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   5421:         &Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 5422:     }
1.357     raeburn  5423:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 5424:     my $ordered_fields;
1.548     raeburn  5425:     my @fields_in_order = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 5426:     if (!@fields_in_order) {
                   5427:         # no order found, pick sorted order then create metadata.addedorder key.
1.548     raeburn  5428:         foreach my $key (sort(keys(%$fields))) {
1.340     banghart 5429:             push @fields_in_order, $key;
1.341     banghart 5430:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 5431:         }
1.341     banghart 5432:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   5433:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   5434:     }
1.340     banghart 5435:     $r->print('<table>');
                   5436:     my $num_fields = scalar(@fields_in_order);
                   5437:     foreach my $key (@fields_in_order) {
                   5438:         $r->print('<tr><td>');
                   5439:         $r->print('<form method="post" action="">');
1.537     bisitz   5440:         $r->print('<select name="newpos" onchange="this.form.submit()">');
1.340     banghart 5441:         for (my $i = 1;$i le $num_fields;$i ++) {
                   5442:             if ($i eq $idx) {
                   5443:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   5444:             } else {
                   5445:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   5446:             }
                   5447:         }
                   5448:         $r->print('</select></td><td>');
                   5449:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   5450:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   5451:         $r->print('</form>');
                   5452:         $r->print($$fields{$key}.'</td></tr>');
                   5453:         $idx ++;
                   5454:     }
                   5455:     $r->print('</table>');
1.507     www      5456:     &endSettingsScreen($r);
1.340     banghart 5457:     return 'ok';
                   5458: }
1.416     jms      5459: 
                   5460: 
1.563     damieng  5461: # Returns HTML with a Continue button redirecting to the initial portfolio metadata screen.
                   5462: # @returns {string}
1.359     banghart 5463: sub continue {
                   5464:     my $output;
                   5465:     $output .= '<form action="" method="post">';
                   5466:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
                   5467:     $output .= '<input type="submit" value="Continue" />';
                   5468:     return ($output);
                   5469: }
1.416     jms      5470: 
                   5471: 
1.563     damieng  5472: # UI to add a metadata field.
                   5473: # Currenly does not work because of an HTML error (the field is not visible).
                   5474: #
                   5475: # @param {Apache2::RequestRec} $r - the Apache request
1.334     banghart 5476: sub addmetafield {
                   5477:     my ($r)=@_;
1.414     droeschl 5478:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 5479:         text=>"Add Metadata Field"});
1.334     banghart 5480:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   5481:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 5482:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5483:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5484:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   5485:     &startSettingsScreen($r,'parmset',$crstype);
1.339     banghart 5486:     if (exists($env{'form.undelete'})) {
1.358     banghart 5487:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 5488:         foreach my $meta_field(@meta_fields) {
                   5489:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   5490:             $options =~ s/deleted//;
                   5491:             $options =~ s/,,/,/;
                   5492:             my $put_result = &Apache::lonnet::put('environment',
                   5493:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446     bisitz   5494: 
1.339     banghart 5495:             $r->print('Undeleted Metadata Field <strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}."</strong> with result ".$put_result.'<br />');
                   5496:         }
1.359     banghart 5497:         $r->print(&continue());
1.339     banghart 5498:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 5499:         my $meta_field = $env{'form.fieldname'};
                   5500:         my $display_field = $env{'form.fieldname'};
                   5501:         $meta_field =~ s/\W/_/g;
1.338     banghart 5502:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 5503:         my $put_result = &Apache::lonnet::put('environment',
                   5504:                             {'metadata.'.$meta_field.'.values'=>"",
                   5505:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   5506:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.359     banghart 5507:         $r->print('Added new Metadata Field <strong>'.$env{'form.fieldname'}."</strong> with result ".$put_result.'<br />');
                   5508:         $r->print(&continue());
1.335     banghart 5509:     } else {
1.357     raeburn  5510:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 5511:         if ($fields) {
                   5512:             $r->print('You may undelete previously deleted fields.<br />Check those you wish to undelete and click Undelete.<br />');
                   5513:             $r->print('<form method="post" action="">');
                   5514:             foreach my $key(keys(%$fields)) {
1.358     banghart 5515:                 $r->print('<input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'<br /');
1.339     banghart 5516:             }
                   5517:             $r->print('<input type="submit" name="undelete" value="Undelete" />');
                   5518:             $r->print('</form>');
                   5519:         }
1.563     damieng  5520:         $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 5521:         $r->print('<input type="text" name="fieldname" /><br />');
                   5522:         $r->print('<input type="submit" value="Add Metadata Field" />');
1.334     banghart 5523:     }
1.361     albertel 5524:     $r->print('</form>');
1.507     www      5525:     &endSettingsScreen($r);
1.334     banghart 5526: }
1.416     jms      5527: 
                   5528: 
                   5529: 
1.560     damieng  5530: # Display or save portfolio metadata.
1.563     damieng  5531: #
                   5532: # @param {Apache2::RequestRec} $r - the Apache request
1.259     banghart 5533: sub setrestrictmeta {
1.240     banghart 5534:     my ($r)=@_;
1.242     banghart 5535:     my $next_meta;
1.244     banghart 5536:     my $output;
1.245     banghart 5537:     my $item_num;
1.246     banghart 5538:     my $put_result;
1.414     droeschl 5539:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
1.473     amueller 5540:         text=>"Restrict Metadata"});
1.280     albertel 5541:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 5542:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 5543:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5544:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5545:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   5546:     &startSettingsScreen($r,'parmset',$crstype);
1.259     banghart 5547:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 5548:     my $save_field = '';
1.259     banghart 5549:     if ($env{'form.restrictmeta'}) {
1.254     banghart 5550:         foreach my $field (sort(keys(%env))) {
1.252     banghart 5551:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 5552:                 my $options;
1.252     banghart 5553:                 my $meta_field = $1;
                   5554:                 my $meta_key = $2;
1.253     banghart 5555:                 if ($save_field ne $meta_field) {
1.252     banghart 5556:                     $save_field = $meta_field;
1.473     amueller 5557:                     if ($env{'form.'.$meta_field.'_stuadd'}) {
                   5558:                         $options.='stuadd,';
                   5559:                     }
                   5560:                     if ($env{'form.'.$meta_field.'_choices'}) {
                   5561:                         $options.='choices,';
                   5562:                     }
                   5563:                     if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
                   5564:                         $options.='onlyone,';
                   5565:                     }
                   5566:                     if ($env{'form.'.$meta_field.'_active'}) {
                   5567:                         $options.='active,';
                   5568:                     }
                   5569:                     if ($env{'form.'.$meta_field.'_deleted'}) {
                   5570:                         $options.='deleted,';
                   5571:                     }
1.259     banghart 5572:                     my $name = $save_field;
1.560     damieng  5573:                     $put_result = &Apache::lonnet::put('environment',
                   5574:                         {'metadata.'.$meta_field.'.options'=>$options,
                   5575:                         'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
                   5576:                         },$dom,$crs);
1.252     banghart 5577:                 }
                   5578:             }
                   5579:         }
                   5580:     }
1.296     albertel 5581:     &Apache::lonnet::coursedescription($env{'request.course.id'},
1.473     amueller 5582:                        {'freshen_cache' => 1});
1.335     banghart 5583:     # Get the default metadata fields
1.258     albertel 5584:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 5585:     # Now get possible added metadata fields
1.357     raeburn  5586:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.346     banghart 5587:     my $row_alt = 1;
1.347     banghart 5588:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 5589:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 5590:         if ($field ne 'courserestricted') {
1.346     banghart 5591:             $row_alt = $row_alt ? 0 : 1;
1.560     damieng  5592:             $output.= &output_row($r, $field, $metadata_fields{$field});
                   5593:         }
1.255     banghart 5594:     }
1.351     banghart 5595:     my $buttons = (<<ENDButtons);
                   5596:         <input type="submit" name="restrictmeta" value="Save" />
                   5597:         </form><br />
                   5598:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
                   5599:         <input type="submit" name="restrictmeta" value="Add a Metadata Field" />
                   5600:         </form>
                   5601:         <br />
                   5602:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
                   5603:         <input type="submit" name="restrictmeta" value="Order Metadata Fields" />
                   5604: ENDButtons
1.337     banghart 5605:     my $added_flag = 1;
1.335     banghart 5606:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.346     banghart 5607:         $row_alt = $row_alt ? 0 : 1;
1.563     damieng  5608:         $output.= &output_row($r, $field, $$added_metadata_fields{$field},$added_flag, $row_alt); # FIXME: wrong parameters
1.335     banghart 5609:     }
1.347     banghart 5610:     $output .= &Apache::loncommon::end_data_table();
1.446     bisitz   5611:     $r->print(<<ENDenv);
1.259     banghart 5612:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 5613:         $output
1.351     banghart 5614:         $buttons
1.340     banghart 5615:         </form>
1.244     banghart 5616: ENDenv
1.507     www      5617:     &endSettingsScreen($r);
1.280     albertel 5618:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 5619:     return 'ok';
                   5620: }
1.416     jms      5621: 
                   5622: 
1.563     damieng  5623: # Returns metadata fields that have been manually added.
                   5624: #
                   5625: # @param {string} $cid - course id
                   5626: # @returns {hash reference} - hash field name -> field title (not localized)
1.335     banghart 5627: sub get_added_meta_fieldnames {
1.357     raeburn  5628:     my ($cid) = @_;
1.335     banghart 5629:     my %fields;
                   5630:     foreach my $key(%env) {
1.357     raeburn  5631:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 5632:             my $field_name = $1;
                   5633:             my ($display_field_name) = $env{$key};
                   5634:             $fields{$field_name} = $display_field_name;
                   5635:         }
                   5636:     }
                   5637:     return \%fields;
                   5638: }
1.416     jms      5639: 
                   5640: 
1.563     damieng  5641: # Returns metadata fields that have been manually added and deleted.
                   5642: #
                   5643: # @param {string} $cid - course id
                   5644: # @returns {hash reference} - hash field name -> field title (not localized)
1.339     banghart 5645: sub get_deleted_meta_fieldnames {
1.357     raeburn  5646:     my ($cid) = @_;
1.339     banghart 5647:     my %fields;
                   5648:     foreach my $key(%env) {
1.357     raeburn  5649:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 5650:             my $field_name = $1;
                   5651:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   5652:                 my ($display_field_name) = $env{$key};
                   5653:                 $fields{$field_name} = $display_field_name;
                   5654:             }
                   5655:         }
                   5656:     }
                   5657:     return \%fields;
                   5658: }
1.560     damieng  5659: 
                   5660: 
                   5661: ##################################################
                   5662: # PARAMETER SETTINGS DEFAULT ACTIONS
                   5663: ##################################################
                   5664: 
                   5665: # UI to change parameter setting default actions
1.563     damieng  5666: #
                   5667: # @param {Apache2::RequestRec} $r - the Apache request
1.220     www      5668: sub defaultsetter {
1.280     albertel 5669:     my ($r) = @_;
                   5670: 
1.414     droeschl 5671:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
1.473     amueller 5672:         text=>"Set Defaults"});
1.531     raeburn  5673:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5674:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5675:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.446     bisitz   5676:     my $start_page =
1.531     raeburn  5677:         &Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 5678:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.507     www      5679:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5680:     &startSettingsScreen($r,'parmset',$crstype);
1.507     www      5681:     $r->print('<form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">');
1.280     albertel 5682: 
1.221     www      5683:     my @ids=();
                   5684:     my %typep=();
                   5685:     my %keyp=();
                   5686:     my %allparms=();
                   5687:     my %allparts=();
                   5688:     my %allmaps=();
                   5689:     my %mapp=();
                   5690:     my %symbp=();
                   5691:     my %maptitles=();
                   5692:     my %uris=();
                   5693:     my %keyorder=&standardkeyorder();
                   5694:     my %defkeytype=();
                   5695: 
1.446     bisitz   5696:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 5697:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   5698:                 \%keyorder,\%defkeytype);
1.224     www      5699:     if ($env{'form.storerules'}) {
1.560     damieng  5700:         my %newrules=();
                   5701:         my @delrules=();
                   5702:         my %triggers=();
                   5703:         foreach my $key (keys(%env)) {
1.225     albertel 5704:             if ($key=~/^form\.(\w+)\_action$/) {
1.560     damieng  5705:                 my $tempkey=$1;
                   5706:                 my $action=$env{$key};
1.226     www      5707:                 if ($action) {
1.560     damieng  5708:                     $newrules{$tempkey.'_action'}=$action;
                   5709:                     if ($action ne 'default') {
                   5710:                         my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   5711:                         $triggers{$whichparm}.=$tempkey.':';
                   5712:                     }
                   5713:                     $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
                   5714:                     if (&isdateparm($defkeytype{$tempkey})) {
                   5715:                         $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
                   5716:                         $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   5717:                         $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   5718:                         $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   5719:                     } else {
                   5720:                         $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
                   5721:                         $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
                   5722:                     }
                   5723:                 } else {
                   5724:                     push(@delrules,$tempkey.'_action');
                   5725:                     push(@delrules,$tempkey.'_type');
                   5726:                     push(@delrules,$tempkey.'_hours');
                   5727:                     push(@delrules,$tempkey.'_min');
                   5728:                     push(@delrules,$tempkey.'_sec');
                   5729:                     push(@delrules,$tempkey.'_value');
                   5730:                 }
1.473     amueller 5731:             }
                   5732:         }
1.560     damieng  5733:         foreach my $key (keys(%allparms)) {
                   5734:             $newrules{$key.'_triggers'}=$triggers{$key};
1.473     amueller 5735:         }
1.560     damieng  5736:         &Apache::lonnet::put('parmdefactions',\%newrules,$cdom,$cnum);
                   5737:         &Apache::lonnet::del('parmdefactions',\@delrules,$cdom,$cnum);
                   5738:         &resetrulescache();
1.224     www      5739:     }
1.227     www      5740:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
1.473     amueller 5741:                        'hours' => 'Hours',
                   5742:                        'min' => 'Minutes',
                   5743:                        'sec' => 'Seconds',
                   5744:                        'yes' => 'Yes',
                   5745:                        'no' => 'No');
1.222     www      5746:     my @standardoptions=('','default');
                   5747:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   5748:     my @dateoptions=('','default');
                   5749:     my @datedisplay=('',&mt('Default value when manually setting'));
                   5750:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  5751:         unless ($tempkey) { next; }
                   5752:         push @standardoptions,'when_setting_'.$tempkey;
                   5753:         push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   5754:         if (&isdateparm($defkeytype{$tempkey})) {
                   5755:             push @dateoptions,'later_than_'.$tempkey;
                   5756:             push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   5757:             push @dateoptions,'earlier_than_'.$tempkey;
                   5758:             push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   5759:         }
1.222     www      5760:     }
1.563     damieng  5761:     $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   5762:         &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 5763:     $r->print("\n".&Apache::loncommon::start_data_table().
1.473     amueller 5764:           &Apache::loncommon::start_data_table_header_row().
                   5765:           "<th>".&mt('Rule for parameter').'</th><th>'.
                   5766:           &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   5767:           &Apache::loncommon::end_data_table_header_row());
1.221     www      5768:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  5769:         unless ($tempkey) { next; }
                   5770:         $r->print("\n".&Apache::loncommon::start_data_table_row().
                   5771:             "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
                   5772:         my $action=&rulescache($tempkey.'_action');
                   5773:         $r->print('<select name="'.$tempkey.'_action">');
                   5774:         if (&isdateparm($defkeytype{$tempkey})) {
                   5775:             for (my $i=0;$i<=$#dateoptions;$i++) {
                   5776:             if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   5777:             $r->print("\n<option value='$dateoptions[$i]'".
                   5778:                 ($dateoptions[$i] eq $action?' selected="selected"':'').
                   5779:                 ">$datedisplay[$i]</option>");
                   5780:             }
                   5781:         } else {
                   5782:             for (my $i=0;$i<=$#standardoptions;$i++) {
                   5783:             if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   5784:             $r->print("\n<option value='$standardoptions[$i]'".
                   5785:                 ($standardoptions[$i] eq $action?' selected="selected"':'').
                   5786:                 ">$standarddisplay[$i]</option>");
                   5787:             }
1.473     amueller 5788:         }
1.560     damieng  5789:         $r->print('</select>');
                   5790:         unless (&isdateparm($defkeytype{$tempkey})) {
                   5791:             $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   5792:                 '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
1.473     amueller 5793:         }
1.560     damieng  5794:         $r->print("\n</td><td>\n");
1.222     www      5795: 
1.221     www      5796:         if (&isdateparm($defkeytype{$tempkey})) {
1.560     damieng  5797:             my $days=&rulescache($tempkey.'_days');
                   5798:             my $hours=&rulescache($tempkey.'_hours');
                   5799:             my $min=&rulescache($tempkey.'_min');
                   5800:             my $sec=&rulescache($tempkey.'_sec');
                   5801:             $r->print(<<ENDINPUTDATE);
                   5802:     <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
                   5803:     <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   5804:     <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   5805:     <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.564     raeburn  5806: ENDINPUTDATE
1.560     damieng  5807:         } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
                   5808:                 my $yeschecked='';
                   5809:                 my $nochecked='';
                   5810:                 if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   5811:                 if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
                   5812: 
                   5813:             $r->print(<<ENDYESNO);
                   5814:     <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   5815:     <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.564     raeburn  5816: ENDYESNO
1.221     www      5817:         } else {
1.560     damieng  5818:             $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
                   5819:         }
1.318     albertel 5820:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      5821:     }
1.318     albertel 5822:     $r->print(&Apache::loncommon::end_data_table().
1.473     amueller 5823:           "\n".'<input type="submit" name="storerules" value="'.
1.507     www      5824:           &mt('Save').'" /></form>'."\n");
                   5825:     &endSettingsScreen($r);
                   5826:     $r->print(&Apache::loncommon::end_page());
1.220     www      5827:     return;
                   5828: }
1.193     albertel 5829: 
1.560     damieng  5830: ##################################################
                   5831: # PARAMETER CHANGES LOG
                   5832: ##################################################
                   5833: 
1.563     damieng  5834: # Returns some info for a parameter log entry.
                   5835: # Returned entries:
                   5836: # $realm - HTML title for the parameter level and resource
                   5837: # $section - parameter section
                   5838: # $name - parameter name
                   5839: # $part - parameter part
                   5840: # $what - $part.'.'.$name
                   5841: # $middle - resource symb ?
                   5842: # $uname - user name (same as given)
                   5843: # $udom - user domain (same as given)
                   5844: # $issection - section or group name
                   5845: # $realmdescription - title for the parameter level and resource (without using HTML)
                   5846: #
                   5847: # FIXME: remove unused fields.
                   5848: #
                   5849: # @param {string} $key - parameter log key
                   5850: # @param {string} $uname - user name
                   5851: # @param {string} $udom - user domain
                   5852: # @param {string} $exeuser - unused
                   5853: # @param {string} $exedomain - unused
                   5854: # @param {boolean} $typeflag - .type log entry
                   5855: # @returns {Array}
1.290     www      5856: sub components {
1.330     albertel 5857:     my ($key,$uname,$udom,$exeuser,$exedomain,$typeflag)=@_;
                   5858: 
                   5859:     if ($typeflag) {
1.560     damieng  5860:         $key=~s/\.type$//;
1.290     www      5861:     }
1.330     albertel 5862: 
                   5863:     my ($middle,$part,$name)=
1.560     damieng  5864:         ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.291     www      5865:     my $issection;
1.330     albertel 5866: 
1.290     www      5867:     my $section=&mt('All Students');
                   5868:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  5869:         $issection=$1;
                   5870:         $section=&mt('Group/Section').': '.$issection;
                   5871:         $middle=~s/^\[(.*)\]//;
1.290     www      5872:     }
                   5873:     $middle=~s/\.+$//;
                   5874:     $middle=~s/^\.+//;
1.291     www      5875:     if ($uname) {
1.560     damieng  5876:         $section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   5877:         $issection='';
1.291     www      5878:     }
1.316     albertel 5879:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446     bisitz   5880:     my $realmdescription=&mt('all resources');
1.556     raeburn  5881:     if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   5882:         my $mapurl = $1;
                   5883:         my $maplevel = $2;
                   5884:         my $leveltitle = &mt('Folder/Map');
                   5885:         if ($maplevel eq 'rec') {
                   5886:             $leveltitle = &mt('Recursive');
                   5887:         }
1.560     damieng  5888:         $realm='<span class="LC_parm_scope_folder">'.$leveltitle.
                   5889:             ': '.&Apache::lonnet::gettitle($mapurl).' <span class="LC_parm_folder"><br />('.
                   5890:             $mapurl.')</span></span>';
                   5891:         $realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($mapurl);
                   5892:     } elsif ($middle) {
                   5893:         my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   5894:         $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   5895:             ': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.
                   5896:             ' in '.$map.' id: '.$id.')</span></span>';
                   5897:         $realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      5898:     }
1.291     www      5899:     my $what=$part.'.'.$name;
1.330     albertel 5900:     return ($realm,$section,$name,$part,
1.473     amueller 5901:         $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      5902: }
1.293     www      5903: 
1.563     damieng  5904: my %standard_parms; # hash parameter name -> parameter title (not localized)
                   5905: my %standard_parms_types; # hash parameter name -> parameter type
1.416     jms      5906: 
1.563     damieng  5907: # Reads parameter info from packages.tab into %standard_parms.
1.328     albertel 5908: sub load_parameter_names {
                   5909:     open(my $config,"<$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
                   5910:     while (my $configline=<$config>) {
1.560     damieng  5911:         if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   5912:         chomp($configline);
                   5913:         my ($short,$plain)=split(/:/,$configline);
                   5914:         my (undef,$name,$type)=split(/\&/,$short,3);
                   5915:         if ($type eq 'display') {
                   5916:             $standard_parms{$name} = $plain;
1.469     raeburn  5917:         } elsif ($type eq 'type') {
1.560     damieng  5918:                 $standard_parms_types{$name} = $plain;
1.469     raeburn  5919:         }
1.328     albertel 5920:     }
                   5921:     close($config);
                   5922:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   5923:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
                   5924: }
                   5925: 
1.563     damieng  5926: # Returns a parameter title for standard parameters, the name for others.
                   5927: #
                   5928: # @param {string} $name - parameter name
                   5929: # @returns {string}
1.292     www      5930: sub standard_parameter_names {
                   5931:     my ($name)=@_;
1.328     albertel 5932:     if (!%standard_parms) {
1.560     damieng  5933:         &load_parameter_names();
1.328     albertel 5934:     }
1.292     www      5935:     if ($standard_parms{$name}) {
1.560     damieng  5936:         return $standard_parms{$name};
1.446     bisitz   5937:     } else {
1.560     damieng  5938:         return $name;
1.292     www      5939:     }
                   5940: }
1.290     www      5941: 
1.563     damieng  5942: # Returns a parameter type for standard parameters, undef for others.
                   5943: #
                   5944: # @param {string} $name - parameter name
                   5945: # @returns {string}
1.469     raeburn  5946: sub standard_parameter_types {
                   5947:     my ($name)=@_;
                   5948:     if (!%standard_parms_types) {
                   5949:         &load_parameter_names();
                   5950:     }
                   5951:     if ($standard_parms_types{$name}) {
                   5952:         return $standard_parms_types{$name};
                   5953:     }
                   5954:     return;
                   5955: }
1.309     www      5956: 
1.563     damieng  5957: # Returns a parameter level title (not localized) from the parameter level name.
                   5958: #
                   5959: # @param {string} $name - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   5960: # @returns {string}
1.557     raeburn  5961: sub standard_parameter_levels {
                   5962:     my ($name)=@_;
                   5963:     my %levels = (
                   5964:                     'resourcelevel'   => 'a single resource',
                   5965:                     'maplevel'        => 'the enclosing map/folder', 
                   5966:                     'maplevelrecurse' => 'the enclosing map/folder (recursive into sub-folders)',
                   5967:                     'courselevel'     => 'the general (course) level',
                   5968:                  );
                   5969:     if ($levels{$name}) {
                   5970:         return $levels{$name};
                   5971:     }
                   5972:     return;
                   5973: }
                   5974: 
1.560     damieng  5975: # Display log for parameter changes, blog postings, user notification changes.
1.563     damieng  5976: #
                   5977: # @param {Apache2::RequestRec} $r - the Apache request
1.285     albertel 5978: sub parm_change_log {
1.284     www      5979:     my ($r)=@_;
1.531     raeburn  5980:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5981:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5982:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'}
1.414     droeschl 5983:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.473     amueller 5984:     text=>"Parameter Change Log"});
1.522     raeburn  5985:     my $js = '<script type="text/javascript">'."\n".
                   5986:              '// <![CDATA['."\n".
                   5987:              &Apache::loncommon::display_filter_js('parmslog')."\n".
                   5988:              '// ]]>'."\n".
                   5989:              '</script>'."\n";
                   5990:     $r->print(&Apache::loncommon::start_page('Parameter Change Log',$js));
1.327     albertel 5991:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
1.531     raeburn  5992:     &startSettingsScreen($r,'parmset',$crstype);
                   5993:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',$cdom,$cnum);
1.311     albertel 5994: 
1.301     www      5995:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 5996: 
1.522     raeburn  5997:     $r->print('<div class="LC_left_float">'.
                   5998:               '<fieldset><legend>'.&mt('Display of Changes').'</legend>'.
                   5999:               '<form action="/adm/parmset?action=parameterchangelog"
1.327     albertel 6000:                      method="post" name="parameterlog">');
1.446     bisitz   6001: 
1.311     albertel 6002:     my %saveable_parameters = ('show' => 'scalar',);
                   6003:     &Apache::loncommon::store_course_settings('parameter_log',
                   6004:                                               \%saveable_parameters);
                   6005:     &Apache::loncommon::restore_course_settings('parameter_log',
                   6006:                                                 \%saveable_parameters);
1.522     raeburn  6007:     $r->print(&Apache::loncommon::display_filter('parmslog').'&nbsp;'."\n".
                   6008:               '<input type="submit" value="'.&mt('Display').'" />'.
                   6009:               '</form></fieldset></div><br clear="all" />');
1.301     www      6010: 
1.531     raeburn  6011:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.301     www      6012:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
1.473     amueller 6013:           '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
                   6014:           &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th><th>'.&mt('Announce').'</th>'.
                   6015:           &Apache::loncommon::end_data_table_header_row());
1.309     www      6016:     my $shown=0;
1.349     www      6017:     my $folder='';
                   6018:     if ($env{'form.displayfilter'} eq 'currentfolder') {
1.560     damieng  6019:         my $last='';
                   6020:         if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   6021:                 &GDBM_READER(),0640)) {
                   6022:             $last=$hash{'last_known'};
                   6023:             untie(%hash);
                   6024:         }
                   6025:         if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
                   6026:     }
                   6027:     foreach my $id (sort {
                   6028:                 if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   6029:                     return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   6030:                 }
                   6031:                 my $aid = (split('00000',$a))[-1];
                   6032:                 my $bid = (split('00000',$b))[-1];
                   6033:                 return $bid<=>$aid;
1.473     amueller 6034:             } (keys(%parmlog))) {
1.294     www      6035:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.560     damieng  6036:         my $count = 0;
                   6037:         my $time =
                   6038:             &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
                   6039:         my $plainname =
                   6040:             &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   6041:                         $parmlog{$id}{'exe_udom'});
                   6042:         my $about_me_link =
                   6043:             &Apache::loncommon::aboutmewrapper($plainname,
                   6044:                             $parmlog{$id}{'exe_uname'},
                   6045:                             $parmlog{$id}{'exe_udom'});
                   6046:         my $send_msg_link='';
                   6047:         if ((($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
                   6048:             || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
                   6049:             $send_msg_link ='<br />'.
                   6050:             &Apache::loncommon::messagewrapper(&mt('Send message'),
                   6051:                             $parmlog{$id}{'exe_uname'},
                   6052:                             $parmlog{$id}{'exe_udom'});
                   6053:         }
                   6054:         my $row_start=&Apache::loncommon::start_data_table_row();
                   6055:         my $makenewrow=0;
                   6056:         my %istype=();
                   6057:         my $output;
                   6058:         foreach my $changed (reverse(sort(@changes))) {
                   6059:                 my $value=$parmlog{$id}{'logentry'}{$changed};
                   6060:             my $typeflag = ($changed =~/\.type$/ &&
                   6061:                     !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 6062:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
1.560     damieng  6063:                 &components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},undef,undef,$typeflag);
                   6064:             if ($env{'request.course.sec'} ne '') {
                   6065:                 next if (($issection ne '') && ($issection ne $env{'request.course.sec'}));
                   6066:                 if ($uname ne '') {
                   6067:                     my $stusection = &Apache::lonnet::getsection($uname,$udom,$env{'request.course.id'});
                   6068:                     next if (($stusection ne '-1') && ($stusection ne $env{'request.course.sec'})); 
                   6069:                 }
                   6070:             }
                   6071:             if ($env{'form.displayfilter'} eq 'currentfolder') {
                   6072:                 if ($folder) {
                   6073:                     if ($middle!~/^\Q$folder\E/) { next; }
                   6074:                 }
                   6075:             }
                   6076:             if ($typeflag) {
                   6077:                 $istype{$parmname}=$value;
                   6078:                 if (!$env{'form.includetypes'}) { next; }
                   6079:             }
                   6080:             $count++;
                   6081:             if ($makenewrow) {
                   6082:                 $output .= $row_start;
                   6083:             } else {
                   6084:                 $makenewrow=1;
                   6085:             }
1.470     raeburn  6086:             my $parmitem = &standard_parameter_names($parmname);
1.560     damieng  6087:             $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
                   6088:                 &mt($parmitem).'</td><td>'.
                   6089:                 ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
                   6090:             my $stillactive=0;
                   6091:             if ($parmlog{$id}{'delflag'}) {
                   6092:                 $output .= &mt('Deleted');
                   6093:             } else {
                   6094:                 if ($typeflag) {
1.470     raeburn  6095:                     my $parmitem = &standard_parameter_names($value); 
                   6096:                     $parmitem = &mt($parmitem);
1.560     damieng  6097:                     $output .= &mt('Type: [_1]',$parmitem);
                   6098:                 } else {
                   6099:                     my ($level,@all)=&parmval_by_symb($what,$middle,
                   6100:                         &Apache::lonnet::metadata($middle,$what),
                   6101:                         $uname,$udom,$issection,$issection,$courseopt);
1.469     raeburn  6102:                     my $showvalue = $value;
                   6103:                     if ($istype{$parmname} eq '') {
                   6104:                         my $type = &standard_parameter_types($parmname);
                   6105:                         if ($type ne '') {
                   6106:                             if (&isdateparm($type)) {
                   6107:                                 $showvalue =
                   6108:                                     &Apache::lonlocal::locallocaltime($value);
                   6109:                             }
                   6110:                         }
                   6111:                     } else {
1.560     damieng  6112:                         if (&isdateparm($istype{$parmname})) {
                   6113:                             $showvalue = &Apache::lonlocal::locallocaltime($value);
                   6114:                         }
1.469     raeburn  6115:                     }
                   6116:                     $output .= $showvalue;
1.560     damieng  6117:                     if ($value ne $all[$level]) {
                   6118:                         $output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
                   6119:                     } else {
                   6120:                         $stillactive=1;
                   6121:                     }
                   6122:                 }
1.473     amueller 6123:             }
1.560     damieng  6124:             $output .= '</td><td>';
                   6125:                 
                   6126:             if ($stillactive) {
1.470     raeburn  6127:                 my $parmitem = &standard_parameter_names($parmname);
                   6128:                 $parmitem = &mt($parmitem);
1.560     damieng  6129:                 my $title=&mt('Changed [_1]',$parmitem);
1.471     raeburn  6130:                 my $description=&mt('Changed [_1] for [_2] to [_3]',
1.560     damieng  6131:                     $parmitem,$realmdescription,
1.473     amueller 6132:                     (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
1.560     damieng  6133:                 if (($uname) && ($udom)) {
                   6134:                     $output .=
                   6135:                     &Apache::loncommon::messagewrapper('Notify User',
                   6136:                                     $uname,$udom,$title,
                   6137:                                     $description);
                   6138:                 } else {
                   6139:                     $output .=
                   6140:                     &Apache::lonrss::course_blog_link($id,$title,
                   6141:                                     $description);
                   6142:                 }
                   6143:             }
                   6144:             $output .= '</td>'.&Apache::loncommon::end_data_table_row();
1.473     amueller 6145:         }
1.560     damieng  6146:         if ($env{'form.displayfilter'} eq 'containing') {
                   6147:             my $wholeentry=$about_me_link.':'.
                   6148:             $parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   6149:             $output;
                   6150:             if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
1.473     amueller 6151:         }
1.349     www      6152:         if ($count) {
1.560     damieng  6153:             $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
                   6154:                         <td rowspan="'.$count.'">'.$about_me_link.
                   6155:             '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   6156:                         ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   6157:             $send_msg_link.'</td>'.$output);
                   6158:             $shown++;
                   6159:         }
                   6160:         if (!($env{'form.show'} eq &mt('all')
                   6161:             || $shown<=$env{'form.show'})) { last; }
1.286     www      6162:     }
1.301     www      6163:     $r->print(&Apache::loncommon::end_data_table());
1.507     www      6164:     &endSettingsScreen($r);
1.284     www      6165:     $r->print(&Apache::loncommon::end_page());
                   6166: }
                   6167: 
1.560     damieng  6168: ##################################################
                   6169: # MISC !
                   6170: ##################################################
                   6171: 
1.563     damieng  6172: # Stores slot information.
1.560     damieng  6173: # Used by table UI
1.563     damieng  6174: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   6175: #
                   6176: # @param {string} $slot_name - slot name
                   6177: # @param {string} $cdom - course domain
                   6178: # @param {string} $cnum - course number
                   6179: # @param {string} $symb - resource symb
                   6180: # @param {string} $uname - user name
                   6181: # @param {string} $udom - user domain
                   6182: # @returns {string} - 'ok' or error name
1.437     raeburn  6183: sub update_slots {
                   6184:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   6185:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   6186:     if (!keys(%slot)) {
                   6187:         return 'error: slot does not exist';
                   6188:     }
                   6189:     my $max=$slot{'maxspace'};
                   6190:     if (!defined($max)) { $max=99999; }
                   6191: 
                   6192:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   6193:                                        "^$slot_name\0");
                   6194:     my ($tmp)=%consumed;
                   6195:     if ($tmp=~/^error: 2 / ) {
                   6196:         return 'error: unable to determine current slot status';
                   6197:     }
                   6198:     my $last=0;
                   6199:     foreach my $key (keys(%consumed)) {
                   6200:         my $num=(split('\0',$key))[1];
                   6201:         if ($num > $last) { $last=$num; }
                   6202:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   6203:             return 'ok';
                   6204:         }
                   6205:     }
                   6206: 
                   6207:     if (scalar(keys(%consumed)) >= $max) {
                   6208:         return 'error: no space left in slot';
                   6209:     }
                   6210:     my $wanted=$last+1;
                   6211: 
                   6212:     my %reservation=('name'      => $uname.':'.$udom,
                   6213:                      'timestamp' => time,
                   6214:                      'symb'      => $symb);
                   6215: 
                   6216:     my $success=&Apache::lonnet::newput('slot_reservations',
                   6217:                                         {"$slot_name\0$wanted" =>
                   6218:                                              \%reservation},
                   6219:                                         $cdom, $cnum);
1.438     raeburn  6220:     if ($success eq 'ok') {
                   6221:         my %storehash = (
                   6222:                           symb    => $symb,
                   6223:                           slot    => $slot_name,
                   6224:                           action  => 'reserve',
                   6225:                           context => 'parameter',
                   6226:                         );
1.526     raeburn  6227:         &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  6228:                                    '',$uname,$udom,$cnum,$cdom);
1.438     raeburn  6229: 
1.526     raeburn  6230:         &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  6231:                                    '',$uname,$udom,$uname,$udom);
1.438     raeburn  6232:     }
1.437     raeburn  6233:     return $success;
                   6234: }
                   6235: 
1.563     damieng  6236: # Deletes a slot reservation.
1.560     damieng  6237: # Used by table UI
1.563     damieng  6238: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   6239: #
                   6240: # @param {string} $slot_name - slot name
                   6241: # @param {string} $cdom - course domain
                   6242: # @param {string} $cnum - course number
                   6243: # @param {string} $uname - user name
                   6244: # @param {string} $udom - user domain
                   6245: # @param {string} $symb - resource symb
                   6246: # @returns {string} - 'ok' or error name
1.437     raeburn  6247: sub delete_slots {
                   6248:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   6249:     my $delresult;
                   6250:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   6251:                                          $cnum, "^$slot_name\0");
                   6252:     if (&Apache::lonnet::error(%consumed)) {
                   6253:         return 'error: unable to determine current slot status';
                   6254:     }
                   6255:     my ($tmp)=%consumed;
                   6256:     if ($tmp=~/^error: 2 /) {
                   6257:         return 'error: unable to determine current slot status';
                   6258:     }
                   6259:     foreach my $key (keys(%consumed)) {
                   6260:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   6261:             my $num=(split('\0',$key))[1];
                   6262:             my $entry = $slot_name.'\0'.$num;
                   6263:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   6264:                                               $cdom,$cnum);
                   6265:             if ($delresult eq 'ok') {
                   6266:                 my %storehash = (
                   6267:                                   symb    => $symb,
                   6268:                                   slot    => $slot_name,
                   6269:                                   action  => 'release',
                   6270:                                   context => 'parameter',
                   6271:                                 );
1.526     raeburn  6272:                 &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  6273:                                            1,$uname,$udom,$cnum,$cdom);
1.526     raeburn  6274:                 &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  6275:                                            1,$uname,$udom,$uname,$udom);
1.437     raeburn  6276:             }
                   6277:         }
                   6278:     }
                   6279:     return $delresult;
                   6280: }
                   6281: 
1.563     damieng  6282: # Returns true if there is a current course.
1.560     damieng  6283: # Used by handler
1.563     damieng  6284: #
                   6285: # @returns {boolean}
1.355     albertel 6286: sub check_for_course_info {
                   6287:     my $navmap = Apache::lonnavmaps::navmap->new();
                   6288:     return 1 if ($navmap);
                   6289:     return 0;
                   6290: }
                   6291: 
1.563     damieng  6292: # Returns the current course host and host LON-CAPA version.
                   6293: #
                   6294: # @returns {Array} - (course hostname, major version number, minor version number)
1.514     raeburn  6295: sub parameter_release_vars { 
1.504     raeburn  6296:    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6297:    my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   6298:    my $chostname = &Apache::lonnet::hostname($chome);
                   6299:    my ($cmajor,$cminor) = 
                   6300:        split(/\./,&Apache::lonnet::get_server_loncaparev($cdom,$chome));
                   6301:    return ($chostname,$cmajor,$cminor);
                   6302: }
                   6303: 
1.563     damieng  6304: # Checks if the course host version can handle a parameter required version,
                   6305: # and if it does, stores the release needed for the course.
                   6306: #
                   6307: # @param {string} $name - parameter name
                   6308: # @param {string} $value - parameter value
                   6309: # @param {string} $valmatch - name of the test used for checking the value
                   6310: # @param {string} $namematch - name of the test used for checking the name
                   6311: # @param {string} $needsrelease - version needed by the parameter, major.minor
                   6312: # @param {integer} $cmajor - course major version number
                   6313: # @param {integer} $cminor - course minor version number
                   6314: # @returns {boolean} - true if a newer version is needed
1.514     raeburn  6315: sub parameter_releasecheck {
1.557     raeburn  6316:     my ($name,$value,$valmatch,$namematch,$needsrelease,$cmajor,$cminor) = @_;
1.504     raeburn  6317:     my $needsnewer;
                   6318:     my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
                   6319:     if (($cmajor < $needsmajor) || 
                   6320:         ($cmajor == $needsmajor && $cminor < $needsminor)) {
                   6321:         $needsnewer = 1;
1.557     raeburn  6322:     } elsif ($name) {
                   6323:         if ($valmatch) {
                   6324:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.'::'.$valmatch.':'});
                   6325:         } elsif ($value) { 
                   6326:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.':'.$value.'::'});
                   6327:         }
                   6328:     } elsif ($namematch) {
                   6329:         &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter::::'.$namematch});
1.504     raeburn  6330:     }
                   6331:     return $needsnewer;
                   6332: }
                   6333: 
1.560     damieng  6334: ##################################################
                   6335: # HANDLER
                   6336: ##################################################
                   6337: 
                   6338: # Main handler for lonparmset.
                   6339: # Sub called based on request parameters action and command:
                   6340: # no command or action: print_main_menu
                   6341: # command 'set': assessparms (direct access to table mode for a resource)
                   6342: #                (this can also be accessed simply with the symb parameter)
                   6343: # action 'setoverview': overview (display all existing parameter settings)
                   6344: # action 'addmetadata': addmetafield (called to add a portfolio metadata field)
                   6345: # action 'ordermetadata': order_meta_fields (called to order portfolio metadata fields)
                   6346: # action 'setrestrictmeta': setrestrictmeta (display or save portfolio metadata)
                   6347: # action 'newoverview': newoverview (overview mode)
                   6348: # action 'setdefaults': defaultsetter (UI to change parameter setting default actions)
                   6349: # action 'settable': assessparms (table mode)
                   6350: # action 'parameterchangelog': parm_change_log (display log for parameter changes,
                   6351: #                              blog postings, user notification changes)
                   6352: # action 'cleanparameters': clean_parameters (unused)
                   6353: # action 'dateshift1': date_shift_one (overview mode, shift all dates)
                   6354: # action 'dateshift2': date_shift_two (overview mode, shift all dates)
1.30      www      6355: sub handler {
1.43      albertel 6356:     my $r=shift;
1.30      www      6357: 
1.376     albertel 6358:     &reset_caches();
                   6359: 
1.414     droeschl 6360:     &Apache::loncommon::content_type($r,'text/html');
                   6361:     $r->send_http_header;
                   6362:     return OK if $r->header_only;
                   6363: 
1.193     albertel 6364:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.473     amueller 6365:                         ['action','state',
1.205     www      6366:                                              'pres_marker',
                   6367:                                              'pres_value',
1.206     www      6368:                                              'pres_type',
1.506     www      6369:                                              'filter','part',
1.390     www      6370:                                              'udom','uname','symb','serial','timebase']);
1.131     www      6371: 
1.83      bowersj2 6372: 
1.193     albertel 6373:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 6374:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
1.507     www      6375:                         text=>"Content and Problem Settings",
1.473     amueller 6376:                         faq=>10,
                   6377:                         bug=>'Instructor Interface',
1.442     droeschl 6378:                                             help =>
                   6379:                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203     www      6380: 
1.30      www      6381: # ----------------------------------------------------- Needs to be in a course
1.194     albertel 6382:     my $parm_permission =
1.473     amueller 6383:     (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||
                   6384:      &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
                   6385:                   $env{'request.course.sec'}));
1.355     albertel 6386:     my $exists = &check_for_course_info();
                   6387: 
                   6388:     if ($env{'request.course.id'} &&  $parm_permission && $exists) {
1.193     albertel 6389:         #
                   6390:         # Main switch on form.action and form.state, as appropriate
                   6391:         #
                   6392:         # Check first if coming from someone else headed directly for
                   6393:         #  the table mode
                   6394:         if ((($env{'form.command'} eq 'set') && ($env{'form.url'})
1.560     damieng  6395:                 && (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   6396:             &assessparms($r);
1.193     albertel 6397:         } elsif (! exists($env{'form.action'})) {
                   6398:             &print_main_menu($r,$parm_permission);
1.414     droeschl 6399:         } elsif ($env{'form.action'} eq 'setoverview') {
1.560     damieng  6400:             &overview($r);
                   6401:         } elsif ($env{'form.action'} eq 'addmetadata') {
                   6402:             &addmetafield($r);
                   6403:         } elsif ($env{'form.action'} eq 'ordermetadata') {
                   6404:             &order_meta_fields($r);
1.414     droeschl 6405:         } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.560     damieng  6406:             &setrestrictmeta($r);
1.414     droeschl 6407:         } elsif ($env{'form.action'} eq 'newoverview') {
1.560     damieng  6408:             &newoverview($r);
1.414     droeschl 6409:         } elsif ($env{'form.action'} eq 'setdefaults') {
1.560     damieng  6410:             &defaultsetter($r);
                   6411:         } elsif ($env{'form.action'} eq 'settable') {
                   6412:             &assessparms($r);
1.414     droeschl 6413:         } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.560     damieng  6414:             &parm_change_log($r);
1.414     droeschl 6415:         } elsif ($env{'form.action'} eq 'cleanparameters') {
1.560     damieng  6416:             &clean_parameters($r);
1.414     droeschl 6417:         } elsif ($env{'form.action'} eq 'dateshift1') {
1.390     www      6418:             &date_shift_one($r);
1.414     droeschl 6419:         } elsif ($env{'form.action'} eq 'dateshift2') {
1.390     www      6420:             &date_shift_two($r);
1.446     bisitz   6421:         }
1.43      albertel 6422:     } else {
1.1       www      6423: # ----------------------------- Not in a course, or not allowed to modify parms
1.560     damieng  6424:         if ($exists) {
                   6425:             $env{'user.error.msg'}=
                   6426:             "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   6427:         } else {
                   6428:             $env{'user.error.msg'}=
                   6429:             "/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   6430:         }
                   6431:         return HTTP_NOT_ACCEPTABLE;
1.43      albertel 6432:     }
1.376     albertel 6433:     &reset_caches();
                   6434: 
1.43      albertel 6435:     return OK;
1.1       www      6436: }
                   6437: 
                   6438: 1;
                   6439: __END__
                   6440: 
                   6441: 

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