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

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

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