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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.522.2.23.2.  (raeburn    4:): # $Id: lonparmset.pm,v 1.522.2.23 2017/04/02 13:39:05 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: 
                     39: lonparmset provides an interface to setting course parameters. 
                     40: 
                     41: =head1 DESCRIPTION
                     42: 
                     43: This module sets coursewide and assessment parameters.
                     44: 
                     45: =head1 INTERNAL SUBROUTINES
                     46: 
1.416     jms        47: =over
1.59      matthew    48: 
1.416     jms        49: =item parmval()
1.59      matthew    50: 
                     51: Figure out a cascading parameter.
                     52: 
1.71      albertel   53: Inputs:  $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162     albertel   54:          $id   - a bighash Id number
1.71      albertel   55:          $def  - the resource's default value   'stupid emacs
                     56: 
1.269     raeburn    57: Returns:  A list, the first item is the index into the remaining list of items of parm valuse that is the active one, the list consists of parm values at the 14 possible levels
1.71      albertel   58: 
1.306     albertel   59: 14- General Course
                     60: 13- Map or Folder level in course
1.269     raeburn    61: 12- resource default
                     62: 11- map default
1.306     albertel   63: 10- resource level in course
1.269     raeburn    64: 9 - General for section
                     65: 8 - Map or Folder level for section
                     66: 7 - resource level in section
                     67: 6 - General for group
                     68: 5 - Map or Folder level for group
                     69: 4 - resource level in group
1.71      albertel   70: 3 - General for specific student
1.82      www        71: 2 - Map or Folder level for specific student
1.71      albertel   72: 1 - resource level for specific student
1.2       www        73: 
1.416     jms        74: =item parmval_by_symb()
                     75: 
                     76: =item reset_caches()
                     77: 
                     78: =item cacheparmhash() 
                     79: 
                     80: =item parmhash()
                     81: 
                     82: =item symbcache()
                     83: 
                     84: =item preset_defaults()
                     85: 
                     86: =item date_sanity_info()
                     87: 
                     88: =item storeparm()
                     89: 
                     90: Store a parameter by symb
                     91: 
                     92:     Takes
                     93:     - symb
                     94:     - name of parameter
                     95:     - level
                     96:     - new value
                     97:     - new type
                     98:     - username
                     99:     - userdomain
                    100: 
                    101: =item log_parmset()
                    102: 
                    103: =item storeparm_by_symb_inner()
                    104: 
                    105: =item valout()
                    106: 
                    107: Format a value for output.
                    108: 
                    109: Inputs:  $value, $type, $editable
                    110: 
                    111: Returns: $value, formatted for output.  If $type indicates it is a date,
                    112: localtime($value) is returned.
                    113: $editable will return an icon to click on
                    114: 
                    115: =item plink()
                    116: 
                    117: Produces a link anchor.
                    118: 
                    119: Inputs: $type,$dis,$value,$marker,$return,$call
                    120: 
                    121: Returns: scalar with html code for a link which will envoke the 
                    122: javascript function 'pjump'.
                    123: 
                    124: =item page_js()
                    125: 
                    126: =item startpage()
                    127: 
                    128: =item print_row()
                    129: 
                    130: =item print_td()
                    131: 
                    132: =item print_usergroups()
                    133: 
                    134: =item parm_control_group()
                    135: 
                    136: =item extractResourceInformation() : 
                    137: 
1.512     foxr      138:  extractResourceInformation extracts lots of information about all of the the course's resources into a variety of hashes.
1.416     jms       139: 
1.522.2.11  raeburn   140: Input: See list below
                    141: 
                    142: =over 4
1.416     jms       143: 
1.512     foxr      144: =item * B<env{'user.name'}> : Current username
1.416     jms       145: 
1.512     foxr      146: =item * B<env{'user.domain'}> : Domain of current user.
1.416     jms       147: 
1.522.2.12  raeburn   148: =item * B<env{"request.course.fn"}> : Course
1.416     jms       149: 
1.522.2.11  raeburn   150: =back
                    151: 
                    152: Outputs: See list below
                    153: 
                    154: =over 4
1.416     jms       155: 
1.512     foxr      156: =item * B<ids> (out) : An array that will contain all of the ids in the course.
1.416     jms       157: 
1.512     foxr      158: =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       159: 
1.512     foxr      160: =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       161: 
1.512     foxr      162: =item * B<allparms> (out) : hash, name of parameter->display value (what is the display value?)
1.416     jms       163: 
1.512     foxr      164: =item * B<allparts> (out) : hash, part identification->text representation of part, where the text representation is "[Part $part]"
                    165: 
                    166: =item * B<allmaps> (out) : hash, ???
1.416     jms       167: 
                    168: =item * B<mapp> : ??
                    169: 
                    170: =item * B<symbp> : hash, id->full sym?
                    171: 
1.512     foxr      172: =item * B<maptitles>
                    173: 
                    174: =item * B<uris>
1.416     jms       175: 
1.512     foxr      176: =item * B<keyorder>
                    177: 
                    178: =item * B<defkeytype>
1.416     jms       179: 
1.522.2.11  raeburn   180: =back
                    181: 
1.416     jms       182: =item isdateparm()
                    183: 
                    184: =item parmmenu()
                    185: 
                    186: =item partmenu()
                    187: 
                    188: =item usermenu()
                    189: 
                    190: =item displaymenu()
                    191: 
                    192: =item mapmenu()
                    193: 
                    194: =item levelmenu()
                    195: 
                    196: =item sectionmenu()
                    197: 
                    198: =item keysplit()
                    199: 
                    200: =item keysinorder()
                    201: 
                    202: =item keysinorder_bytype()
                    203: 
                    204: =item keysindisplayorder()
                    205: 
                    206: =item standardkeyorder()
                    207: 
                    208: =item assessparms() : 
                    209: 
                    210: Show assessment data and parameters.  This is a large routine that should
                    211: be simplified and shortened... someday.
                    212: 
1.513     foxr      213: Inputs: $r - the Apache request object.
                    214:   
1.416     jms       215: Returns: nothing
                    216: 
                    217: Variables used (guessed by Jeremy):
                    218: 
1.522.2.11  raeburn   219: =over
                    220: 
1.416     jms       221: =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.
                    222: 
                    223: =item * B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
                    224: 
                    225: =item * B<@catmarker> contains list of all possible parameters including part #s
                    226: 
                    227: =item * B<$fullkeyp> contains the full part/id # for the extraction of proper parameters
                    228: 
                    229: =item * B<$tempkeyp> contains part 0 only (no ids - ie, subparts)
                    230:         When storing information, store as part 0
                    231:         When requesting information, request from full part
                    232: 
1.522.2.11  raeburn   233: =back
                    234: 
1.416     jms       235: =item tablestart()
                    236: 
                    237: =item tableend()
                    238: 
                    239: =item extractuser()
                    240: 
                    241: =item parse_listdata_key()
                    242: 
                    243: =item listdata()
                    244: 
                    245: =item date_interval_selector()
                    246: 
                    247: =item get_date_interval_from_form()
                    248: 
                    249: =item default_selector()
                    250: 
                    251: =item string_selector()
                    252: 
                    253: =item dateshift()
                    254: 
                    255: =item newoverview()
                    256: 
                    257: =item secgroup_lister()
                    258: 
                    259: =item overview()
                    260: 
                    261: =item clean_parameters()
                    262: 
                    263: =item date_shift_one()
                    264: 
                    265: =item date_shift_two()
                    266: 
                    267: =item parse_key()
                    268: 
                    269: =item header()
                    270: 
                    271: Output html header for page
                    272: 
                    273: =item print_main_menu()
                    274: 
                    275: =item output_row()
                    276: 
                    277: Set portfolio metadata
                    278: 
                    279: =item order_meta_fields()
                    280: 
                    281: =item addmetafield()
                    282: 
                    283: =item setrestrictmeta()
                    284: 
                    285: =item get_added_meta_fieldnames()
                    286: 
                    287: =item get_deleted_meta_fieldnames()
                    288: 
                    289: =item defaultsetter()
                    290: 
                    291: =item components()
                    292: 
                    293: =item load_parameter_names()
                    294: 
                    295: =item parm_change_log()
                    296: 
                    297: =item handler() : 
                    298: 
1.450     raeburn   299: Main handler.  Calls &assessparms subroutine.
1.416     jms       300: 
                    301: =back
                    302: 
1.59      matthew   303: =cut
                    304: 
1.416     jms       305: ###################################################################
                    306: ###################################################################
                    307: 
                    308: package Apache::lonparmset;
                    309: 
                    310: use strict;
                    311: use Apache::lonnet;
                    312: use Apache::Constants qw(:common :http REDIRECT);
                    313: use Apache::lonhtmlcommon();
                    314: use Apache::loncommon;
                    315: use GDBM_File;
                    316: use Apache::lonhomework;
                    317: use Apache::lonxml;
                    318: use Apache::lonlocal;
                    319: use Apache::lonnavmaps;
                    320: use Apache::longroup;
                    321: use Apache::lonrss;
1.506     www       322: use HTML::Entities;
1.416     jms       323: use LONCAPA qw(:DEFAULT :match);
                    324: 
                    325: 
1.2       www       326: sub parmval {
1.275     raeburn   327:     my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
                    328:     return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,
                    329:                                                            $cgroup,$courseopt);
1.201     www       330: }
                    331: 
                    332: sub parmval_by_symb {
1.275     raeburn   333:     my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
1.200     www       334: 
1.352     albertel  335:     my $useropt;
                    336:     if ($uname ne '' && $udom ne '') {
1.473     amueller  337:     $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
1.352     albertel  338:     }
1.200     www       339: 
1.8       www       340:     my $result='';
1.44      albertel  341:     my @outpar=();
1.2       www       342: # ----------------------------------------------------- Cascading lookup scheme
1.446     bisitz    343:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  344:     $map = &Apache::lonnet::deversion($map);
1.10      www       345: 
1.201     www       346:     my $symbparm=$symb.'.'.$what;
                    347:     my $mapparm=$map.'___(all).'.$what;
1.10      www       348: 
1.269     raeburn   349:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$what;
                    350:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
                    351:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    352: 
1.190     albertel  353:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
                    354:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
                    355:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                    356: 
                    357:     my $courselevel=$env{'request.course.id'}.'.'.$what;
                    358:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
                    359:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.2       www       360: 
1.11      www       361: 
1.182     albertel  362: # --------------------------------------------------------- first, check course
1.11      www       363: 
1.200     www       364:     if (defined($$courseopt{$courselevel})) {
1.473     amueller  365:     $outpar[14]=$$courseopt{$courselevel};
                    366:     $result=14;
1.43      albertel  367:     }
1.11      www       368: 
1.200     www       369:     if (defined($$courseopt{$courselevelm})) {
1.473     amueller  370:     $outpar[13]=$$courseopt{$courselevelm};
                    371:     $result=13;
1.43      albertel  372:     }
1.11      www       373: 
1.182     albertel  374: # ------------------------------------------------------- second, check default
                    375: 
1.269     raeburn   376:     if (defined($def)) { $outpar[12]=$def; $result=12; }
1.182     albertel  377: 
                    378: # ------------------------------------------------------ third, check map parms
                    379: 
1.376     albertel  380:     my $thisparm=&parmhash($symbparm);
1.269     raeburn   381:     if (defined($thisparm)) { $outpar[11]=$thisparm; $result=11; }
1.182     albertel  382: 
1.200     www       383:     if (defined($$courseopt{$courselevelr})) {
1.473     amueller  384:     $outpar[10]=$$courseopt{$courselevelr};
                    385:     $result=10;
1.43      albertel  386:     }
1.11      www       387: 
1.182     albertel  388: # ------------------------------------------------------ fourth, back to course
1.352     albertel  389:     if ($csec ne '') {
1.200     www       390:         if (defined($$courseopt{$seclevel})) {
1.473     amueller  391:         $outpar[9]=$$courseopt{$seclevel};
                    392:         $result=9;
                    393:     }
1.200     www       394:         if (defined($$courseopt{$seclevelm})) {
1.473     amueller  395:         $outpar[8]=$$courseopt{$seclevelm};
                    396:         $result=8;
                    397:     }
1.43      albertel  398: 
1.200     www       399:         if (defined($$courseopt{$seclevelr})) {
1.473     amueller  400:         $outpar[7]=$$courseopt{$seclevelr};
                    401:         $result=7;
                    402:     }
1.43      albertel  403:     }
1.275     raeburn   404: # ------------------------------------------------------ fifth, check course group
1.352     albertel  405:     if ($cgroup ne '') {
1.269     raeburn   406:         if (defined($$courseopt{$grplevel})) {
                    407:             $outpar[6]=$$courseopt{$grplevel};
                    408:             $result=6;
                    409:         }
                    410:         if (defined($$courseopt{$grplevelm})) {
                    411:             $outpar[5]=$$courseopt{$grplevelm};
                    412:             $result=5;
                    413:         }
                    414:         if (defined($$courseopt{$grplevelr})) {
                    415:             $outpar[4]=$$courseopt{$grplevelr};
                    416:             $result=4;
                    417:         }
                    418:     }
1.11      www       419: 
1.182     albertel  420: # ---------------------------------------------------------- fifth, check user
1.11      www       421: 
1.352     albertel  422:     if ($uname ne '') {
1.473     amueller  423:     if (defined($$useropt{$courselevel})) {
                    424:         $outpar[3]=$$useropt{$courselevel};
                    425:         $result=3;
                    426:     }
                    427: 
                    428:     if (defined($$useropt{$courselevelm})) {
                    429:         $outpar[2]=$$useropt{$courselevelm};
                    430:         $result=2;
                    431:     }
                    432: 
                    433:     if (defined($$useropt{$courselevelr})) {
                    434:         $outpar[1]=$$useropt{$courselevelr};
                    435:         $result=1;
                    436:     }
1.43      albertel  437:     }
1.44      albertel  438:     return ($result,@outpar);
1.2       www       439: }
                    440: 
1.198     www       441: 
                    442: 
1.376     albertel  443: # --- Caches local to lonparmset
                    444: 
1.446     bisitz    445: 
1.376     albertel  446: sub reset_caches {
                    447:     &resetparmhash();
                    448:     &resetsymbcache();
                    449:     &resetrulescache();
1.203     www       450: }
                    451: 
1.376     albertel  452: {
                    453:     my $parmhashid;
                    454:     my %parmhash;
                    455:     sub resetparmhash {
1.473     amueller  456:     undef($parmhashid);
                    457:     undef(%parmhash);
1.376     albertel  458:     }
1.446     bisitz    459: 
1.376     albertel  460:     sub cacheparmhash {
1.473     amueller  461:     if ($parmhashid eq  $env{'request.course.fn'}) { return; }
                    462:     my %parmhashfile;
                    463:     if (tie(%parmhashfile,'GDBM_File',
                    464:         $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
                    465:         %parmhash=%parmhashfile;
                    466:         untie(%parmhashfile);
                    467:         $parmhashid=$env{'request.course.fn'};
                    468:     }
1.201     www       469:     }
1.446     bisitz    470: 
1.376     albertel  471:     sub parmhash {
1.473     amueller  472:     my ($id) = @_;
                    473:     &cacheparmhash();
                    474:     return $parmhash{$id};
1.376     albertel  475:     }
                    476:  }
                    477: 
1.446     bisitz    478: {
1.376     albertel  479:     my $symbsid;
                    480:     my %symbs;
                    481:     sub resetsymbcache {
1.473     amueller  482:     undef($symbsid);
                    483:     undef(%symbs);
1.376     albertel  484:     }
1.446     bisitz    485: 
1.376     albertel  486:     sub symbcache {
1.473     amueller  487:     my $id=shift;
                    488:     if ($symbsid ne $env{'request.course.id'}) {
                    489:         undef(%symbs);
                    490:     }
                    491:     if (!$symbs{$id}) {
                    492:         my $navmap = Apache::lonnavmaps::navmap->new();
                    493:         if ($id=~/\./) {
                    494:         my $resource=$navmap->getById($id);
                    495:         $symbs{$id}=$resource->symb();
                    496:         } else {
                    497:         my $resource=$navmap->getByMapPc($id);
                    498:         $symbs{$id}=&Apache::lonnet::declutter($resource->src());
                    499:         }
                    500:         $symbsid=$env{'request.course.id'};
                    501:     }
                    502:     return $symbs{$id};
1.201     www       503:     }
1.376     albertel  504:  }
1.201     www       505: 
1.446     bisitz    506: {
1.376     albertel  507:     my $rulesid;
                    508:     my %rules;
                    509:     sub resetrulescache {
1.473     amueller  510:     undef($rulesid);
                    511:     undef(%rules);
1.376     albertel  512:     }
1.446     bisitz    513: 
1.376     albertel  514:     sub rulescache {
1.473     amueller  515:     my $id=shift;
                    516:     if ($rulesid ne $env{'request.course.id'}
                    517:         && !defined($rules{$id})) {
                    518:         my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    519:         my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                    520:         %rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
                    521:         $rulesid=$env{'request.course.id'};
                    522:     }
                    523:     return $rules{$id};
1.221     www       524:     }
                    525: }
                    526: 
1.416     jms       527: 
                    528: 
1.229     www       529: sub preset_defaults {
                    530:     my $type=shift;
                    531:     if (&rulescache($type.'_action') eq 'default') {
                    532: # yes, there is something
1.473     amueller  533:     return (&rulescache($type.'_hours'),
                    534:         &rulescache($type.'_min'),
                    535:         &rulescache($type.'_sec'),
                    536:         &rulescache($type.'_value'));
1.229     www       537:     } else {
                    538: # nothing there or something else
1.473     amueller  539:     return ('','','','','');
1.229     www       540:     }
                    541: }
                    542: 
1.416     jms       543: 
                    544: 
1.277     www       545: 
                    546: sub date_sanity_info {
                    547:    my $checkdate=shift;
                    548:    unless ($checkdate) { return ''; }
                    549:    my $result='';
                    550:    my $crsprefix='course.'.$env{'request.course.id'}.'.';
                    551:    if ($env{$crsprefix.'default_enrollment_end_date'}) {
                    552:       if ($checkdate>$env{$crsprefix.'default_enrollment_end_date'}) {
1.413     bisitz    553:          $result.='<div class="LC_warning">'
                    554:                  .&mt('After course enrollment end!')
                    555:                  .'</div>';
1.277     www       556:       }
                    557:    }
                    558:    if ($env{$crsprefix.'default_enrollment_start_date'}) {
                    559:       if ($checkdate<$env{$crsprefix.'default_enrollment_start_date'}) {
1.413     bisitz    560:          $result.='<div class="LC_warning">'
                    561:                  .&mt('Before course enrollment start!')
                    562:                  .'</div>';
1.277     www       563:       }
                    564:    }
1.413     bisitz    565: # Preparation for additional warnings about dates in the past/future.
                    566: # An improved, more context sensitive version is recommended,
                    567: # e.g. warn for due and answer dates which are defined before the corresponding open date, etc.
                    568: #   if ($checkdate<time) {
                    569: #      $result.='<div class="LC_info">'
                    570: #              .'('.&mt('in the past').')'
                    571: #              .'</div>';
                    572: #      }
                    573: #   if ($checkdate>time) {
                    574: #      $result.='<div class="LC_info">'
                    575: #              .'('.&mt('in the future').')'
                    576: #              .'</div>';
                    577: #      }
1.277     www       578:    return $result;
                    579: }
                    580: ##################################################
1.186     www       581: ##################################################
                    582: #
1.197     www       583: # Store a parameter by ID
1.186     www       584: #
                    585: # Takes
                    586: # - resource id
                    587: # - name of parameter
                    588: # - level
                    589: # - new value
                    590: # - new type
1.187     www       591: # - username
                    592: # - userdomain
                    593: 
1.186     www       594: sub storeparm {
1.269     raeburn   595:     my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.275     raeburn   596:     &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);
1.197     www       597: }
                    598: 
1.226     www       599: my %recstack;
1.197     www       600: sub storeparm_by_symb {
1.275     raeburn   601:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
1.226     www       602:     unless ($recflag) {
                    603: # first time call
1.473     amueller  604:     %recstack=();
                    605:     $recflag=1;
1.226     www       606:     }
                    607: # store parameter
                    608:     &storeparm_by_symb_inner
1.473     amueller  609:     ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
1.266     www       610: # don't do anything if parameter was reset
                    611:     unless ($nval) { return; }
1.226     www       612:     my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/);
                    613: # remember that this was set
                    614:     $recstack{$parm}=1;
                    615: # what does this trigger?
                    616:     foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) {
                    617: # don't backfire
                    618:        unless ((!$triggered) || ($recstack{$triggered})) {
1.473     amueller  619:        my $action=&rulescache($triggered.'_action');
                    620:        my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
1.226     www       621: # set triggered parameter on same level
1.473     amueller  622:        my $newspnam=$prefix.$triggered;
                    623:        my $newvalue='';
                    624:        my $active=1;
                    625:        if ($action=~/^when\_setting/) {
1.228     www       626: # are there restrictions?
1.473     amueller  627:            if (&rulescache($triggered.'_triggervalue')=~/\w/) {
                    628:            $active=0;
                    629:            foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
                    630:                if (lc($possiblevalue) eq lc($nval)) { $active=1; }
                    631:            }
                    632:            }
                    633:            $newvalue=&rulescache($triggered.'_value');
                    634:        } else {
                    635:            my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
                    636:            if ($action=~/^later\_than/) {
                    637:            $newvalue=$nval+$totalsecs;
                    638:            } else {
                    639:            $newvalue=$nval-$totalsecs;
                    640:            }
                    641:        }
                    642:        if ($active) {
                    643:            &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
                    644:                    $uname,$udom,$csec,$recflag,$cgroup);
                    645:        }
1.226     www       646:        }
                    647:     }
                    648:     return '';
                    649: }
                    650: 
1.293     www       651: sub log_parmset {
1.522.2.3  raeburn   652:     return &Apache::lonnet::write_log('course','parameterlog',@_);
1.284     www       653: }
                    654: 
1.226     www       655: sub storeparm_by_symb_inner {
1.197     www       656: # ---------------------------------------------------------- Get symb, map, etc
1.269     raeburn   657:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.197     www       658: # ---------------------------------------------------------- Construct prefixes
1.186     www       659:     $spnam=~s/\_([^\_]+)$/\.$1/;
1.446     bisitz    660:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  661:     $map = &Apache::lonnet::deversion($map);
                    662: 
1.197     www       663:     my $symbparm=$symb.'.'.$spnam;
                    664:     my $mapparm=$map.'___(all).'.$spnam;
                    665: 
1.269     raeburn   666:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$spnam;
                    667:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
                    668:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    669: 
1.190     albertel  670:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
                    671:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
                    672:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
1.446     bisitz    673: 
1.190     albertel  674:     my $courselevel=$env{'request.course.id'}.'.'.$spnam;
                    675:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
                    676:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.446     bisitz    677: 
1.186     www       678:     my $storeunder='';
1.269     raeburn   679:     if (($snum==14) || ($snum==3)) { $storeunder=$courselevel; }
                    680:     if (($snum==13) || ($snum==2)) { $storeunder=$courselevelm; }
                    681:     if (($snum==10) || ($snum==1)) { $storeunder=$courselevelr; }
                    682:     if ($snum==9) { $storeunder=$seclevel; }
                    683:     if ($snum==8) { $storeunder=$seclevelm; }
                    684:     if ($snum==7) { $storeunder=$seclevelr; }
                    685:     if ($snum==6) { $storeunder=$grplevel; }
                    686:     if ($snum==5) { $storeunder=$grplevelm; }
                    687:     if ($snum==4) { $storeunder=$grplevelr; }
                    688: 
1.446     bisitz    689: 
1.186     www       690:     my $delete;
                    691:     if ($nval eq '') { $delete=1;}
                    692:     my %storecontent = ($storeunder         => $nval,
1.473     amueller  693:             $storeunder.'.type' => $ntype);
1.186     www       694:     my $reply='';
                    695:     if ($snum>3) {
                    696: # ---------------------------------------------------------------- Store Course
                    697: #
1.473     amueller  698:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    699:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.186     www       700: # Expire sheets
1.473     amueller  701:     &Apache::lonnet::expirespread('','','studentcalc');
                    702:     if (($snum==10) || ($snum==7) || ($snum==4)) {
                    703:         &Apache::lonnet::expirespread('','','assesscalc',$symb);
                    704:     } elsif (($snum==11) || ($snum==8) || ($snum==5)) {
                    705:         &Apache::lonnet::expirespread('','','assesscalc',$map);
                    706:     } else {
                    707:         &Apache::lonnet::expirespread('','','assesscalc');
                    708:     }
1.186     www       709: # Store parameter
1.473     amueller  710:     if ($delete) {
                    711:         $reply=&Apache::lonnet::del
                    712:         ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
1.290     www       713:             &log_parmset(\%storecontent,1);
1.473     amueller  714:     } else {
                    715:         $reply=&Apache::lonnet::cput
                    716:         ('resourcedata',\%storecontent,$cdom,$cnum);
                    717:         &log_parmset(\%storecontent);
                    718:     }
                    719:     &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
1.186     www       720:     } else {
                    721: # ------------------------------------------------------------------ Store User
                    722: #
                    723: # Expire sheets
1.473     amueller  724:     &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
                    725:     if ($snum==1) {
                    726:         &Apache::lonnet::expirespread
                    727:         ($uname,$udom,'assesscalc',$symb);
                    728:     } elsif ($snum==2) {
                    729:         &Apache::lonnet::expirespread
                    730:         ($uname,$udom,'assesscalc',$map);
                    731:     } else {
                    732:         &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
                    733:     }
1.186     www       734: # Store parameter
1.473     amueller  735:     if ($delete) {
                    736:         $reply=&Apache::lonnet::del
                    737:         ('resourcedata',[keys(%storecontent)],$udom,$uname);
                    738:         &log_parmset(\%storecontent,1,$uname,$udom);
                    739:     } else {
                    740:         $reply=&Apache::lonnet::cput
                    741:         ('resourcedata',\%storecontent,$udom,$uname);
                    742:         &log_parmset(\%storecontent,0,$uname,$udom);
                    743:     }
                    744:     &Apache::lonnet::devalidateuserresdata($uname,$udom);
1.186     www       745:     }
1.446     bisitz    746: 
1.186     www       747:     if ($reply=~/^error\:(.*)/) {
1.473     amueller  748:     return "<span class=\"LC_error\">Write Error: $1</span>";
1.186     www       749:     }
                    750:     return '';
                    751: }
                    752: 
1.9       www       753: 
                    754: sub valout {
1.522.2.23.2.  (raeburn  755:):     my ($value,$type,$name,$editable)=@_;
1.59      matthew   756:     my $result = '';
                    757:     # Values of zero are valid.
                    758:     if (! $value && $value ne '0') {
1.522.2.4  raeburn   759:         if ($editable) {
                    760:             $result =
                    761:                 '<img src="/res/adm/pages/editmap.png"'
                    762:                .' alt="'.&mt('Change').'"'
1.522.2.8  raeburn   763:                .' title="'.&mt('Change').'" style="border:0;" />';
1.522.2.4  raeburn   764:         } else {
                    765:             $result='&nbsp;';
                    766:         }
1.59      matthew   767:     } else {
1.66      www       768:         if ($type eq 'date_interval') {
1.522.2.23.2.  (raeburn  769:):             my ($totalsecs,$donesuffix) = split(/_/,$value,2);
                    770:):             my ($usesdone,$donebuttontext,$proctor,$secretkey);
                    771:):             if ($donesuffix =~ /^done\:([^\:]+)\:(.*)$/) {
                    772:):                 $donebuttontext = $1;
                    773:):                 (undef,$proctor,$secretkey) = split(/_/,$2);
                    774:):                 $usesdone = 'done';
                    775:):             } elsif ($donesuffix =~ /^done(|_.+)$/) {
                    776:):                 $donebuttontext = &mt('Done');
                    777:):                 ($usesdone,$proctor,$secretkey) = split(/_/,$donesuffix);
                    778:):             }
                    779:):             my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($totalsecs);
1.413     bisitz    780:             my @timer;
1.66      www       781:             $year=$year-70;
                    782:             $mday--;
                    783:             if ($year) {
1.413     bisitz    784: #               $result.=&mt('[quant,_1,yr]',$year).' ';
                    785:                 push(@timer,&mt('[quant,_1,yr]',$year));
1.66      www       786:             }
                    787:             if ($mon) {
1.413     bisitz    788: #               $result.=&mt('[quant,_1,mth]',$mon).' ';
                    789:                 push(@timer,&mt('[quant,_1,mth]',$mon));
1.66      www       790:             }
                    791:             if ($mday) {
1.413     bisitz    792: #               $result.=&mt('[quant,_1,day]',$mday).' ';
                    793:                 push(@timer,&mt('[quant,_1,day]',$mday));
1.66      www       794:             }
                    795:             if ($hour) {
1.413     bisitz    796: #               $result.=&mt('[quant,_1,hr]',$hour).' ';
                    797:                 push(@timer,&mt('[quant,_1,hr]',$hour));
1.66      www       798:             }
                    799:             if ($min) {
1.413     bisitz    800: #               $result.=&mt('[quant,_1,min]',$min).' ';
                    801:                 push(@timer,&mt('[quant,_1,min]',$min));
1.66      www       802:             }
                    803:             if ($sec) {
1.413     bisitz    804: #               $result.=&mt('[quant,_1,sec]',$sec).' ';
                    805:                 push(@timer,&mt('[quant,_1,sec]',$sec));
1.66      www       806:             }
1.413     bisitz    807: #           $result=~s/\s+$//;
                    808:             if (!@timer) { # Special case: all entries 0 -> display "0 secs" intead of empty field to keep this field editable
                    809:                 push(@timer,&mt('[quant,_1,sec]',0));
                    810:             }
                    811:             $result.=join(", ",@timer);
1.522.2.23.2.  (raeburn  812:):             if ($usesdone eq 'done') {
                    813:):                 if ($secretkey) {
                    814:):                     $result .= ' '.&mt('+ "[_1]" with proctor key: [_2]',$donebuttontext,$secretkey);
                    815:):                 } else {
                    816:):                     $result .= ' + "'.$donebuttontext.'"';
                    817:):                 }
                    818:):             }
1.213     www       819:         } elsif (&isdateparm($type)) {
1.361     albertel  820:             $result = &Apache::lonlocal::locallocaltime($value).
1.473     amueller  821:         &date_sanity_info($value);
1.59      matthew   822:         } else {
                    823:             $result = $value;
1.517     www       824:             $result=~s/\,/\, /gs;
1.473     amueller  825:         $result = &HTML::Entities::encode($result,'"<>&');
1.59      matthew   826:         }
                    827:     }
                    828:     return $result;
1.9       www       829: }
                    830: 
1.59      matthew   831: 
1.5       www       832: sub plink {
                    833:     my ($type,$dis,$value,$marker,$return,$call)=@_;
1.23      www       834:     my $winvalue=$value;
                    835:     unless ($winvalue) {
1.473     amueller  836:     if (&isdateparm($type)) {
1.190     albertel  837:             $winvalue=$env{'form.recent_'.$type};
1.23      www       838:         } else {
1.190     albertel  839:             $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23      www       840:         }
                    841:     }
1.229     www       842:     my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
                    843:     my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
                    844:     unless (defined($winvalue)) { $winvalue=$val; }
1.522.2.23.2.  (raeburn  845:):     my $valout = &valout($value,$type,$parmname,1);
1.429     raeburn   846:     my $unencmarker = $marker;
1.378     albertel  847:     foreach my $item (\$type, \$dis, \$winvalue, \$marker, \$return, \$call,
1.473     amueller  848:               \$hour, \$min, \$sec) {
                    849:     $$item = &HTML::Entities::encode($$item,'"<>&');
                    850:     $$item =~ s/\'/\\\'/g;
1.378     albertel  851:     }
1.429     raeburn   852:     return '<table width="100%"><tr valign="top" align="right"><td><a name="'.$unencmarker.'" /></td></tr><tr><td align="center">'.
1.473     amueller  853:     '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
                    854:         .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."'".');">'.
                    855:         $valout.'</a></td></tr></table>';
1.5       www       856: }
                    857: 
1.280     albertel  858: sub page_js {
                    859: 
1.81      www       860:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88      matthew   861:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.280     albertel  862: 
                    863:     return(<<ENDJS);
                    864: <script type="text/javascript">
1.454     bisitz    865: // <![CDATA[
1.44      albertel  866: 
1.88      matthew   867:     $pjump_def
1.44      albertel  868: 
                    869:     function psub() {
                    870:         if (document.parmform.pres_marker.value!='') {
                    871:             document.parmform.action+='#'+document.parmform.pres_marker.value;
                    872:             var typedef=new Array();
                    873:             typedef=document.parmform.pres_type.value.split('_');
                    874:            if (document.parmform.pres_type.value!='') {
                    875:             if (typedef[0]=='date') {
                    876:                 eval('document.parmform.recent_'+
                    877:                      document.parmform.pres_type.value+
1.473     amueller  878:              '.value=document.parmform.pres_value.value;');
1.44      albertel  879:             } else {
                    880:                 eval('document.parmform.recent_'+typedef[0]+
1.473     amueller  881:              '.value=document.parmform.pres_value.value;');
1.44      albertel  882:             }
1.473     amueller  883:        }
1.44      albertel  884:             document.parmform.submit();
                    885:         } else {
                    886:             document.parmform.pres_value.value='';
                    887:             document.parmform.pres_marker.value='';
                    888:         }
                    889:     }
                    890: 
1.57      albertel  891:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                    892:         var options = "width=" + w + ",height=" + h + ",";
                    893:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                    894:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                    895:         var newWin = window.open(url, wdwName, options);
                    896:         newWin.focus();
                    897:     }
1.454     bisitz    898: // ]]>
1.44      albertel  899: </script>
1.81      www       900: $selscript
1.280     albertel  901: ENDJS
                    902: 
                    903: }
1.507     www       904: 
1.522.2.2  raeburn   905: sub showhide_js {
                    906:     return <<"COURSECONTENTSCRIPT";
                    907: 
                    908: function showHide_courseContent() {
                    909:     var parmlevValue=document.getElementById("parmlev").value;
                    910:     if (parmlevValue == 'general') {
                    911:         document.getElementById('mapmenu').style.display="none";
                    912:     } else {
                    913:         if ((parmlevValue == "full") || (parmlevValue == "map")) {
                    914:             document.getElementById('mapmenu').style.display ="";
                    915:         } else {
                    916:             document.getElementById('mapmenu').style.display="none";
                    917:         }
                    918:     }
                    919:     return;
                    920: }
                    921: 
                    922: COURSECONTENTSCRIPT
                    923: }
                    924: 
1.522.2.23.2.  (raeburn  925:): sub done_proctor_js {
                    926:):     return <<"END";
                    927:): function toggleSecret(form,radio,key) {
                    928:):     var radios = form[radio+key];
                    929:):     if (radios.length) {
                    930:):         for (var i=0; i<radios.length; i++) {
                    931:):             if (radios[i].checked) {
                    932:):                 if (radios[i].value == '_done_proctor') {
                    933:):                     if (document.getElementById('done_'+key+'_proctorkey')) {
                    934:):                         document.getElementById('done_'+key+'_proctorkey').type='text';
                    935:):                     }
                    936:):                 } else {
                    937:):                     if (document.getElementById('done_'+key+'_proctorkey')) {
                    938:):                         document.getElementById('done_'+key+'_proctorkey').type='hidden';
                    939:):                         document.getElementById('done_'+key+'_proctorkey').value='';
                    940:):                     }
                    941:):                 }
                    942:):             }
                    943:):         }
                    944:):     }
                    945:): }
                    946:): END
                    947:): 
                    948:): }
                    949:): 
1.280     albertel  950: sub startpage {
1.515     raeburn   951:     my ($r,$psymb) = @_;
1.281     albertel  952: 
1.515     raeburn   953:     my %loaditems = (
                    954:                       'onload'   => "group_or_section('cgroup')",
                    955:                     );
                    956:     if (!$psymb) {
1.522.2.2  raeburn   957:         $loaditems{'onload'} = "showHide_courseContent(); group_or_section('cgroup'); resize_scrollbox('mapmenuscroll','1','1');";
1.515     raeburn   958:     }
1.280     albertel  959: 
1.414     droeschl  960:     if ((($env{'form.command'} eq 'set') && ($env{'form.url'})
1.473     amueller  961:          && (!$env{'form.dis'})) || ($env{'form.symb'})) {
                    962:     &Apache::lonhtmlcommon::add_breadcrumb({help=>'Problem_Parameters',
                    963:         text=>"Problem Parameters"});
1.414     droeschl  964:     } else {
1.473     amueller  965:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
                    966:        text=>"Table Mode",
                    967:        help => 'Course_Setting_Parameters'});
1.414     droeschl  968:     }
1.522.2.2  raeburn   969:     my $js = &page_js().'
                    970: <script type="text/javascript">
                    971: // <![CDATA[
                    972: '.
                    973:             &Apache::lonhtmlcommon::resize_scrollbox_js('params').'
                    974: // ]]>
                    975: </script>
                    976: ';
1.446     bisitz    977:     my $start_page =
1.522.2.2  raeburn   978:     &Apache::loncommon::start_page('Set/Modify Course Parameters',$js,
1.473     amueller  979:                        {'add_entries' => \%loaditems,});
1.446     bisitz    980:     my $breadcrumbs =
1.473     amueller  981:     &Apache::lonhtmlcommon::breadcrumbs('Table Mode Parameter Setting','Table_Mode');
1.506     www       982:     my $escfilter=&Apache::lonhtmlcommon::entity_encode($env{'form.filter'});
                    983:     my $escpart=&Apache::lonhtmlcommon::entity_encode($env{'form.part'});
1.507     www       984:     $r->print($start_page.$breadcrumbs);
1.280     albertel  985:     $r->print(<<ENDHEAD);
1.193     albertel  986: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.419     bisitz    987: <input type="hidden" value="" name="pres_value" />
                    988: <input type="hidden" value="" name="pres_type" />
                    989: <input type="hidden" value="" name="pres_marker" />
                    990: <input type="hidden" value="1" name="prevvisit" />
1.506     www       991: <input type="hidden" value="$escfilter" name="filter" />
                    992: <input type="hidden" value="$escpart" name="part" />
1.44      albertel  993: ENDHEAD
                    994: }
                    995: 
1.209     www       996: 
1.44      albertel  997: sub print_row {
1.201     www       998:     my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.522.2.19  raeburn   999:     $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups,$noeditgrp,
                   1000:     $readonly)=@_;
1.275     raeburn  1001:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   1002:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1003:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.66      www      1004: # get the values for the parameter in cascading order
                   1005: # empty levels will remain empty
1.44      albertel 1006:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.473     amueller 1007:       $rid,$$default{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.66      www      1008: # get the type for the parameters
                   1009: # problem: these may not be set for all levels
                   1010:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
1.275     raeburn  1011:                                           $$name{$which}.'.type',$rid,
1.473     amueller 1012:          $$defaulttype{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.66      www      1013: # cascade down manually
1.182     albertel 1014:     my $cascadetype=$$defaulttype{$which};
1.269     raeburn  1015:     for (my $i=14;$i>0;$i--) {
1.473     amueller 1016:      if ($typeoutpar[$i]) {
1.66      www      1017:             $cascadetype=$typeoutpar[$i];
1.473     amueller 1018:     } else {
1.66      www      1019:             $typeoutpar[$i]=$cascadetype;
                   1020:         }
                   1021:     }
1.57      albertel 1022:     my $parm=$$display{$which};
                   1023: 
1.203     www      1024:     if ($parmlev eq 'full') {
1.419     bisitz   1025:         $r->print('<td style="background-color:'.$defbgtwo.';" align="center">'
1.506     www      1026:                   .($$part{$which} eq '0'?'0 ('.&mt('default').')':$$part{$which}).'</td>');
1.433     raeburn  1027:     } else {
1.57      albertel 1028:         $parm=~s|\[.*\]\s||g;
                   1029:     }
1.231     www      1030:     my $automatic=&rulescache(($which=~/\_([^\_]+)$/)[0].'_triggers');
                   1031:     if ($automatic) {
1.473     amueller 1032:     $parm.='<span class="LC_warning"><br />'.&mt('Automatically sets').' '.join(', ',split(/\:/,$automatic)).'</span>';
1.231     www      1033:     }
1.427     bisitz   1034:     $r->print('<td>'.$parm.'</td>');
1.446     bisitz   1035: 
1.44      albertel 1036:     my $thismarker=$which;
                   1037:     $thismarker=~s/^parameter\_//;
                   1038:     my $mprefix=$rid.'&'.$thismarker.'&';
1.522.2.23.2.  (raeburn 1039:):     my $effective_parm = &valout($outpar[$result],$typeoutpar[$result],$thismarker);
1.275     raeburn  1040:     my ($othergrp,$grp_parm,$controlgrp);
1.44      albertel 1041: 
1.57      albertel 1042:     if ($parmlev eq 'general') {
                   1043: 
                   1044:         if ($uname) {
1.522.2.19  raeburn  1045:             &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.269     raeburn  1046:         } elsif ($cgroup) {
1.522.2.19  raeburn  1047:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,$noeditgrp,$readonly);
1.57      albertel 1048:         } elsif ($csec) {
1.522.2.19  raeburn  1049:             &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.57      albertel 1050:         } else {
1.522.2.19  raeburn  1051:             &print_td($r,14,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.57      albertel 1052:         }
                   1053:     } elsif ($parmlev eq 'map') {
                   1054: 
                   1055:         if ($uname) {
1.522.2.19  raeburn  1056:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.269     raeburn  1057:         } elsif ($cgroup) {
1.522.2.19  raeburn  1058:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,$noeditgrp,$readonly);
1.57      albertel 1059:         } elsif ($csec) {
1.522.2.19  raeburn  1060:             &print_td($r,8,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.57      albertel 1061:         } else {
1.522.2.19  raeburn  1062:             &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.57      albertel 1063:         }
                   1064:     } else {
1.275     raeburn  1065:         if ($uname) {
                   1066:             if (@{$usersgroups} > 1) {
                   1067:                 my ($coursereply,$grp_parm,$controlgrp);
                   1068:                 ($coursereply,$othergrp,$grp_parm,$controlgrp) =
                   1069:                     &print_usergroups($r,$$part{$which}.'.'.$$name{$which},
                   1070:                        $rid,$cgroup,$defbgone,$usersgroups,$result,$courseopt);
                   1071:                 if ($coursereply && $result > 3) {
                   1072:                     if (defined($controlgrp)) {
                   1073:                         if ($cgroup ne $controlgrp) {
                   1074:                             $effective_parm = $grp_parm;
                   1075:                             $result = 0;
                   1076:                         }
                   1077:                     }
                   1078:                 }
                   1079:             }
                   1080:         }
1.57      albertel 1081: 
1.522.2.22  raeburn  1082:         &print_td($r,14,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.57      albertel 1083: 
1.522.2.19  raeburn  1084:     &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1085:     &print_td($r,12,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1086:     &print_td($r,11,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1087:     &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.473     amueller 1088: 
                   1089:     if ($csec) {
1.522.2.19  raeburn  1090:         &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1091:         &print_td($r,8,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1092:         &print_td($r,7,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.473     amueller 1093:     }
1.269     raeburn  1094: 
                   1095:         if ($cgroup) {
1.522.2.21  raeburn  1096:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,$noeditgrp,$readonly);
                   1097:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,$noeditgrp,$readonly);
                   1098:             &print_td($r,4,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,$noeditgrp,$readonly);
1.269     raeburn  1099:         }
1.446     bisitz   1100: 
1.473     amueller 1101:     if ($uname) {
1.275     raeburn  1102:             if ($othergrp) {
                   1103:                 $r->print($othergrp);
                   1104:             }
1.522.2.19  raeburn  1105:         &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1106:         &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1107:         &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.473     amueller 1108:     }
1.57      albertel 1109: 
                   1110:     } # end of $parmlev if/else
1.419     bisitz   1111:     $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.'</td>');
1.136     albertel 1112: 
1.203     www      1113:     if ($parmlev eq 'full') {
1.136     albertel 1114:         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201     www      1115:                                         '.'.$$name{$which},$$symbp{$rid});
1.136     albertel 1116:         my $sessionvaltype=$typeoutpar[$result];
                   1117:         if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; }
1.419     bisitz   1118:         $r->print('<td style="background-color:#999999;" align="center"><font color="#FFFFFF">'.
1.522.2.23.2.  (raeburn 1119:):                   &valout($sessionval,$sessionvaltype,$$name{$which}).'&nbsp;'.
1.57      albertel 1120:                   '</font></td>');
1.136     albertel 1121:     }
1.44      albertel 1122:     $r->print('</tr>');
1.57      albertel 1123:     $r->print("\n");
1.44      albertel 1124: }
1.59      matthew  1125: 
1.44      albertel 1126: sub print_td {
1.522.2.19  raeburn  1127:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,$noeditgrp,$readonly)=@_;
1.419     bisitz   1128:     $r->print('<td style="background-color:'.(($result==$which)?'#AAFFAA':$defbg).
                   1129:               ';" align="center">');
1.437     raeburn  1130:     my $nolink = 0;
1.522.2.19  raeburn  1131:     if ($readonly) {
1.437     raeburn  1132:         $nolink = 1;
1.522.2.19  raeburn  1133:     } else {
                   1134:         if ($which == 11 || $which == 12) {
1.522.2.7  raeburn  1135:             $nolink = 1;
1.522.2.19  raeburn  1136:         } elsif ($mprefix =~ /availablestudent\&$/) {
                   1137:             if ($which > 3) {
                   1138:                 $nolink = 1;
                   1139:             }
                   1140:         } elsif ($mprefix =~ /examcode\&$/) {
                   1141:             unless ($which == 2) {
                   1142:                 $nolink = 1;
                   1143:             }
1.522.2.7  raeburn  1144:         }
1.437     raeburn  1145:     }
                   1146:     if ($nolink) {
1.522.2.23.2.  (raeburn 1147:):         $r->print(&valout($$outpar[$which],$$typeoutpar[$which],$mprefix));
1.114     www      1148:     } else {
1.437     raeburn  1149:         $r->print(&plink($$typeoutpar[$which],
                   1150:                          $$display{$value},$$outpar[$which],
                   1151:                          $mprefix."$which",'parmform.pres','psub'));
1.114     www      1152:     }
                   1153:     $r->print('</td>'."\n");
1.57      albertel 1154: }
                   1155: 
1.275     raeburn  1156: sub print_usergroups {
                   1157:     my ($r,$what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
                   1158:     my $courseid = $env{'request.course.id'};
                   1159:     my $output;
                   1160:     my $symb = &symbcache($rid);
                   1161:     my $symbparm=$symb.'.'.$what;
                   1162:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
                   1163:     my $mapparm=$map.'___(all).'.$what;
                   1164:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype) =
                   1165:           &parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,$what,
                   1166:                                                                    $courseopt);
                   1167:     my $bgcolor = $defbg;
                   1168:     my $grp_parm;
1.446     bisitz   1169:     if (($coursereply) && ($cgroup ne $resultgroup)) {
1.275     raeburn  1170:         if ($result > 3) {
1.419     bisitz   1171:             $bgcolor = '#AAFFAA';
1.522.2.23.2.  (raeburn 1172:):             $grp_parm = &valout($coursereply,$resulttype,$what);
1.275     raeburn  1173:         }
1.522.2.23.2.  (raeburn 1174:):         $grp_parm = &valout($coursereply,$resulttype,$what);
1.419     bisitz   1175:         $output = '<td style="background-color:'.$bgcolor.';" align="center">';
1.275     raeburn  1176:         if ($resultgroup && $resultlevel) {
                   1177:             $output .= '<small><b>'.$resultgroup.'</b> ('.$resultlevel.'): </small>'.$grp_parm;
                   1178:         } else {
                   1179:             $output .= '&nbsp;';
                   1180:         }
                   1181:         $output .= '</td>';
                   1182:     } else {
1.419     bisitz   1183:         $output .= '<td style="background-color:'.$bgcolor.';">&nbsp;</td>';
1.275     raeburn  1184:     }
                   1185:     return ($coursereply,$output,$grp_parm,$resultgroup);
                   1186: }
                   1187: 
                   1188: sub parm_control_group {
                   1189:     my ($courseid,$usersgroups,$symbparm,$mapparm,$what,$courseopt) = @_;
                   1190:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1191:     my $grpfound = 0;
                   1192:     my @levels = ($symbparm,$mapparm,$what);
                   1193:     my @levelnames = ('resource','map/folder','general');
                   1194:     foreach my $group (@{$usersgroups}) {
                   1195:         if ($grpfound) { last; }
                   1196:         for (my $i=0; $i<@levels; $i++) {
                   1197:             my $item = $courseid.'.['.$group.'].'.$levels[$i];
                   1198:             if (defined($$courseopt{$item})) {
                   1199:                 $coursereply = $$courseopt{$item};
                   1200:                 $resultitem = $item;
                   1201:                 $resultgroup = $group;
                   1202:                 $resultlevel = $levelnames[$i];
                   1203:                 $resulttype = $$courseopt{$item.'.type'};
                   1204:                 $grpfound = 1;
                   1205:                 last;
                   1206:             }
                   1207:         }
                   1208:     }
                   1209:     return($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1210: }
1.201     www      1211: 
1.63      bowersj2 1212: 
                   1213: 
                   1214: sub extractResourceInformation {
                   1215:     my $ids = shift;
                   1216:     my $typep = shift;
                   1217:     my $keyp = shift;
                   1218:     my $allparms = shift;
                   1219:     my $allparts = shift;
                   1220:     my $allmaps = shift;
                   1221:     my $mapp = shift;
                   1222:     my $symbp = shift;
1.82      www      1223:     my $maptitles=shift;
1.196     www      1224:     my $uris=shift;
1.210     www      1225:     my $keyorder=shift;
1.211     www      1226:     my $defkeytype=shift;
1.196     www      1227: 
1.210     www      1228:     my $keyordercnt=100;
1.63      bowersj2 1229: 
1.196     www      1230:     my $navmap = Apache::lonnavmaps::navmap->new();
                   1231:     my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
                   1232:     foreach my $resource (@allres) {
1.480     amueller 1233:         my $id=$resource->id();
1.196     www      1234:         my ($mapid,$resid)=split(/\./,$id);
1.480     amueller 1235:         if ($mapid eq '0') { next; }
                   1236:         $$ids[$#$ids+1]=$id;
                   1237:         my $srcf=$resource->src();
                   1238:         $srcf=~/\.(\w+)$/;
                   1239:         $$typep{$id}=$1;
                   1240:         $$keyp{$id}='';
1.196     www      1241:         $$uris{$id}=$srcf;
1.512     foxr     1242: 
1.480     amueller 1243:         foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
                   1244:             next if ($key!~/^parameter_/);
1.363     albertel 1245: 
1.209     www      1246: # Hidden parameters
1.480     amueller 1247:             next if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm');
1.209     www      1248: #
                   1249: # allparms is a hash of parameter names
                   1250: #
1.480     amueller 1251:             my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
                   1252:             if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
                   1253:                 my ($display,$parmdis);
                   1254:                 $display = &standard_parameter_names($name);
                   1255:                 if ($display eq '') {
                   1256:                     $display= &Apache::lonnet::metadata($srcf,$key.'.display');
                   1257:                     $parmdis = $display;
                   1258:                     $parmdis =~ s/\s*\[Part.*$//g;
                   1259:                 } else {
                   1260:                     $parmdis = &mt($display);
                   1261:                 }
                   1262:                 $$allparms{$name}=$parmdis;
                   1263:                 if (ref($defkeytype)) {
                   1264:                     $$defkeytype{$name}=
                   1265:                     &Apache::lonnet::metadata($srcf,$key.'.type');
                   1266:                 }
                   1267:             }
1.363     albertel 1268: 
1.209     www      1269: #
                   1270: # allparts is a hash of all parts
                   1271: #
1.480     amueller 1272:             my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
                   1273:             $$allparts{$part} = &mt('Part: [_1]',$part);
1.209     www      1274: #
                   1275: # Remember all keys going with this resource
                   1276: #
1.480     amueller 1277:             if ($$keyp{$id}) {
                   1278:                 $$keyp{$id}.=','.$key;
                   1279:             } else {
                   1280:                 $$keyp{$id}=$key;
                   1281:             }   
1.210     www      1282: #
                   1283: # Put in order
1.446     bisitz   1284: #
1.480     amueller 1285:             unless ($$keyorder{$key}) {
                   1286:                 $$keyorder{$key}=$keyordercnt;
                   1287:                 $keyordercnt++;
                   1288:             }
1.473     amueller 1289:         }
                   1290: 
                   1291: 
1.480     amueller 1292:         if (!exists($$mapp{$mapid})) {
                   1293:             $$mapp{$id}=
                   1294:             &Apache::lonnet::declutter($resource->enclosing_map_src());
                   1295:             $$mapp{$mapid}=$$mapp{$id};
                   1296:             $$allmaps{$mapid}=$$mapp{$id};
                   1297:             if ($mapid eq '1') {
1.522.2.6  raeburn  1298:                 $$maptitles{$mapid}=&mt('Main Content');
1.480     amueller 1299:             } else {
                   1300:                 $$maptitles{$mapid}=&Apache::lonnet::gettitle($$mapp{$id});
                   1301:             }
                   1302:             $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
                   1303:             $$symbp{$mapid}=$$mapp{$id}.'___(all)';
1.473     amueller 1304:         } else {
1.480     amueller 1305:             $$mapp{$id} = $$mapp{$mapid};
1.473     amueller 1306:         }
1.480     amueller 1307:         $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
1.63      bowersj2 1308:     }
                   1309: }
                   1310: 
1.208     www      1311: 
                   1312: 
1.213     www      1313: sub isdateparm {
                   1314:     my $type=shift;
                   1315:     return (($type=~/^date/) && (!($type eq 'date_interval')));
                   1316: }
                   1317: 
1.468     amueller 1318: #
1.501     bisitz   1319: # parmmenu displays a list of the selected parameters.
                   1320: # It also offers a link to show/hide the complete parameter list
                   1321: # from which you can select all desired parameters.
1.468     amueller 1322: #
1.208     www      1323: sub parmmenu {
1.211     www      1324:     my ($r,$allparms,$pscat,$keyorder)=@_;
1.208     www      1325:     my $tempkey;
                   1326:     $r->print(<<ENDSCRIPT);
                   1327: <script type="text/javascript">
1.454     bisitz   1328: // <![CDATA[
1.208     www      1329:     function checkall(value, checkName) {
1.453     schualex 1330: 
                   1331:         var li = "_li";
                   1332:         var displayOverview = "";
                   1333:         
                   1334:         if (value == false) {
                   1335:             displayOverview = "none"
                   1336:         }
                   1337: 
1.473     amueller 1338:     for (i=0; i<document.forms.parmform.elements.length; i++) {
1.208     www      1339:             ele = document.forms.parmform.elements[i];
                   1340:             if (ele.name == checkName) {
                   1341:                 document.forms.parmform.elements[i].checked=value;
                   1342:             }
                   1343:         }
                   1344:     }
1.210     www      1345: 
                   1346:     function checkthis(thisvalue, checkName) {
1.458     schualex 1347: 
                   1348: 
1.473     amueller 1349:     for (i=0; i<document.forms.parmform.elements.length; i++) {
1.210     www      1350:             ele = document.forms.parmform.elements[i];
                   1351:             if (ele.name == checkName) {
1.473     amueller 1352:         if (ele.value == thisvalue) {
                   1353:             document.forms.parmform.elements[i].checked=true;
                   1354:         }
1.210     www      1355:             }
                   1356:         }
                   1357:     }
                   1358: 
                   1359:     function checkdates() {
1.473     amueller 1360:     checkthis('duedate','pscat');
                   1361:      checkthis('opendate','pscat');
                   1362:     checkthis('answerdate','pscat');
1.218     www      1363:     }
                   1364: 
                   1365:     function checkdisset() {
1.521     raeburn  1366:      checkthis('discussend','pscat');
1.473     amueller 1367:      checkthis('discusshide','pscat');
1.521     raeburn  1368:      checkthis('discussvote','pscat');
1.218     www      1369:     }
                   1370: 
                   1371:     function checkcontdates() {
1.473     amueller 1372:     checkthis('contentopen','pscat');
                   1373:      checkthis('contentclose','pscat');
1.218     www      1374:     }
1.446     bisitz   1375: 
1.210     www      1376:     function checkvisi() {
1.473     amueller 1377:     checkthis('hiddenresource','pscat');
                   1378:      checkthis('encrypturl','pscat');
                   1379:     checkthis('problemstatus','pscat');
                   1380:     checkthis('contentopen','pscat');
                   1381:     checkthis('opendate','pscat');
1.210     www      1382:     }
                   1383: 
                   1384:     function checkparts() {
1.473     amueller 1385:     checkthis('hiddenparts','pscat');
                   1386:     checkthis('display','pscat');
                   1387:     checkthis('ordered','pscat');
1.210     www      1388:     }
                   1389: 
                   1390:     function checkstandard() {
                   1391:         checkall(false,'pscat');
1.473     amueller 1392:     checkdates();
                   1393:     checkthis('weight','pscat');
                   1394:     checkthis('maxtries','pscat');
1.501     bisitz   1395:     checkthis('type','pscat');
                   1396:     checkthis('problemstatus','pscat');
1.210     www      1397:     }
                   1398: 
1.454     bisitz   1399: // ]]>
1.208     www      1400: </script>
                   1401: ENDSCRIPT
1.453     schualex 1402: 
1.491     bisitz   1403:     $r->print('<hr />');
1.453     schualex 1404:     &shortCuts($r,$allparms,$pscat,$keyorder);
1.491     bisitz   1405:     $r->print('<hr />');
1.453     schualex 1406: }
1.465     amueller 1407: # return a hash
                   1408: sub categories {
                   1409:     return ('time_settings' => 'Time Settings',
                   1410:     'grading' => 'Grading',
                   1411:     'tries' => 'Tries',
                   1412:     'problem_appearance' => 'Problem Appearance',
                   1413:     'behaviour_of_input_fields' => 'Behaviour of Input Fields',
                   1414:     'hiding' => 'Hiding',
                   1415:     'high_level_randomization' => 'High Level Randomization',
                   1416:     'slots' => 'Slots',
                   1417:     'file_submission' => 'File Submission',
                   1418:     'misc' => 'Miscellaneous' ); 
                   1419: }
                   1420: 
                   1421: # return a hash. Like a look-up table
                   1422: sub lookUpTableParameter {
                   1423:  
                   1424:     return ( 
                   1425:         'opendate' => 'time_settings',
                   1426:         'duedate' => 'time_settings',
                   1427:         'answerdate' => 'time_settings',
                   1428:         'interval' => 'time_settings',
                   1429:         'contentopen' => 'time_settings',
                   1430:         'contentclose' => 'time_settings',
                   1431:         'discussend' => 'time_settings',
1.522.2.15  raeburn  1432: 	'printstartdate' => 'time_settings',
                   1433: 	'printenddate' => 'time_settings',
1.465     amueller 1434:         'weight' => 'grading',
                   1435:         'handgrade' => 'grading',
                   1436:         'maxtries' => 'tries',
                   1437:         'hinttries' => 'tries',
1.503     raeburn  1438:         'randomizeontries' => 'tries',
1.465     amueller 1439:         'type' => 'problem_appearance',
                   1440:         'problemstatus' => 'problem_appearance',
                   1441:         'display' => 'problem_appearance',
                   1442:         'ordered' => 'problem_appearance',
                   1443:         'numbubbles' => 'problem_appearance',
                   1444:         'tol' => 'behaviour_of_input_fields',
                   1445:         'sig' => 'behaviour_of_input_fields',
                   1446:         'turnoffunit' => 'behaviour_of_input_fields',
                   1447:         'hiddenresource' => 'hiding',
                   1448:         'hiddenparts' => 'hiding',
                   1449:         'discusshide' => 'hiding',
                   1450:         'buttonshide' => 'hiding',
                   1451:         'turnoffeditor' => 'hiding',
                   1452:         'encrypturl' => 'hiding',
                   1453:         'randomorder' => 'high_level_randomization',
                   1454:         'randompick' => 'high_level_randomization',
                   1455:         'available' => 'slots',
                   1456:         'useslots' => 'slots',
                   1457:         'availablestudent' => 'slots',
                   1458:         'uploadedfiletypes' => 'file_submission',
                   1459:         'maxfilesize' => 'file_submission',
                   1460:         'cssfile' => 'misc',
                   1461:         'mapalias' => 'misc',
                   1462:         'acc' => 'misc',
                   1463:         'maxcollaborators' => 'misc',
                   1464:         'scoreformat' => 'misc',
1.514     raeburn  1465:         'lenient' => 'grading',
1.519     raeburn  1466:         'retrypartial' => 'tries',
1.521     raeburn  1467:         'discussvote'  => 'misc',
1.522.2.7  raeburn  1468:         'examcode' => 'high_level_randomization',
1.465     amueller 1469:     );    
                   1470: }
                   1471: 
                   1472: sub whatIsMyCategory {
                   1473:     my $name = shift;
                   1474:     my $catList = shift;
                   1475:     my @list;
                   1476:     my %lookUpList = &lookUpTableParameter; #Initilize the lookupList
                   1477:     my $cat = $lookUpList{$name};
                   1478:     if (defined($cat)) {
                   1479:         if (!defined($$catList{$cat})){
                   1480:             push @list, ($name);
                   1481:             $$catList{$cat} = \@list;
                   1482:         } else {
                   1483:             push @{${$catList}{$cat}}, ($name);     
                   1484:         }
                   1485:     } else {
                   1486:         if (!defined($$catList{'misc'})){
                   1487:             push @list, ($name);
                   1488:             $$catList{'misc'} = \@list;
                   1489:         } else {
                   1490:             push @{${$catList}{'misc'}}, ($name);     
                   1491:         }
                   1492:     }        
                   1493: }
                   1494: 
                   1495: sub keysindisplayorderCategory {
                   1496:     my ($name,$keyorder)=@_;
                   1497:     return sort {
1.473     amueller 1498:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b}; 
1.465     amueller 1499:     } ( @{$name});
                   1500: }
                   1501: 
1.467     amueller 1502: sub category_order {
                   1503:     return (
                   1504:         'time_settings' => 1,
                   1505:         'grading' => 2,
                   1506:         'tries' => 3,
                   1507:         'problem_appearance' => 4,
                   1508:         'hiding' => 5,
                   1509:         'behaviour_of_input_fields' => 6,
                   1510:         'high_level_randomization'  => 7,
                   1511:         'slots' => 8,
                   1512:         'file_submission' => 9,
                   1513:         'misc' => 10
                   1514:     );
                   1515: 
                   1516: }
1.453     schualex 1517: 
                   1518: sub parmboxes {
                   1519:     my ($r,$allparms,$pscat,$keyorder)=@_;
                   1520:     my $tempkey;
1.465     amueller 1521:     my $tempparameter;
                   1522:     my %categories = &categories;
1.467     amueller 1523:     my %category_order = &category_order();
1.465     amueller 1524:     my %categoryList = (
                   1525:         'time_settings' => [],
                   1526:         'grading' => [],
                   1527:         'tries' => [],
                   1528:         'problem_appearance' => [],
                   1529:         'behaviour_of_input_fields' => [],
                   1530:         'hiding' => [],
                   1531:         'high_level_randomization' => [],
                   1532:         'slots' => [],
                   1533:         'file_submission' => [],
                   1534:         'misc' => [],
1.489     bisitz   1535:     );
1.510     www      1536: 
1.465     amueller 1537:     foreach $tempparameter (keys %$allparms) {
                   1538:         &whatIsMyCategory($tempparameter, \%categoryList);
                   1539:     }
1.453     schualex 1540:     #part to print the parm-list
1.510     www      1541:     $r->print('<div class="LC_columnSection">'."\n");
1.453     schualex 1542: 
1.465     amueller 1543:     #Print parameters
1.467     amueller 1544:     for my $key (sort { $category_order{$a} <=> $category_order{$b} } keys %categoryList) {
1.522.2.8  raeburn  1545:         next if(@{$categoryList{$key}} == 0);
                   1546:         $r->print('<div class="LC_Box LC_400Box">'
                   1547:                   .'<h4 class="LC_hcell">'
                   1548:                   .&mt($categories{$key})
                   1549:                   .'</h4>'."\n");
                   1550:         foreach $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {
                   1551:             $r->print('<span class="LC_nobreak">'
                   1552:                      .'<label><input type="checkbox" name="pscat" '
                   1553:                      .'value="'.$tempkey.'" ');
                   1554:             if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
                   1555:                 $r->print(' checked="checked"');
                   1556:             }
                   1557:             $r->print(' />'.($$allparms{$tempkey}=~/\S/ ? $$allparms{$tempkey}
1.465     amueller 1558:                                                       : $tempkey)
1.522.2.8  raeburn  1559:                      .'</label></span><br />'."\n");
1.465     amueller 1560:         }
1.522.2.9  raeburn  1561:         $r->print("</div>\n");
1.465     amueller 1562:     }
1.453     schualex 1563: 
1.510     www      1564:     $r->print("</div>\n");
1.453     schualex 1565: }
1.468     amueller 1566: #
                   1567: # This function offers some links on the parameter section to get with one click a group a parameters
                   1568: #
1.453     schualex 1569: sub shortCuts {
                   1570:     my ($r,$allparms,$pscat,$keyorder)=@_;
                   1571: 
1.491     bisitz   1572:     # Parameter Selection
                   1573:     $r->print(
                   1574:         &Apache::lonhtmlcommon::start_funclist(&mt('Parameter Selection'))
                   1575:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1576:             '<a href="javascript:checkall(true, \'pscat\')">'.&mt('Select All').'</a>')
                   1577:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1578:             '<a href="javascript:checkstandard()">'.&mt('Select Common Only').'</a>')
                   1579:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1580:             '<a href="javascript:checkall(false, \'pscat\')">'.&mt('Unselect All').'</a>')
                   1581:        .&Apache::lonhtmlcommon::end_funclist()
                   1582:     );
                   1583: 
                   1584:     # Add Selection for...
                   1585:     $r->print(
                   1586:         &Apache::lonhtmlcommon::start_funclist(&mt('Add Selection for...'))
                   1587:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1588:             '<a href="javascript:checkdates()">'.&mt('Problem Dates').'</a>')
                   1589:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1590:             '<a href="javascript:checkcontdates()">'.&mt('Content Dates').'</a>')
                   1591:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1592:             '<a href="javascript:checkdisset()">'.&mt('Discussion Settings').'</a>')
                   1593:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1594:             '<a href="javascript:checkvisi()">'.&mt('Visibilities').'</a>')
                   1595:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1596:             '<a href="javascript:checkparts()">'.&mt('Part Parameters').'</a>')
                   1597:        .&Apache::lonhtmlcommon::end_funclist()
                   1598:     );
1.208     www      1599: }
                   1600: 
1.209     www      1601: sub partmenu {
1.446     bisitz   1602:     my ($r,$allparts,$psprt)=@_;
1.522.2.2  raeburn  1603:     my $selsize = 1+scalar(keys(%{$allparts}));
                   1604:     if ($selsize > 8) {
                   1605:         $selsize = 8;
                   1606:     }
1.446     bisitz   1607: 
1.522.2.2  raeburn  1608:     $r->print('<select multiple="multiple" name="psprt" size="'.$selsize.'">');
1.208     www      1609:     $r->print('<option value="all"');
1.401     bisitz   1610:     $r->print(' selected="selected"') unless (@{$psprt});
1.208     www      1611:     $r->print('>'.&mt('All Parts').'</option>');
                   1612:     my %temphash=();
                   1613:     foreach (@{$psprt}) { $temphash{$_}=1; }
1.234     albertel 1614:     foreach my $tempkey (sort {
1.473     amueller 1615:     if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); }
1.234     albertel 1616:     } keys(%{$allparts})) {
1.473     amueller 1617:     unless ($tempkey =~ /\./) {
                   1618:         $r->print('<option value="'.$tempkey.'"');
                   1619:         if ($$psprt[0] eq "all" ||  $temphash{$tempkey}) {
                   1620:         $r->print(' selected="selected"');
                   1621:         }
                   1622:         $r->print('>'.$$allparts{$tempkey}.'</option>');
                   1623:     }
1.208     www      1624:     }
1.446     bisitz   1625:     $r->print('</select>');
1.209     www      1626: }
                   1627: 
                   1628: sub usermenu {
1.275     raeburn  1629:     my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups)=@_;
1.209     www      1630:     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                   1631:         &Apache::loncommon::selectstudent_link('parmform','uname','udom');
                   1632:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.412     bisitz   1633: 
1.209     www      1634:     my $sections='';
1.300     albertel 1635:     my %sectionhash = &Apache::loncommon::get_sections();
                   1636: 
1.269     raeburn  1637:     my $groups;
1.307     raeburn  1638:     my %grouphash = &Apache::longroup::coursegroups();
1.299     albertel 1639: 
1.412     bisitz   1640:     my $g_s_header='';
                   1641:     my $g_s_footer='';
1.446     bisitz   1642: 
1.300     albertel 1643:     if (%sectionhash) {
1.412     bisitz   1644:         $sections=&mt('Section:').' <select name="csec"';
1.299     albertel 1645:         if (%grouphash && $parmlev ne 'full') {
1.269     raeburn  1646:             $sections .= qq| onchange="group_or_section('csec')" |;
                   1647:         }
                   1648:         $sections .= '>';
1.473     amueller 1649:     foreach my $section ('',sort keys %sectionhash) {
                   1650:         $sections.='<option value="'.$section.'" '.
                   1651:         ($section eq $csec?'selected="selected"':'').'>'.$section.
1.275     raeburn  1652:                                                               '</option>';
1.209     www      1653:         }
                   1654:         $sections.='</select>';
1.269     raeburn  1655:     }
1.412     bisitz   1656: 
1.300     albertel 1657:     if (%sectionhash && %grouphash && $parmlev ne 'full') {
1.412     bisitz   1658:         $sections .= '&nbsp;'.&mt('or').'&nbsp;';
1.269     raeburn  1659:         $sections .= qq|
                   1660: <script type="text/javascript">
1.454     bisitz   1661: // <![CDATA[
1.269     raeburn  1662: function group_or_section(caller) {
                   1663:    if (caller == "cgroup") {
                   1664:        if (document.parmform.cgroup.selectedIndex != 0) {
                   1665:            document.parmform.csec.selectedIndex = 0;
                   1666:        }
                   1667:    } else {
                   1668:        if (document.parmform.csec.selectedIndex != 0) {
                   1669:            document.parmform.cgroup.selectedIndex = 0;
                   1670:        }
                   1671:    }
                   1672: }
1.454     bisitz   1673: // ]]>
1.269     raeburn  1674: </script>
                   1675: |;
                   1676:     } else {
                   1677:         $sections .= qq|
                   1678: <script type="text/javascript">
1.454     bisitz   1679: // <![CDATA[
1.269     raeburn  1680: function group_or_section(caller) {
                   1681:     return;
                   1682: }
1.454     bisitz   1683: // ]]>
1.269     raeburn  1684: </script>
                   1685: |;
1.446     bisitz   1686:     }
1.299     albertel 1687: 
                   1688:     if (%grouphash) {
1.412     bisitz   1689:         $groups=&mt('Group:').' <select name="cgroup"';
1.300     albertel 1690:         if (%sectionhash && $env{'form.action'} eq 'settable') {
1.269     raeburn  1691:             $groups .= qq| onchange="group_or_section('cgroup')" |;
                   1692:         }
                   1693:         $groups .= '>';
1.275     raeburn  1694:         foreach my $grp ('',sort keys %grouphash) {
                   1695:             $groups.='<option value="'.$grp.'" ';
                   1696:             if ($grp eq $cgroup) {
                   1697:                 unless ((defined($uname)) && ($grp eq '')) {
                   1698:                     $groups .=  'selected="selected" ';
                   1699:                 }
                   1700:             } elsif (!defined($cgroup)) {
                   1701:                 if (@{$usersgroups} == 1) {
                   1702:                     if ($grp eq $$usersgroups[0]) {
                   1703:                         $groups .=  'selected="selected" ';
                   1704:                     }
                   1705:                 }
                   1706:             }
                   1707:             $groups .= '>'.$grp.'</option>';
1.269     raeburn  1708:         }
                   1709:         $groups.='</select>';
                   1710:     }
1.412     bisitz   1711: 
1.445     neumanie 1712:     if (%sectionhash || %grouphash) {
1.446     bisitz   1713:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Group/Section')));
                   1714:         $r->print($sections.$groups);
1.448     bisitz   1715:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.445     neumanie 1716:     }
1.446     bisitz   1717: 
                   1718:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('User')));
1.443     neumanie 1719:     $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
1.412     bisitz   1720:                  ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
                   1721:                  ,'<input type="text" value="'.$id.'" size="12" name="id" /> '
1.446     bisitz   1722:                  ,$chooseopt));
1.209     www      1723: }
                   1724: 
1.468     amueller 1725: #
                   1726: # This function shows on table Mode the available Parameters for the selected Resources
                   1727: #
1.209     www      1728: sub displaymenu {
1.522.2.8  raeburn  1729:     my ($r,$allparms,$pscat,$psprt,$keyorder,$divid)=@_;
1.510     www      1730: 
1.445     neumanie 1731:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.510     www      1732:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameters to View')));
                   1733: 
1.448     bisitz   1734:     &parmmenu($r,$allparms,$pscat,$keyorder);
1.522.2.8  raeburn  1735:     $r->print(&Apache::loncommon::start_scrollbox('480px','440px','200px',$divid));
1.510     www      1736:     &parmboxes($r,$allparms,$pscat,$keyorder);
                   1737:     $r->print(&Apache::loncommon::end_scrollbox());
                   1738: 
                   1739:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.453     schualex 1740:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.510     www      1741:  
1.209     www      1742: }
                   1743: 
1.445     neumanie 1744: sub mapmenu {
1.499     raeburn  1745:     my ($r,$allmaps,$pschp,$maptitles,$symbp)=@_;
1.468     amueller 1746:     my %allmaps_inverted = reverse %$allmaps;
1.461     neumanie 1747:     my $navmap = Apache::lonnavmaps::navmap->new();
                   1748:     my $tree=[];
                   1749:     my $treeinfo={};
                   1750:     if (defined($navmap)) {
1.499     raeburn  1751:         my $it=$navmap->getIterator(undef,undef,undef,1,1,undef);
1.461     neumanie 1752:         my $curRes;
                   1753:         my $depth = 0;
1.468     amueller 1754:         my %parent = ();
                   1755:         my $startcount = 5;
                   1756:         my $lastcontainer = $startcount;
                   1757: # preparing what is to show ...
1.461     neumanie 1758:         while ($curRes = $it->next()) {
                   1759:             if ($curRes == $it->BEGIN_MAP()) {
                   1760:                 $depth++;
1.468     amueller 1761:                 $parent{$depth}= $lastcontainer;
1.461     neumanie 1762:             }
                   1763:             if ($curRes == $it->END_MAP()) {
                   1764:                 $depth--;
1.468     amueller 1765:                 $lastcontainer = $parent{$depth};
1.461     neumanie 1766:             }
                   1767:             if (ref($curRes)) {
1.468     amueller 1768:                 my $symb = $curRes->symb();
                   1769:                 my $ressymb = $symb;
1.461     neumanie 1770:                 if (($curRes->is_sequence()) || ($curRes->is_page())) {
                   1771:                     my $type = 'sequence';
                   1772:                     if ($curRes->is_page()) {
                   1773:                         $type = 'page';
                   1774:                     }
                   1775:                     my $id= $curRes->id();
1.468     amueller 1776:                     my $srcf = $curRes->src();
                   1777:                     my $resource_name = &Apache::lonnet::gettitle($srcf);
                   1778:                     if(!exists($treeinfo->{$id})) {
                   1779:                         push(@$tree,$id);
1.473     amueller 1780:                         my $enclosing_map_folder = &Apache::lonnet::declutter($curRes->enclosing_map_src());        
1.468     amueller 1781:                         $treeinfo->{$id} = {
1.461     neumanie 1782:                                     depth => $depth,
                   1783:                                     type  => $type,
1.468     amueller 1784:                                     name  => $resource_name,
                   1785:                                     enclosing_map_folder => $enclosing_map_folder,
1.461     neumanie 1786:                                     };
1.462     neumanie 1787:                     }
1.461     neumanie 1788:                 }
                   1789:             }
                   1790:         }
1.462     neumanie 1791:     }
1.473     amueller 1792: # Show it ...    
1.484     amueller 1793:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Enclosing Map or Folder'),'','',' id="mapmenu"'));
1.461     neumanie 1794:     if ((ref($tree) eq 'ARRAY') && (ref($treeinfo) eq 'HASH')) {
                   1795:         my $icon = '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.497     bisitz   1796:         my $whitespace =
                   1797:             '<img src="'
                   1798:            .&Apache::loncommon::lonhttpdurl('/adm/lonIcons/whitespace_21.gif')
                   1799:            .'" alt="" />';
                   1800: 
1.498     bisitz   1801:         # Info about selectable folders/maps
                   1802:         $r->print(
                   1803:             '<div class="LC_info">'
1.508     www      1804:            .&mt('You can only select maps and folders which have modifiable settings.')
                   1805:            .' '.&Apache::loncommon::help_open_topic('Parameter_Set_Folder') 
1.498     bisitz   1806:            .'</div>'
                   1807:         );
                   1808: 
1.522.2.8  raeburn  1809:         $r->print(&Apache::loncommon::start_scrollbox('700px','680px','400px','mapmenuscroll'));
1.522.2.2  raeburn  1810:         $r->print(&Apache::loncommon::start_data_table(undef,'mapmenuinner'));
1.497     bisitz   1811: 
1.498     bisitz   1812:         # Display row: "All Maps or Folders"
                   1813:         $r->print(
1.522.2.2  raeburn  1814:             &Apache::loncommon::start_data_table_row(undef,'picklevel')
1.498     bisitz   1815:            .'<td>'
                   1816:            .'<label>'
                   1817:            .'<input type="radio" name="pschp"'
1.497     bisitz   1818:         );
                   1819:         $r->print(' checked="checked"') if ($pschp eq 'all' || !$pschp);
1.498     bisitz   1820:         $r->print(
                   1821:             ' value="all" />&nbsp;'.$icon.'&nbsp;'
                   1822:            .&mt('All Maps or Folders')
                   1823:            .'</label>'
                   1824:            .'<hr /></td>'
                   1825:            .&Apache::loncommon::end_data_table_row()
1.463     bisitz   1826:         );
1.497     bisitz   1827: 
1.522.2.6  raeburn  1828:         # Display row: "Main Content"
1.468     amueller 1829:         if (exists($$allmaps{1})) {
1.498     bisitz   1830:             $r->print(
                   1831:                 &Apache::loncommon::start_data_table_row()
                   1832:                .'<td>'
                   1833:                .'<label>'
                   1834:                .'<input type="radio" name="pschp" value="1"'
1.468     amueller 1835:             );
1.497     bisitz   1836:             $r->print(' checked="checked"') if ($pschp eq '1');
1.498     bisitz   1837:             $r->print(
                   1838:                 '/>&nbsp;'.$icon.'&nbsp;'
                   1839:                .$$maptitles{1}
                   1840:                .($$allmaps{1} !~/^uploaded/?' ['.$$allmaps{1}.']':'')
                   1841:                .'</label>'
                   1842:                .'</td>'
                   1843:                .&Apache::loncommon::end_data_table_row()
1.468     amueller 1844:             );
                   1845:         }
1.497     bisitz   1846: 
                   1847:         # Display rows for all course maps and folders
1.468     amueller 1848:         foreach my $id (@{$tree}) {
                   1849:             my ($mapid,$resid)=split(/\./,$id);
1.464     bisitz   1850:             # Indentation
1.468     amueller 1851:             my $depth = $treeinfo->{$id}->{'depth'};
1.464     bisitz   1852:             my $indent;
                   1853:             for (my $i = 0; $i < $depth; $i++) {
                   1854:                 $indent.= $whitespace;
                   1855:             }
1.461     neumanie 1856:             $icon =  '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.468     amueller 1857:             if ($treeinfo->{$id}->{'type'} eq 'page') {
1.461     neumanie 1858:                 $icon = '<img src="/adm/lonIcons/navmap.page.open.gif" alt="" />';
                   1859:             }
1.468     amueller 1860:             my $symb_name = $$symbp{$id};
                   1861:             my ($front, $tail) = split (/___${resid}___/, $symb_name);
                   1862:             $symb_name = $tail;
1.498     bisitz   1863:             $r->print(
                   1864:                 &Apache::loncommon::start_data_table_row()
                   1865:                .'<td>'
                   1866:                .'<label>'
1.463     bisitz   1867:             );
1.498     bisitz   1868:             # Only offer radio button for folders/maps which can be parameterized
                   1869:             if ($allmaps_inverted{$symb_name}) {
                   1870:                 $r->print(
                   1871:                     '<input type ="radio" name="pschp"'
                   1872:                    .' value="'.$allmaps_inverted{$symb_name}.'"'
                   1873:                 );
                   1874:                 $r->print(' checked="checked"') if ($allmaps_inverted{$symb_name} eq $pschp);
                   1875:                 $r->print('/>');
                   1876:             } else {
                   1877:                 $r->print($whitespace);
1.461     neumanie 1878:             }
1.498     bisitz   1879:             $r->print(
                   1880:                 $indent.$icon.'&nbsp;'
                   1881:                .$treeinfo->{$id}->{name}
                   1882:                .($$allmaps{$mapid}!~/^uploaded/?' ['.$$allmaps{$mapid}.']':'')
                   1883:                .'</label>'
                   1884:                .'</td>'
                   1885:                .&Apache::loncommon::end_data_table_row()
1.463     bisitz   1886:             );
1.461     neumanie 1887:         }
1.497     bisitz   1888: 
1.522.2.2  raeburn  1889:         $r->print(&Apache::loncommon::end_data_table().
                   1890:                   '<br style="line-height:2px;" />'.
                   1891:                   &Apache::loncommon::end_scrollbox());
1.209     www      1892:     }
                   1893: }
                   1894: 
1.482     amueller 1895: # Build up the select Box to choose if your parameter specification should work for the resource, map/folder or the course level
                   1896: # The value of default selection in the select box is set by the value that is given by the argument in $parmlev.
1.209     www      1897: sub levelmenu {
1.446     bisitz   1898:     my ($r,$alllevs,$parmlev)=@_;
                   1899: 
1.445     neumanie 1900:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameter Level').&Apache::loncommon::help_open_topic('Course_Parameter_Levels')));
1.474     amueller 1901:     $r->print('<select id="parmlev" name="parmlev" onchange="showHide_courseContent()">');
1.209     www      1902:     foreach (reverse sort keys %{$alllevs}) {
1.473     amueller 1903:     $r->print('<option value="'.$$alllevs{$_}.'"');
                   1904:     if ($parmlev eq $$alllevs{$_}) {
                   1905:         $r->print(' selected="selected"');
                   1906:     }
                   1907:     $r->print('>'.&mt($_).'</option>');
1.208     www      1908:     }
1.446     bisitz   1909:     $r->print("</select>");
1.208     www      1910: }
                   1911: 
1.211     www      1912: 
                   1913: sub sectionmenu {
                   1914:     my ($r,$selectedsections)=@_;
1.300     albertel 1915:     my %sectionhash = &Apache::loncommon::get_sections();
                   1916:     return if (!%sectionhash);
                   1917: 
1.421     bisitz   1918:     $r->print('<select name="Section" multiple="multiple" size="8">');
1.300     albertel 1919:     foreach my $s ('all',sort keys %sectionhash) {
1.473     amueller 1920:     $r->print('    <option value="'.$s.'"');
                   1921:     foreach (@{$selectedsections}) {
                   1922:         if ($s eq $_) {
                   1923:         $r->print(' selected="selected"');
                   1924:         last;
                   1925:         }
                   1926:     }
                   1927:     $r->print('>'.$s."</option>\n");
1.300     albertel 1928:     }
                   1929:     $r->print("</select>\n");
1.269     raeburn  1930: }
                   1931: 
                   1932: sub groupmenu {
                   1933:     my ($r,$selectedgroups)=@_;
1.307     raeburn  1934:     my %grouphash = &Apache::longroup::coursegroups();
1.299     albertel 1935:     return if (!%grouphash);
                   1936: 
1.421     bisitz   1937:     $r->print('<select name="Group" multiple="multiple" size="8">');
1.299     albertel 1938:     foreach my $group (sort(keys(%grouphash))) {
1.473     amueller 1939:     $r->print('    <option value="'.$group.'"');
                   1940:     foreach (@{$selectedgroups}) {
                   1941:         if ($group eq $_) {
                   1942:         $r->print(' selected="selected"');
                   1943:         last;
                   1944:         }
                   1945:     }
                   1946:     $r->print('>'.$group."</option>\n");
1.211     www      1947:     }
1.299     albertel 1948:     $r->print("</select>\n");
1.211     www      1949: }
                   1950: 
1.269     raeburn  1951: 
1.210     www      1952: sub keysplit {
                   1953:     my $keyp=shift;
                   1954:     return (split(/\,/,$keyp));
                   1955: }
                   1956: 
                   1957: sub keysinorder {
                   1958:     my ($name,$keyorder)=@_;
                   1959:     return sort {
1.473     amueller 1960:     $$keyorder{$a} <=> $$keyorder{$b};
1.210     www      1961:     } (keys %{$name});
                   1962: }
                   1963: 
1.236     albertel 1964: sub keysinorder_bytype {
                   1965:     my ($name,$keyorder)=@_;
                   1966:     return sort {
1.473     amueller 1967:     my $ta=(split('_',$a))[-1];
                   1968:     my $tb=(split('_',$b))[-1];
                   1969:     if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
                   1970:         return ($a cmp $b);
                   1971:     }
                   1972:     $$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
1.236     albertel 1973:     } (keys %{$name});
                   1974: }
                   1975: 
1.211     www      1976: sub keysindisplayorder {
                   1977:     my ($name,$keyorder)=@_;
                   1978:     return sort {
1.473     amueller 1979:     $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
1.211     www      1980:     } (keys %{$name});
                   1981: }
                   1982: 
1.214     www      1983: sub sortmenu {
                   1984:     my ($r,$sortorder)=@_;
1.236     albertel 1985:     $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214     www      1986:     if ($sortorder eq 'realmstudent') {
1.422     bisitz   1987:        $r->print(' checked="checked"');
1.214     www      1988:     }
                   1989:     $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236     albertel 1990:     $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214     www      1991:     if ($sortorder eq 'studentrealm') {
1.422     bisitz   1992:        $r->print(' checked="checked"');
1.214     www      1993:     }
1.236     albertel 1994:     $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
1.473     amueller 1995:           '</label>');
1.214     www      1996: }
                   1997: 
1.211     www      1998: sub standardkeyorder {
                   1999:     return ('parameter_0_opendate' => 1,
1.473     amueller 2000:         'parameter_0_duedate' => 2,
                   2001:         'parameter_0_answerdate' => 3,
                   2002:         'parameter_0_interval' => 4,
                   2003:         'parameter_0_weight' => 5,
                   2004:         'parameter_0_maxtries' => 6,
                   2005:         'parameter_0_hinttries' => 7,
                   2006:         'parameter_0_contentopen' => 8,
                   2007:         'parameter_0_contentclose' => 9,
                   2008:         'parameter_0_type' => 10,
                   2009:         'parameter_0_problemstatus' => 11,
                   2010:         'parameter_0_hiddenresource' => 12,
                   2011:         'parameter_0_hiddenparts' => 13,
                   2012:         'parameter_0_display' => 14,
                   2013:         'parameter_0_ordered' => 15,
                   2014:         'parameter_0_tol' => 16,
                   2015:         'parameter_0_sig' => 17,
                   2016:         'parameter_0_turnoffunit' => 18,
1.521     raeburn  2017:         'parameter_0_discussend' => 19,
                   2018:         'parameter_0_discusshide' => 20,
                   2019:         'parameter_0_discussvote' => 21,
1.522.2.15  raeburn  2020: 	'parameter_0_printstartdate'  =>  22,
                   2021: 	'parameter_0_printenddate' =>  23);
1.211     www      2022: }
                   2023: 
1.59      matthew  2024: 
1.30      www      2025: sub assessparms {
1.1       www      2026: 
1.522.2.19  raeburn  2027:     my ($r,$parm_permission) = @_;
1.512     foxr     2028: 
                   2029: 
                   2030: # -------------------------------------------------------- Variable declaration
1.201     www      2031:     my @ids=();
                   2032:     my %symbp=();
                   2033:     my %mapp=();
                   2034:     my %typep=();
                   2035:     my %keyp=();
                   2036:     my %uris=();
                   2037:     my %maptitles=();
1.129     www      2038:     my %allmaps=();
                   2039:     my %alllevs=();
1.57      albertel 2040: 
1.187     www      2041:     my $uname;
                   2042:     my $udom;
                   2043:     my $uhome;
                   2044:     my $csec;
1.269     raeburn  2045:     my $cgroup;
1.275     raeburn  2046:     my @usersgroups = ();
1.446     bisitz   2047: 
1.190     albertel 2048:     my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187     www      2049: 
1.57      albertel 2050:     $alllevs{'Resource Level'}='full';
1.215     www      2051:     $alllevs{'Map/Folder Level'}='map';
1.57      albertel 2052:     $alllevs{'Course Level'}='general';
                   2053: 
                   2054:     my %allparms;
                   2055:     my %allparts;
1.512     foxr     2056: # ------------------------------------------------------------------------------
                   2057: 
1.210     www      2058: #
                   2059: # Order in which these parameters will be displayed
                   2060: #
1.211     www      2061:     my %keyorder=&standardkeyorder();
                   2062: 
1.512     foxr     2063: #    @ids=();
                   2064: #    %symbp=();       # These seem defined above already.
                   2065: #    %typep=();
1.43      albertel 2066: 
                   2067:     my $message='';
                   2068: 
1.190     albertel 2069:     $csec=$env{'form.csec'};
1.269     raeburn  2070:     $cgroup=$env{'form.cgroup'};
1.522.2.20  raeburn  2071:     my $noeditgrp;
                   2072:     if ($cgroup ne '') {
                   2073:         unless (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2074:             if (($env{'request.course.groups'} eq '') ||
                   2075:                 (!grep(/^\Q$cgroup\E$/,split(/,/,$env{'request.course.groups'})))) {
                   2076:                 $noeditgrp = 1;
                   2077:             }
                   2078:         }
                   2079:     }
1.188     www      2080: 
1.190     albertel 2081:     if      ($udom=$env{'form.udom'}) {
                   2082:     } elsif ($udom=$env{'request.role.domain'}) {
                   2083:     } elsif ($udom=$env{'user.domain'}) {
1.172     albertel 2084:     } else {
1.473     amueller 2085:         $udom=$r->dir_config('lonDefDomain');
1.172     albertel 2086:     }
1.468     amueller 2087:     
1.43      albertel 2088: 
1.134     albertel 2089:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190     albertel 2090:     my $pschp=$env{'form.pschp'};
1.506     www      2091: 
                   2092: 
1.134     albertel 2093:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.522.2.1  raeburn  2094:     if (!@psprt) { $psprt[0]='0'; }
1.506     www      2095:     if (($env{'form.part'}) && ($psprt[0] ne 'all')) { $psprt[0]=$env{'form.part'}; }
1.57      albertel 2096: 
1.43      albertel 2097:     my $pssymb='';
1.57      albertel 2098:     my $parmlev='';
1.446     bisitz   2099: 
1.190     albertel 2100:     unless ($env{'form.parmlev'}) {
1.57      albertel 2101:         $parmlev = 'map';
                   2102:     } else {
1.190     albertel 2103:         $parmlev = $env{'form.parmlev'};
1.57      albertel 2104:     }
1.26      www      2105: 
1.29      www      2106: # ----------------------------------------------- Was this started from grades?
                   2107: 
1.190     albertel 2108:     if (($env{'form.command'} eq 'set') && ($env{'form.url'})
1.473     amueller 2109:     && (!$env{'form.dis'})) {
                   2110:         my $url=$env{'form.url'};
                   2111:         $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                   2112:         $pssymb=&Apache::lonnet::symbread($url);
                   2113:         if (!@pscat) { @pscat=('all'); }
                   2114:         $pschp='';
1.57      albertel 2115:         $parmlev = 'full';
1.190     albertel 2116:     } elsif ($env{'form.symb'}) {
1.473     amueller 2117:         $pssymb=$env{'form.symb'};
                   2118:         if (!@pscat) { @pscat=('all'); }
                   2119:         $pschp='';
1.57      albertel 2120:         $parmlev = 'full';
1.43      albertel 2121:     } else {
1.473     amueller 2122:         $env{'form.url'}='';
1.43      albertel 2123:     }
                   2124: 
1.190     albertel 2125:     my $id=$env{'form.id'};
1.43      albertel 2126:     if (($id) && ($udom)) {
1.473     amueller 2127:         $uname=(&Apache::lonnet::idget($udom,$id))[1];
                   2128:         if ($uname) {
                   2129:             $id='';
                   2130:         } else {
                   2131:             $message=
                   2132:             '<span class="LC_error">'.&mt("Unknown ID")." '$id' ".
                   2133:             &mt('at domain')." '$udom'</span>";
                   2134:         }
1.43      albertel 2135:     } else {
1.473     amueller 2136:         $uname=$env{'form.uname'};
1.43      albertel 2137:     }
                   2138:     unless ($udom) { $uname=''; }
                   2139:     $uhome='';
                   2140:     if ($uname) {
1.473     amueller 2141:         $uhome=&Apache::lonnet::homeserver($uname,$udom);
1.43      albertel 2142:         if ($uhome eq 'no_host') {
1.473     amueller 2143:             $message=
                   2144:             '<span class="LC_error">'.&mt("Unknown user")." '$uname' ".
                   2145:             &mt("at domain")." '$udom'</span>";
                   2146:             $uname='';
1.12      www      2147:         } else {
1.473     amueller 2148:             $csec=&Apache::lonnet::getsection($udom,$uname,
                   2149:                           $env{'request.course.id'});
                   2150:             if ($csec eq '-1') {
                   2151:                 $message='<span class="LC_error">'.
                   2152:                 &mt("User")." '$uname' ".&mt("at domain")." '$udom' ".
                   2153:                 &mt("not in this course")."</span>";
                   2154:                 $uname='';
                   2155:                 $csec=$env{'form.csec'};
1.269     raeburn  2156:                 $cgroup=$env{'form.cgroup'};
1.473     amueller 2157:             } else {
                   2158:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   2159:                   ('firstname','middlename','lastname','generation','id'));
                   2160:                 $message="\n<p>\n".&mt("Full Name").": ".
                   2161:                 $name{'firstname'}.' '.$name{'middlename'}.' '
                   2162:                 .$name{'lastname'}.' '.$name{'generation'}.
1.501     bisitz   2163:                 "<br />\n".&mt('Student/Employee ID').": ".$name{'id'}.'<p>';
1.473     amueller 2164:             }
1.297     raeburn  2165:             @usersgroups = &Apache::lonnet::get_users_groups(
1.275     raeburn  2166:                                        $udom,$uname,$env{'request.course.id'});
1.297     raeburn  2167:             if (@usersgroups > 0) {
1.306     albertel 2168:                 unless (grep(/^\Q$cgroup\E$/,@usersgroups)) {
1.275     raeburn  2169:                     $cgroup = $usersgroups[0];
1.297     raeburn  2170:                 }
1.269     raeburn  2171:             }
1.12      www      2172:         }
1.43      albertel 2173:     }
1.2       www      2174: 
1.43      albertel 2175:     unless ($csec) { $csec=''; }
1.269     raeburn  2176:     unless ($cgroup) { $cgroup=''; }
1.12      www      2177: 
1.14      www      2178: # --------------------------------------------------------- Get all assessments
1.446     bisitz   2179:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 2180:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   2181:                 \%keyorder);
1.63      bowersj2 2182: 
1.57      albertel 2183:     $mapp{'0.0'} = '';
                   2184:     $symbp{'0.0'} = '';
1.99      albertel 2185: 
1.14      www      2186: # ---------------------------------------------------------- Anything to store?
1.522.2.19  raeburn  2187:     if ($env{'form.pres_marker'} && $parm_permission->{'edit'}) {
1.205     www      2188:         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
                   2189:         my @values=split(/\&\&\&/,$env{'form.pres_value'});
                   2190:         my @types=split(/\&\&\&/,$env{'form.pres_type'});
1.500     raeburn  2191:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2192:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.504     raeburn  2193:         my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   2194:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   2195:         my $totalstored = 0;
1.522.2.16  raeburn  2196:         my $now = time;
1.512     foxr     2197: 
1.473     amueller 2198:         for (my $i=0;$i<=$#markers;$i++) {
1.514     raeburn  2199:             my ($needsrelease,$needsnewer,$name);
1.437     raeburn  2200:             if ($markers[$i] =~ /^[\d.]+\&0_availablestudent\&(1|2|3)$/) {
                   2201:                 my (@ok_slots,@fail_slots,@del_slots);
                   2202:                 my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
                   2203:                 my ($level,@all) =
                   2204:                     &parmval_by_symb('0.availablestudent',$pssymb,'',$uname,$udom,
                   2205:                                      $csec,$cgroup,$courseopt);
                   2206:                 foreach my $slot_name (split(/:/,$values[$i])) {
                   2207:                     next if ($slot_name eq '');
                   2208:                     if (&update_slots($slot_name,$cdom,$cnum,$pssymb,$uname,$udom) eq 'ok') {
                   2209:                         push(@ok_slots,$slot_name);
                   2210: 
                   2211:                     } else {
                   2212:                         push(@fail_slots,$slot_name);
                   2213:                     }
                   2214:                 }
                   2215:                 if (@ok_slots) {
                   2216:                     $values[$i] = join(':',@ok_slots);
                   2217:                 } else {
                   2218:                     $values[$i] = '';
                   2219:                 }
                   2220:                 if ($all[$level] ne '') {
                   2221:                     my @existing = split(/:/,$all[$level]);
                   2222:                     foreach my $slot_name (@existing) {
                   2223:                         if (!grep(/^\Q$slot_name\E$/,split(/:/,$values[$i]))) {
                   2224:                             if (&delete_slots($slot_name,$cdom,$cnum,$uname,$udom,$pssymb) eq 'ok') {
                   2225:                                 push(@del_slots,$slot_name);
                   2226:                             }
                   2227:                         }
                   2228:                     }
                   2229:                 }
1.522.2.16  raeburn  2230:             } elsif ($markers[$i] =~ /_(type|lenient|retrypartial|discussvote|examcode|printstartdate|printenddate)\&\d+$/) {
1.514     raeburn  2231:                 $name = $1;
1.522.2.7  raeburn  2232:                 my $val = $values[$i];
                   2233:                 if ($name eq 'examcode') {
1.522.2.14  raeburn  2234:                     if (&Apache::lonnet::validCODE($values[$i])) {
                   2235:                         $val = 'valid';
                   2236:                     }
1.522.2.16  raeburn  2237:                 } elsif ($name eq 'printstartdate') {
                   2238:                     if ($val =~ /^\d+$/) {
                   2239:                         if ($val > $now) {
                   2240:                             $val = 'future';
                   2241:                         }
                   2242:                     }
                   2243:                 } elsif ($name eq 'printenddate') {
                   2244:                     if ($val =~ /^\d+$/) {
                   2245:                         if ($val < $now) {
                   2246:                             $val = 'past';
                   2247:                         }
                   2248:                     }
1.522.2.7  raeburn  2249:                 }
1.504     raeburn  2250:                 $needsrelease =
1.522.2.7  raeburn  2251:                     $Apache::lonnet::needsrelease{"parameter:$name:$val"};
1.504     raeburn  2252:                 if ($needsrelease) {
1.505     raeburn  2253:                     unless ($got_chostname) {
1.514     raeburn  2254:                         ($chostname,$cmajor,$cminor) = &parameter_release_vars();
1.504     raeburn  2255:                         $got_chostname = 1;
                   2256:                     }
1.522.2.7  raeburn  2257:                     $needsnewer = &parameter_releasecheck($name,$val,
1.514     raeburn  2258:                                                           $needsrelease,
                   2259:                                                           $cmajor,$cminor);
1.500     raeburn  2260:                 }
1.437     raeburn  2261:             }
1.504     raeburn  2262:             if ($needsnewer) {
1.514     raeburn  2263:                 $message .= &oldversion_warning($name,$values[$i],$chostname,$cmajor,
1.504     raeburn  2264:                                                 $cminor,$needsrelease);
                   2265:             } else {
                   2266:                 $message.=&storeparm(split(/\&/,$markers[$i]),
                   2267:                                      $values[$i],
                   2268:                                      $types[$i],
                   2269:                                      $uname,$udom,$csec,$cgroup);
                   2270:                 $totalstored ++;
                   2271:             }
1.473     amueller 2272:         }
1.68      www      2273: # ---------------------------------------------------------------- Done storing
1.504     raeburn  2274:         if ($totalstored) {
                   2275:             $message.='<p class="LC_warning">'
                   2276:                      .&mt('Changes can take up to 10 minutes before being active for all students.')
                   2277:                      .&Apache::loncommon::help_open_topic('Caching')
                   2278:                      .'</p>';
                   2279:         }
1.68      www      2280:     }
1.57      albertel 2281: #----------------------------------------------- if all selected, fill in array
1.209     www      2282:     if ($pscat[0] eq "all") {@pscat = (keys %allparms);}
1.501     bisitz   2283:     if (!@pscat) { @pscat=('duedate','opendate','answerdate','weight','maxtries','type','problemstatus') };
1.57      albertel 2284:     if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
1.2       www      2285: # ------------------------------------------------------------------ Start page
1.63      bowersj2 2286: 
1.515     raeburn  2287:     &startpage($r,$pssymb);
1.57      albertel 2288: 
1.44      albertel 2289:     foreach ('tolerance','date_default','date_start','date_end',
1.473     amueller 2290:         'date_interval','int','float','string') {
                   2291:         $r->print('<input type="hidden" value="'.
                   2292:           &HTML::Entities::encode($env{'form.recent_'.$_},'"&<>').
                   2293:           '" name="recent_'.$_.'" />');
1.44      albertel 2294:     }
1.446     bisitz   2295: 
1.459     bisitz   2296:     # ----- Start Parameter Selection
                   2297: 
                   2298:     # Hide parm selection?
                   2299:     $r->print(<<ENDPARMSELSCRIPT);
                   2300: <script type="text/javascript">
                   2301: // <![CDATA[
                   2302: function parmsel_show() {
                   2303:   document.getElementById('parmsel').style.display = "";
                   2304:   document.getElementById('parmsellink').style.display = "none";
                   2305: }
                   2306: // ]]>
                   2307: </script>
                   2308: ENDPARMSELSCRIPT
1.474     amueller 2309:     
1.445     neumanie 2310:     if (!$pssymb) {
1.486     www      2311:         my $parmselhiddenstyle=' style="display:none"';
                   2312:         if($env{'form.hideparmsel'} eq 'hidden') {
                   2313:            $r->print('<div id="parmsel"'.$parmselhiddenstyle.'>');
                   2314:         } else  {
                   2315:            $r->print('<div id="parmsel">');
                   2316:         }
                   2317: 
1.491     bisitz   2318:         # Step 1
1.522.2.2  raeburn  2319:         $r->print(&Apache::lonhtmlcommon::topic_bar(1,&mt('Resource Specification'),'parmstep1'));
                   2320:         $r->print('
1.474     amueller 2321: <script type="text/javascript">
1.522.2.2  raeburn  2322: // <![CDATA['.
                   2323:                  &showhide_js().'
1.474     amueller 2324: // ]]>
                   2325: </script>
1.522.2.2  raeburn  2326: ');
                   2327:         $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.209     www      2328:         &levelmenu($r,\%alllevs,$parmlev);
1.491     bisitz   2329:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.474     amueller 2330:         &mapmenu($r,\%allmaps,$pschp,\%maptitles, \%symbp);
1.491     bisitz   2331:         $r->print(&Apache::lonhtmlcommon::row_closure());
                   2332:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
                   2333:         &partmenu($r,\%allparts,\@psprt);
1.474     amueller 2334:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   2335:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   2336: 
                   2337:         # Step 2
1.522.2.2  raeburn  2338:         $r->print(&Apache::lonhtmlcommon::topic_bar(2,&mt('Parameter Specification'),'parmstep2'));
1.522.2.8  raeburn  2339:         &displaymenu($r,\%allparms,\@pscat,\@psprt,\%keyorder,'parmmenuscroll');
1.491     bisitz   2340: 
                   2341:         # Step 3
1.522.2.2  raeburn  2342:         $r->print(&Apache::lonhtmlcommon::topic_bar(3,&mt('User Specification (optional)'),'parmstep3'));
1.486     www      2343:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
                   2344:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups);
                   2345:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   2346:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   2347: 
                   2348:         # Update Display Button
1.486     www      2349:         $r->print('<p>'
                   2350:              .'<input type="submit" name="dis"'
1.511     www      2351:              .' value="'.&mt('Update Display').'" />'
1.486     www      2352:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
                   2353:              .'</p>');
                   2354:         $r->print('</div>');
1.491     bisitz   2355: 
1.486     www      2356:         # Offer link to display parameter selection again
                   2357:         $r->print('<p id="parmsellink"');
                   2358:         if ($env{'form.hideparmsel'} ne 'hidden') {
                   2359:            $r->print($parmselhiddenstyle);
                   2360:         }
                   2361:         $r->print('>'
                   2362:              .'<a href="javascript:parmsel_show()">'
                   2363:              .&mt('Change Parameter Selection')
                   2364:              .'</a>'
                   2365:              .'</p>');
1.44      albertel 2366:     } else {
1.515     raeburn  2367:         $r->print();
1.478     amueller 2368:         # parameter screen for a single resource. 
1.486     www      2369:         my ($map,$iid,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.473     amueller 2370:         my $title = &Apache::lonnet::gettitle($pssymb);
1.501     bisitz   2371:         $r->print(&mt('Specific Resource: [_1] ([_2])',
                   2372:                          $title,'<span class="LC_filename">'.$resource.'</span>').
1.472     amueller 2373:                 '<input type="hidden" value="'.$pssymb.'" name="symb" />'.
1.486     www      2374:                   '<br />');
                   2375:         $r->print(&Apache::lonhtmlcommon::topic_bar('',&mt('Additional Display Specification (optional)')));
                   2376:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.522.2.1  raeburn  2377:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')).
                   2378:                   '<label>'.
                   2379:                   '<input type="checkbox" name="psprt" value="all"'.
                   2380:                   ($env{'form.psprt'}?' checked="checked"':'').' />'.
                   2381:                   &mt('Show all parts').
                   2382:                   '</label></td></tr>');
1.486     www      2383:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups);
                   2384:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   2385:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   2386:         $r->print('<p>'
1.459     bisitz   2387:              .'<input type="submit" name="dis"'
1.511     www      2388:              .' value="'.&mt('Update Display').'" />'
1.459     bisitz   2389:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
1.486     www      2390:              .'</p>');
1.459     bisitz   2391:     }
1.478     amueller 2392:     
1.486     www      2393:     # ----- End Parameter Selection
1.57      albertel 2394: 
1.459     bisitz   2395:     # Display Messages
                   2396:     $r->print('<div>'.$message.'</div>');
1.210     www      2397: 
1.57      albertel 2398: 
                   2399:     my @temp_pscat;
                   2400:     map {
                   2401:         my $cat = $_;
                   2402:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   2403:     } @pscat;
                   2404: 
                   2405:     @pscat = @temp_pscat;
                   2406: 
1.209     www      2407:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      2408: # ----------------------------------------------------------------- Start Table
1.57      albertel 2409:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 2410:         my $csuname=$env{'user.name'};
                   2411:         my $csudom=$env{'user.domain'};
1.522.2.19  raeburn  2412:         my $readonly = 1;
                   2413:         if ($parm_permission->{'edit'}) {
                   2414:             undef($readonly);
                   2415:         }
1.57      albertel 2416: 
1.203     www      2417:         if ($parmlev eq 'full') {
1.506     www      2418: #
                   2419: # This produces the cascading table output of parameters
                   2420: #
1.473     amueller 2421:                my $coursespan=$csec?8:5;
                   2422:                my $userspan=3;
                   2423:                if ($cgroup ne '') {
                   2424:                   $coursespan += 3;
                   2425:                }
                   2426: 
1.517     www      2427:                $r->print(&Apache::loncommon::start_data_table());
1.506     www      2428: #
                   2429: # This produces the headers
                   2430: #
1.473     amueller 2431:                $r->print('<tr><td colspan="5"></td>');
                   2432:                $r->print('<th colspan="'.($coursespan).'">'.&mt('Any User').'</th>');
                   2433:                if ($uname) {
                   2434:                 if (@usersgroups > 1) {
                   2435:                        $userspan ++;
                   2436:                    }
                   2437:                    $r->print('<th colspan="'.$userspan.'" rowspan="2">');
                   2438:                    $r->print(&mt("User")." $uname ".&mt('at Domain')." $udom</th>");
                   2439:                }
                   2440:                my %lt=&Apache::lonlocal::texthash(
                   2441:                 'pie'    => "Parameter in Effect",
                   2442:                 'csv'    => "Current Session Value",
1.472     amueller 2443:                 'rl'     => "Resource Level",
1.473     amueller 2444:                 'ic'     => 'in Course',
                   2445:                 'aut'    => "Assessment URL and Title",
                   2446:                 'type'   => 'Type',
                   2447:                 'emof'   => "Enclosing Map or Folder",
                   2448:                 'part'   => 'Part',
1.472     amueller 2449:                 'pn'     => 'Parameter Name',
1.473     amueller 2450:                 'def'    => 'default',
                   2451:                 'femof'  => 'from Enclosing Map or Folder',
                   2452:                 'gen'    => 'general',
                   2453:                 'foremf' => 'for Enclosing Map or Folder',
                   2454:                 'fr'     => 'for Resource'
                   2455:             );
                   2456:                $r->print(<<ENDTABLETWO);
1.419     bisitz   2457: <th rowspan="3">$lt{'pie'}</th>
1.501     bisitz   2458: <th rowspan="3">$lt{'csv'}<br />($csuname:$csudom)</th>
1.419     bisitz   2459: </tr><tr><td colspan="5"></td><th colspan="2">$lt{'ic'}</th><th colspan="2">$lt{'rl'}</th>
                   2460: <th colspan="1">$lt{'ic'}</th>
1.182     albertel 2461: 
1.10      www      2462: ENDTABLETWO
1.473     amueller 2463:                if ($csec) {
                   2464:                    $r->print('<th colspan="3">'.
                   2465:                   &mt("in Section")." $csec</th>");
                   2466:                }
                   2467:                if ($cgroup) {
1.419     bisitz   2468:                 $r->print('<th colspan="3">'.
1.472     amueller 2469:                 &mt("in Group")." $cgroup</th>");
1.473     amueller 2470:                }
                   2471:                $r->print(<<ENDTABLEHEADFOUR);
1.133     www      2472: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   2473: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.192     albertel 2474: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
                   2475: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      2476: ENDTABLEHEADFOUR
1.57      albertel 2477: 
1.473     amueller 2478:                if ($csec) {
                   2479:                    $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
                   2480:                }
                   2481: 
                   2482:                if ($cgroup) {
                   2483:                 $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
                   2484:                }
                   2485: 
                   2486:                if ($uname) {
                   2487:                 if (@usersgroups > 1) {
                   2488:                     $r->print('<th>'.&mt('Control by other group?').'</th>');
                   2489:                    }
                   2490:                    $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
                   2491:                }
                   2492: 
                   2493:                $r->print('</tr>');
1.506     www      2494: #
                   2495: # Done with the headers
                   2496: # 
1.473     amueller 2497:                my $defbgone='';
                   2498:                my $defbgtwo='';
                   2499:                my $defbgthree = '';
1.57      albertel 2500: 
1.473     amueller 2501:                foreach (@ids) {
1.57      albertel 2502: 
1.473     amueller 2503:                 my $rid=$_;
1.57      albertel 2504:                 my ($inmapid)=($rid=~/\.(\d+)$/);
                   2505: 
1.446     bisitz   2506:                 if ((!$pssymb &&
1.473     amueller 2507:                  (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   2508:                 ||
                   2509:                 ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      2510: # ------------------------------------------------------ Entry for one resource
1.473     amueller 2511:                     if ($defbgone eq '#E0E099') {
                   2512:                         $defbgone='#E0E0DD';
1.57      albertel 2513:                     } else {
1.419     bisitz   2514:                         $defbgone='#E0E099';
1.57      albertel 2515:                     }
1.419     bisitz   2516:                     if ($defbgtwo eq '#FFFF99') {
1.473     amueller 2517:                         $defbgtwo='#FFFFDD';
1.57      albertel 2518:                     } else {
1.473     amueller 2519:                         $defbgtwo='#FFFF99';
1.57      albertel 2520:                     }
1.419     bisitz   2521:                     if ($defbgthree eq '#FFBB99') {
                   2522:                         $defbgthree='#FFBBDD';
1.269     raeburn  2523:                     } else {
1.419     bisitz   2524:                         $defbgthree='#FFBB99';
1.269     raeburn  2525:                     }
                   2526: 
1.57      albertel 2527:                     my $thistitle='';
                   2528:                     my %name=   ();
                   2529:                     undef %name;
                   2530:                     my %part=   ();
                   2531:                     my %display=();
                   2532:                     my %type=   ();
                   2533:                     my %default=();
1.196     www      2534:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 2535: 
1.506     www      2536:                     my $filter=$env{'form.filter'};
1.210     www      2537:                     foreach (&keysplit($keyp{$rid})) {
1.57      albertel 2538:                         my $tempkeyp = $_;
                   2539:                         if (grep $_ eq $tempkeyp, @catmarker) {
1.506     www      2540:                           my $parmname=&Apache::lonnet::metadata($uri,$_.'.name');
                   2541: # We may only want certain parameters listed
                   2542:                           if ($filter) {
                   2543:                              unless ($filter=~/\Q$parmname\E/) { next; }
                   2544:                           }
                   2545:                           $name{$_}=$parmname;
1.57      albertel 2546:                           $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
1.506     www      2547: 
1.433     raeburn  2548:                           my $parmdis=&Apache::lonnet::metadata($uri,$_.'.display');
                   2549:                           if ($allparms{$name{$_}} ne '') {
                   2550:                               my $identifier;
                   2551:                               if ($parmdis =~ /(\s*\[Part.*)$/) {
                   2552:                                   $identifier = $1;
                   2553:                               }
                   2554:                               $display{$_} = $allparms{$name{$_}}.$identifier;
                   2555:                           } else {
                   2556:                               $display{$_} = $parmdis;
                   2557:                           }
1.57      albertel 2558:                           unless ($display{$_}) { $display{$_}=''; }
                   2559:                           $display{$_}.=' ('.$name{$_}.')';
                   2560:                           $default{$_}=&Apache::lonnet::metadata($uri,$_);
                   2561:                           $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
                   2562:                           $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
                   2563:                         }
                   2564:                     }
                   2565:                     my $totalparms=scalar keys %name;
                   2566:                     if ($totalparms>0) {
1.473     amueller 2567:                            my $firstrow=1;
                   2568:                         my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.419     bisitz   2569:                         $r->print('<tr><td style="background-color:'.$defbgone.';"'.
1.57      albertel 2570:                              ' rowspan='.$totalparms.
1.419     bisitz   2571:                              '><tt><font size="-1">'.
1.57      albertel 2572:                              join(' / ',split(/\//,$uri)).
                   2573:                              '</font></tt><p><b>'.
1.154     albertel 2574:                              "<a href=\"javascript:openWindow('".
1.473     amueller 2575:                           &Apache::lonnet::clutter($uri).'?symb='.
                   2576:                           &escape($symbp{$rid}).
1.336     albertel 2577:                              "', 'metadatafile', '450', '500', 'no', 'yes');\"".
                   2578:                              " target=\"_self\">$title");
1.57      albertel 2579: 
                   2580:                         if ($thistitle) {
1.473     amueller 2581:                             $r->print(' ('.$thistitle.')');
1.57      albertel 2582:                         }
                   2583:                         $r->print('</a></b></td>');
1.419     bisitz   2584:                         $r->print('<td style="background-color:'.$defbgtwo.';"'.
1.57      albertel 2585:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   2586:                                       '</td>');
                   2587: 
1.419     bisitz   2588:                         $r->print('<td style="background-color:'.$defbgone.';"'.
1.57      albertel 2589:                                       ' rowspan='.$totalparms.
1.238     www      2590:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.512     foxr     2591:                         foreach (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 2592: 
                   2593:                             unless ($firstrow) {
                   2594:                                 $r->print('<tr>');
                   2595:                             } else {
                   2596:                                 undef $firstrow;
                   2597:                             }
1.201     www      2598:                             &print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 2599:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  2600:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.522.2.19  raeburn  2601:                                        $cgroup,\@usersgroups,$noeditgrp,$readonly);
1.57      albertel 2602:                         }
                   2603:                     }
                   2604:                 }
                   2605:             } # end foreach ids
1.43      albertel 2606: # -------------------------------------------------- End entry for one resource
1.517     www      2607:             $r->print(&Apache::loncommon::end_data_table);
1.203     www      2608:         } # end of  full
1.57      albertel 2609: #--------------------------------------------------- Entry for parm level map
                   2610:         if ($parmlev eq 'map') {
1.419     bisitz   2611:             my $defbgone = '#E0E099';
                   2612:             my $defbgtwo = '#FFFF99';
                   2613:             my $defbgthree = '#FFBB99';
1.57      albertel 2614: 
                   2615:             my %maplist;
                   2616: 
                   2617:             if ($pschp eq 'all') {
1.446     bisitz   2618:                 %maplist = %allmaps;
1.57      albertel 2619:             } else {
                   2620:                 %maplist = ($pschp => $mapp{$pschp});
                   2621:             }
                   2622: 
                   2623: #-------------------------------------------- for each map, gather information
                   2624:             my $mapid;
1.473     amueller 2625:                foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
1.60      albertel 2626:                 my $maptitle = $maplist{$mapid};
1.57      albertel 2627: 
                   2628: #-----------------------  loop through ids and get all parameter types for map
                   2629: #-----------------------------------------          and associated information
                   2630:                 my %name = ();
                   2631:                 my %part = ();
                   2632:                 my %display = ();
                   2633:                 my %type = ();
                   2634:                 my %default = ();
                   2635:                 my $map = 0;
                   2636: 
1.473     amueller 2637: #        $r->print("Catmarker: @catmarker<br />\n");
1.446     bisitz   2638: 
1.57      albertel 2639:                 foreach (@ids) {
1.473     amueller 2640:                     ($map)=(/([\d]*?)\./);
                   2641:                       my $rid = $_;
1.446     bisitz   2642: 
1.57      albertel 2643: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   2644: 
1.473     amueller 2645:                      if ($map eq $mapid) {
                   2646:                         my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 2647: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   2648: 
                   2649: #--------------------------------------------------------------------
                   2650: # @catmarker contains list of all possible parameters including part #s
                   2651: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   2652: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   2653: # When storing information, store as part 0
                   2654: # When requesting information, request from full part
                   2655: #-------------------------------------------------------------------
1.473     amueller 2656:                         foreach (&keysplit($keyp{$rid})) {
                   2657:                              my $tempkeyp = $_;
                   2658:                               my $fullkeyp = $tempkeyp;
                   2659:                               $tempkeyp =~ s/_\w+_/_0_/;
                   2660: 
                   2661:                               if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   2662:                                 $part{$tempkeyp}="0";
                   2663:                                 $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   2664:                                 my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   2665:                                 if ($allparms{$name{$tempkeyp}} ne '') {
                   2666:                                     my $identifier;
                   2667:                                     if ($parmdis =~ /(\s*\[Part.*)$/) {
                   2668:                                         $identifier = $1;
                   2669:                                     }
                   2670:                                     $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   2671:                                 } else {
                   2672:                                     $display{$tempkeyp} = $parmdis;
                   2673:                                 }
                   2674:                                 unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   2675:                                 $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   2676:                                 $display{$tempkeyp} =~ s/_\w+_/_0_/;
                   2677:                                 $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   2678:                                 $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   2679:                               }
                   2680:                         } # end loop through keys
                   2681:                       }
1.57      albertel 2682:                 } # end loop through ids
1.446     bisitz   2683: 
1.57      albertel 2684: #---------------------------------------------------- print header information
1.133     www      2685:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      2686:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.401     bisitz   2687:                 my $tmp="";
1.57      albertel 2688:                 if ($uname) {
1.473     amueller 2689:                     my $person=&Apache::loncommon::plainname($uname,$udom);
1.401     bisitz   2690:                     $tmp.=&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
                   2691:                         &mt('in')." \n";
1.57      albertel 2692:                 } else {
1.401     bisitz   2693:                     $tmp.="<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n";
1.57      albertel 2694:                 }
1.269     raeburn  2695:                 if ($cgroup) {
1.401     bisitz   2696:                     $tmp.=&mt("Group")." <font color=\"red\"><i>$cgroup".
                   2697:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  2698:                     $csec = '';
                   2699:                 } elsif ($csec) {
1.401     bisitz   2700:                     $tmp.=&mt("Section")." <font color=\"red\"><i>$csec".
                   2701:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  2702:                 }
1.401     bisitz   2703:                 $r->print('<div align="center"><h4>'
                   2704:                          .&mt('Set Defaults for All Resources in [_1]Specifically for [_2][_3]'
1.404     bisitz   2705:                              ,$foldermap.'<br /><font color="red"><i>'.$showtitle.'</i></font><br />'
1.401     bisitz   2706:                              ,$tmp
                   2707:                              ,'<font color="red"><i>'.$coursename.'</i></font>'
                   2708:                              )
                   2709:                          ."<br /></h4>\n"
1.422     bisitz   2710:                 );
1.57      albertel 2711: #---------------------------------------------------------------- print table
1.419     bisitz   2712:                 $r->print('<p>'.&Apache::loncommon::start_data_table()
                   2713:                          .&Apache::loncommon::start_data_table_header_row()
                   2714:                          .'<th>'.&mt('Parameter Name').'</th>'
                   2715:                          .'<th>'.&mt('Default Value').'</th>'
                   2716:                          .'<th>'.&mt('Parameter in Effect').'</th>'
                   2717:                          .&Apache::loncommon::end_data_table_header_row()
                   2718:                 );
1.57      albertel 2719: 
1.473     amueller 2720:                 foreach (&keysinorder(\%name,\%keyorder)) {
                   2721:                     $r->print(&Apache::loncommon::start_data_table_row());
1.201     www      2722:                     &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  2723:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
1.522.2.19  raeburn  2724:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                   2725:                            $readonly);
1.57      albertel 2726:                 }
1.422     bisitz   2727:                 $r->print(&Apache::loncommon::end_data_table().'</p>'
                   2728:                          .'</div>'
                   2729:                 );
1.57      albertel 2730:             } # end each map
                   2731:         } # end of $parmlev eq map
                   2732: #--------------------------------- Entry for parm level general (Course level)
                   2733:         if ($parmlev eq 'general') {
1.473     amueller 2734:             my $defbgone = '#E0E099';
1.419     bisitz   2735:             my $defbgtwo = '#FFFF99';
                   2736:             my $defbgthree = '#FFBB99';
1.57      albertel 2737: 
                   2738: #-------------------------------------------- for each map, gather information
                   2739:             my $mapid="0.0";
                   2740: #-----------------------  loop through ids and get all parameter types for map
                   2741: #-----------------------------------------          and associated information
                   2742:             my %name = ();
                   2743:             my %part = ();
                   2744:             my %display = ();
                   2745:             my %type = ();
                   2746:             my %default = ();
1.446     bisitz   2747: 
1.57      albertel 2748:             foreach (@ids) {
                   2749:                 my $rid = $_;
1.446     bisitz   2750: 
1.196     www      2751:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 2752: 
                   2753: #--------------------------------------------------------------------
                   2754: # @catmarker contains list of all possible parameters including part #s
                   2755: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   2756: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   2757: # When storing information, store as part 0
                   2758: # When requesting information, request from full part
                   2759: #-------------------------------------------------------------------
1.473     amueller 2760:                 foreach (&keysplit($keyp{$rid})) {
                   2761:                     my $tempkeyp = $_;
                   2762:                       my $fullkeyp = $tempkeyp;
                   2763:                       $tempkeyp =~ s/_\w+_/_0_/;
                   2764:                       if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   2765:                         $part{$tempkeyp}="0";
                   2766:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   2767:                         my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   2768:                         if ($allparms{$name{$tempkeyp}} ne '') {
                   2769:                             my $identifier;
                   2770:                             if ($parmdis =~ /(\s*\[Part.*)$/) {
                   2771:                                 $identifier = $1;
                   2772:                             }
                   2773:                             $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   2774:                         } else {
                   2775:                             $display{$tempkeyp} = $parmdis;
                   2776:                         }
                   2777:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   2778:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   2779:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
                   2780:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   2781:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   2782:                       }
1.57      albertel 2783:                 } # end loop through keys
                   2784:             } # end loop through ids
1.446     bisitz   2785: 
1.57      albertel 2786: #---------------------------------------------------- print header information
1.473     amueller 2787:             my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 2788:             $r->print(<<ENDMAPONE);
1.419     bisitz   2789: <center>
                   2790: <h4>$setdef
1.135     albertel 2791: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 2792: ENDMAPONE
                   2793:             if ($uname) {
1.473     amueller 2794:                 my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 2795:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 2796:             } else {
1.135     albertel 2797:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 2798:             }
1.446     bisitz   2799: 
1.135     albertel 2800:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.306     albertel 2801:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$cgroup</i></font>\n")};
1.135     albertel 2802:             $r->print("</h4>\n");
1.57      albertel 2803: #---------------------------------------------------------------- print table
1.419     bisitz   2804:             $r->print('<p>'.&Apache::loncommon::start_data_table()
                   2805:                      .&Apache::loncommon::start_data_table_header_row()
                   2806:                      .'<th>'.&mt('Parameter Name').'</th>'
                   2807:                      .'<th>'.&mt('Default Value').'</th>'
                   2808:                      .'<th>'.&mt('Parameter in Effect').'</th>'
                   2809:                      .&Apache::loncommon::end_data_table_header_row()
                   2810:             );
1.57      albertel 2811: 
1.473     amueller 2812:             foreach (&keysinorder(\%name,\%keyorder)) {
1.419     bisitz   2813:                 $r->print(&Apache::loncommon::start_data_table_row());
1.201     www      2814:                 &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.522.2.19  raeburn  2815:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   2816:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                   2817:                            $readonly);
1.57      albertel 2818:             }
1.419     bisitz   2819:             $r->print(&Apache::loncommon::end_data_table()
                   2820:                      .'</p>'
                   2821:                      .'</center>'
                   2822:             );
1.57      albertel 2823:         } # end of $parmlev eq general
1.43      albertel 2824:     }
1.507     www      2825:     $r->print('</form>');
                   2826:     $r->print(&Apache::loncommon::end_page());
1.57      albertel 2827: } # end sub assessparms
1.30      www      2828: 
1.120     www      2829: ##################################################
1.207     www      2830: # Overview mode
                   2831: ##################################################
1.124     www      2832: my $tableopen;
                   2833: 
                   2834: sub tablestart {
1.522.2.19  raeburn  2835:     my ($readonly) = @_;
1.124     www      2836:     if ($tableopen) {
1.522.2.19  raeburn  2837:         return '';
1.124     www      2838:     } else {
1.522.2.19  raeburn  2839:         $tableopen=1;
                   2840:         my $output = &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th>';
                   2841:         if ($readonly) {
                   2842:             $output .= '<th>'.&mt('Current value').'</th>';
                   2843:         } else {
                   2844:             $output .= '<th>'.&mt('Delete').'</th><th>'.&mt('Set to ...').'</th>';
                   2845:         }
                   2846:         $output .= '</tr>';
                   2847:         return $output;
1.124     www      2848:     }
                   2849: }
                   2850: 
                   2851: sub tableend {
                   2852:     if ($tableopen) {
1.473     amueller 2853:     $tableopen=0;
                   2854:     return &Apache::loncommon::end_data_table();
1.124     www      2855:     } else {
1.473     amueller 2856:     return'';
1.124     www      2857:     }
                   2858: }
                   2859: 
1.207     www      2860: sub readdata {
                   2861:     my ($crs,$dom)=@_;
                   2862: # Read coursedata
                   2863:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   2864: # Read userdata
                   2865: 
                   2866:     my $classlist=&Apache::loncoursedata::get_classlist();
                   2867:     foreach (keys %$classlist) {
1.350     albertel 2868:         if ($_=~/^($match_username)\:($match_domain)$/) {
1.473     amueller 2869:         my ($tuname,$tudom)=($1,$2);
                   2870:         my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
1.207     www      2871:             foreach my $userkey (keys %{$useropt}) {
1.473     amueller 2872:         if ($userkey=~/^$env{'request.course.id'}/) {
1.207     www      2873:                     my $newkey=$userkey;
1.473     amueller 2874:             $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   2875:             $$resourcedata{$newkey}=$$useropt{$userkey};
                   2876:         }
                   2877:         }
                   2878:     }
1.207     www      2879:     }
1.522.2.19  raeburn  2880:     if (wantarray) {
                   2881:         return ($resourcedata,$classlist);
                   2882:     } else {
                   2883:         return $resourcedata;
                   2884:     }
1.207     www      2885: }
                   2886: 
                   2887: 
1.124     www      2888: # Setting
1.208     www      2889: 
                   2890: sub storedata {
                   2891:     my ($r,$crs,$dom)=@_;
1.207     www      2892: # Set userlevel immediately
                   2893: # Do an intermediate store of course level
                   2894:     my $olddata=&readdata($crs,$dom);
1.124     www      2895:     my %newdata=();
                   2896:     undef %newdata;
                   2897:     my @deldata=();
                   2898:     undef @deldata;
1.504     raeburn  2899:     my ($got_chostname,$chostname,$cmajor,$cminor);
1.522.2.16  raeburn  2900:     my $now = time;
1.504     raeburn  2901:     foreach my $key (keys(%env)) { 
                   2902:     if ($key =~ /^form\.([a-z]+)\_(.+)$/) {
1.473     amueller 2903:         my $cmd=$1;
                   2904:         my $thiskey=$2;
                   2905:         my ($tuname,$tudom)=&extractuser($thiskey);
                   2906:         my $tkey=$thiskey;
                   2907:             if ($tuname) {
                   2908:         $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   2909:         }
                   2910:         if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
1.522.2.16  raeburn  2911:         my ($data, $typeof, $text, $name, $valchk);
1.473     amueller 2912:         if ($cmd eq 'set') {
1.504     raeburn  2913:             $data=$env{$key};
1.522.2.16  raeburn  2914:             $valchk = $data;
1.473     amueller 2915:             $typeof=$env{'form.typeof_'.$thiskey};
                   2916:             $text = &mt('Saved modified parameter for');
1.504     raeburn  2917:             if ($typeof eq 'string_questiontype') {
1.514     raeburn  2918:                 $name = 'type';
                   2919:             } elsif ($typeof eq 'string_lenient') {
                   2920:                 $name = 'lenient';
1.521     raeburn  2921:             } elsif ($typeof eq 'string_discussvote') {
                   2922:                 $name = 'discussvote';
1.522.2.7  raeburn  2923:             } elsif ($typeof eq 'string_examcode') {
                   2924:                 $name = 'examcode';
1.522.2.16  raeburn  2925:                 if (&Apache::lonnet::validCODE($data)) {
                   2926:                     $valchk = 'valid';
                   2927:                 }
1.519     raeburn  2928:             } elsif ($typeof eq 'string_yesno') {
                   2929:                 if ($thiskey =~ /\.retrypartial$/) {
                   2930:                     $name = 'retrypartial';
                   2931:                 }
1.514     raeburn  2932:             }
1.522.2.16  raeburn  2933:         } elsif ($cmd eq 'datepointer') {
                   2934:             $data=&Apache::lonhtmlcommon::get_date_from_form($env{$key});
                   2935:             $typeof=$env{'form.typeof_'.$thiskey};
                   2936:             $text = &mt('Saved modified date for');
                   2937:             if ($typeof eq 'date_start') {
                   2938:                 if ($thiskey =~ /\.printstartdate$/) {
                   2939:                     $name = 'printstartdate';
                   2940:                     if (($data) && ($data > $now)) {
                   2941:                         $valchk = 'future';
1.504     raeburn  2942:                     }
                   2943:                 }
1.522.2.16  raeburn  2944:             } elsif ($typeof eq 'date_end') {
                   2945:                 if ($thiskey =~ /\.printenddate$/) {
                   2946:                     $name = 'printenddate';
                   2947:                     if (($data) && ($data < $now)) {
                   2948:                         $valchk = 'past';
                   2949:                     }
                   2950:                 }
                   2951:             }
                   2952:         } elsif ($cmd eq 'dateinterval') {
                   2953:             $data=&get_date_interval_from_form($thiskey);
                   2954:             $typeof=$env{'form.typeof_'.$thiskey};
                   2955:             $text = &mt('Saved modified date for');
                   2956:         }
                   2957:         if ($name ne '') {
                   2958:             my ($needsrelease,$needsnewer);
                   2959:             $needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk"};
                   2960:             if ($needsrelease) {
                   2961:                 unless ($got_chostname) {
                   2962:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
                   2963:                     $got_chostname = 1;
                   2964:                 }
                   2965:                 $needsnewer = &parameter_releasecheck($name,$valchk,
                   2966:                                                       $needsrelease,
                   2967:                                                       $cmajor,$cminor);
1.504     raeburn  2968:                 if ($needsnewer) {
1.514     raeburn  2969:                     $r->print('<br />'.&oldversion_warning($name,$data,
                   2970:                                                            $chostname,$cmajor,
1.504     raeburn  2971:                                                            $cminor,$needsrelease));
                   2972:                     next;
                   2973:                 }
                   2974:             }
1.473     amueller 2975:         }
                   2976:         if (defined($data) and $$olddata{$thiskey} ne $data) {
1.207     www      2977:             if ($tuname) {
1.473     amueller 2978:             if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
                   2979:                                  $tkey.'.type' => $typeof},
                   2980:                          $tudom,$tuname) eq 'ok') {
                   2981:                 &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom);
                   2982:                 $r->print('<br />'.$text.' '.
                   2983:                       &Apache::loncommon::plainname($tuname,$tudom));
                   2984:             } else {
                   2985:                 $r->print('<div class="LC_error">'.
                   2986:                       &mt('Error saving parameters').'</div>');
                   2987:             }
                   2988:             &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2989:             } else {
                   2990:             $newdata{$thiskey}=$data;
                   2991:              $newdata{$thiskey.'.type'}=$typeof;
1.446     bisitz   2992:                    }
1.473     amueller 2993:         }
                   2994:         } elsif ($cmd eq 'del') {
                   2995:         if ($tuname) {
                   2996:             if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') {
                   2997:                 &log_parmset({$tkey=>''},1,$tuname,$tudom);
                   2998:             $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   2999:             } else {
                   3000:             $r->print('<div class="LC_error">'.
                   3001:                   &mt('Error deleting parameters').'</div>');
                   3002:             }
                   3003:             &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   3004:         } else {
                   3005:             push (@deldata,$thiskey,$thiskey.'.type');
                   3006:         }
                   3007:         }
                   3008:     }
1.124     www      3009:     }
1.207     www      3010: # Store all course level
1.144     www      3011:     my $delentries=$#deldata+1;
                   3012:     my @newdatakeys=keys %newdata;
                   3013:     my $putentries=$#newdatakeys+1;
                   3014:     if ($delentries) {
1.473     amueller 3015:     if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {
                   3016:         my %loghash=map { $_ => '' } @deldata;
                   3017:         &log_parmset(\%loghash,1);
1.522.2.18  raeburn  3018:         $r->print('<h2>'.&mt('Deleted [quant,_1,parameter]',$delentries/2).'</h2>');
1.473     amueller 3019:     } else {
                   3020:         $r->print('<div class="LC_error">'.
                   3021:               &mt('Error deleting parameters').'</div>');
                   3022:     }
                   3023:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      3024:     }
                   3025:     if ($putentries) {
1.473     amueller 3026:     if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
                   3027:                 &log_parmset(\%newdata,0);
1.522.2.17  raeburn  3028:         $r->print('<h3>'.&mt('Saved [quant,_1,parameter]',$putentries/2).'</h3>');
1.473     amueller 3029:     } else {
                   3030:         $r->print('<div class="LC_error">'.
                   3031:               &mt('Error saving parameters').'</div>');
                   3032:     }
                   3033:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      3034:     }
1.208     www      3035: }
1.207     www      3036: 
1.208     www      3037: sub extractuser {
                   3038:     my $key=shift;
1.350     albertel 3039:     return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
1.208     www      3040: }
1.206     www      3041: 
1.381     albertel 3042: sub parse_listdata_key {
                   3043:     my ($key,$listdata) = @_;
                   3044:     # split into student/section affected, and
                   3045:     # the realm (folder/resource part and parameter
1.446     bisitz   3046:     my ($student,$realm) =
1.473     amueller 3047:     ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
1.381     albertel 3048:     # if course wide student would be undefined
                   3049:     if (!defined($student)) {
1.473     amueller 3050:     ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.381     albertel 3051:     }
                   3052:     # strip off the .type if it's not the Question type parameter
                   3053:     if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
1.473     amueller 3054:     $realm=~s/\.type//;
1.381     albertel 3055:     }
                   3056:     # split into resource+part and parameter name
1.388     albertel 3057:     my ($res,    $parm) = ($realm=~/^(.*)\.(.*)$/);
                   3058:        ($res, my $part) = ($res  =~/^(.*)\.(.*)$/);
1.381     albertel 3059:     return ($student,$res,$part,$parm);
                   3060: }
                   3061: 
1.208     www      3062: sub listdata {
1.522.2.19  raeburn  3063:     my ($r,$resourcedata,$listdata,$sortorder,$caller,$classlist,$readonly)=@_;
1.207     www      3064: # Start list output
1.206     www      3065: 
1.122     www      3066:     my $oldsection='';
                   3067:     my $oldrealm='';
                   3068:     my $oldpart='';
1.123     www      3069:     my $pointer=0;
1.124     www      3070:     $tableopen=0;
1.145     www      3071:     my $foundkeys=0;
1.248     albertel 3072:     my %keyorder=&standardkeyorder();
1.381     albertel 3073: 
1.214     www      3074:     foreach my $thiskey (sort {
1.473     amueller 3075:     my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
                   3076:     my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
1.381     albertel 3077: 
1.473     amueller 3078:     # get the numerical order for the param
                   3079:     $aparm=$keyorder{'parameter_0_'.$aparm};
                   3080:     $bparm=$keyorder{'parameter_0_'.$bparm};
1.381     albertel 3081: 
1.473     amueller 3082:     my $result=0;
1.381     albertel 3083: 
1.473     amueller 3084:     if ($sortorder eq 'realmstudent') {
1.381     albertel 3085:             if ($ares     ne $bres    ) {
1.473     amueller 3086:         $result = ($ares     cmp $bres);
1.446     bisitz   3087:             } elsif ($astudent ne $bstudent) {
1.473     amueller 3088:         $result = ($astudent cmp $bstudent);
                   3089:         } elsif ($apart    ne $bpart   ) {
                   3090:         $result = ($apart    cmp $bpart);
                   3091:         }
                   3092:     } else {
                   3093:         if      ($astudent ne $bstudent) {
                   3094:         $result = ($astudent cmp $bstudent);
                   3095:         } elsif ($ares     ne $bres    ) {
                   3096:         $result = ($ares     cmp $bres);
                   3097:         } elsif ($apart    ne $bpart   ) {
                   3098:         $result = ($apart    cmp $bpart);
                   3099:         }
                   3100:     }
1.446     bisitz   3101: 
1.473     amueller 3102:     if (!$result) {
1.381     albertel 3103:             if (defined($aparm) && defined($bparm)) {
1.473     amueller 3104:         $result = ($aparm <=> $bparm);
1.381     albertel 3105:             } elsif (defined($aparm)) {
1.473     amueller 3106:         $result = -1;
1.381     albertel 3107:             } elsif (defined($bparm)) {
1.473     amueller 3108:         $result = 1;
                   3109:         }
                   3110:     }
1.381     albertel 3111: 
1.473     amueller 3112:     $result;
1.214     www      3113:     } keys %{$listdata}) {
1.381     albertel 3114: 
1.473     amueller 3115:     if ($$listdata{$thiskey.'.type'}) {
1.211     www      3116:             my $thistype=$$listdata{$thiskey.'.type'};
                   3117:             if ($$resourcedata{$thiskey.'.type'}) {
1.473     amueller 3118:         $thistype=$$resourcedata{$thiskey.'.type'};
                   3119:         }
                   3120:         my ($middle,$part,$name)=
                   3121:         ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
                   3122:         my $section=&mt('All Students');
                   3123:         if ($middle=~/^\[(.*)\]/) {
                   3124:         my $issection=$1;
                   3125:         if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
                   3126:             $section=&mt('User').": ".&Apache::loncommon::plainname($1,$2);
                   3127:         } else {
                   3128:             $section=&mt('Group/Section').': '.$issection;
                   3129:         }
                   3130:         $middle=~s/^\[(.*)\]//;
                   3131:         }
                   3132:         $middle=~s/\.+$//;
                   3133:         $middle=~s/^\.+//;
                   3134:         my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
                   3135:         if ($middle=~/^(.+)\_\_\_\(all\)$/) {
                   3136:         $realm='<span class="LC_parm_scope_folder">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><span class="LC_parm_folder">('.$1.')</span></span>';
                   3137:         } elsif ($middle) {
                   3138:         my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   3139:         $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.' in '.$map.' id: '.$id.')</span></span>';
                   3140:         }
                   3141:         if ($sortorder eq 'realmstudent') {
                   3142:         if ($realm ne $oldrealm) {
                   3143:             $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   3144:             $oldrealm=$realm;
                   3145:             $oldsection='';
                   3146:         }
                   3147:         if ($section ne $oldsection) {
                   3148:             $r->print(&tableend()."\n<h2>$section</h2>");
                   3149:             $oldsection=$section;
                   3150:             $oldpart='';
                   3151:         }
                   3152:         } else {
                   3153:         if ($section ne $oldsection) {
                   3154:             $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   3155:             $oldsection=$section;
                   3156:             $oldrealm='';
                   3157:         }
                   3158:         if ($realm ne $oldrealm) {
                   3159:             $r->print(&tableend()."\n<h2>$realm</h2>");
                   3160:             $oldrealm=$realm;
                   3161:             $oldpart='';
                   3162:         }
                   3163:         }
                   3164:         if ($part ne $oldpart) {
                   3165:         $r->print(&tableend().
                   3166:               "\n".'<span class="LC_parm_part">'.&mt('Part').": $part</span>");
                   3167:         $oldpart=$part;
                   3168:         }
1.123     www      3169: #
                   3170: # Ready to print
                   3171: #
1.470     raeburn  3172:             my $parmitem = &standard_parameter_names($name);
1.522.2.19  raeburn  3173:         $r->print(&tablestart($readonly).
1.473     amueller 3174:               &Apache::loncommon::start_data_table_row().
                   3175:               '<td><b>'.&mt($parmitem).
1.522.2.19  raeburn  3176:               '</b></td>');
                   3177:         unless ($readonly) {
                   3178:             $r->print('<td><input type="checkbox" name="del_'.
                   3179:                       $thiskey.'" /></td>');
                   3180:         }
                   3181:         $r->print('<td>');
1.473     amueller 3182:         $foundkeys++;
                   3183:         if (&isdateparm($thistype)) {
1.522.2.19  raeburn  3184:             my $jskey='key_'.$pointer;
                   3185:             my $state;
                   3186:             $pointer++;
                   3187:             if ($readonly) {
                   3188:                 $state = 'disabled';
                   3189:             }
                   3190:             $r->print(
                   3191:                 &Apache::lonhtmlcommon::date_setter('parmform',
                   3192:                                                     $jskey,
                   3193:                                                     $$resourcedata{$thiskey},
                   3194:                                                     '',1,$state));
                   3195:             unless ($readonly) {
                   3196:                 $r->print(
1.277     www      3197: '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
1.413     bisitz   3198: (($$resourcedata{$thiskey}!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$$resourcedata{$thiskey}.'">'.
                   3199: &mt('Shift all dates based on this date').'</a></span>':'').
1.277     www      3200: &date_sanity_info($$resourcedata{$thiskey})
1.473     amueller 3201:               );
1.522.2.19  raeburn  3202:             }
1.473     amueller 3203:         } elsif ($thistype eq 'date_interval') {
1.522.2.23.2.  (raeburn 3204:):             $r->print(&date_interval_selector($thiskey,$name,
1.522.2.19  raeburn  3205:                       $$resourcedata{$thiskey},$readonly));
1.473     amueller 3206:         } elsif ($thistype =~ m/^string/) {
1.522.2.19  raeburn  3207:             $r->print(&string_selector($thistype,$thiskey,
                   3208:                       $$resourcedata{$thiskey},$name,$readonly));
1.473     amueller 3209:         } else {
1.522.2.19  raeburn  3210:             $r->print(&default_selector($thiskey,$$resourcedata{$thiskey},$readonly));
1.473     amueller 3211:         }
1.522.2.19  raeburn  3212:         unless ($readonly) {
                   3213:             $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   3214:                       $thistype.'" />');
1.522.2.20  raeburn  3215:         }
1.473     amueller 3216:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
                   3217:     }
1.121     www      3218:     }
1.208     www      3219:     return $foundkeys;
                   3220: }
                   3221: 
1.385     albertel 3222: 
                   3223: sub date_interval_selector {
1.522.2.23.2.  (raeburn 3224:):     my ($thiskey, $pname, $showval, $readonly) = @_;
                   3225:):     my ($result,%skipval);
                   3226:):     my $currval = $showval;
1.385     albertel 3227:     foreach my $which (['days', 86400, 31],
1.473     amueller 3228:                ['hours', 3600, 23],
                   3229:                ['minutes', 60, 59],
                   3230:                ['seconds',  1, 59]) {
                   3231:     my ($name, $factor, $max) = @{ $which };
                   3232:     my $amount = int($showval/$factor);
                   3233:     $showval  %= $factor;
                   3234:     my %select = ((map {$_ => $_} (0..$max)),
                   3235:               'select_form_order' => [0..$max]);
                   3236:     $result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey,
1.522.2.19  raeburn  3237:                            \%select,'',$readonly);
1.473     amueller 3238:     $result .= ' '.&mt($name);
1.385     albertel 3239:     }
1.522.2.23.2.  (raeburn 3240:):     if ($pname eq 'interval') {
                   3241:):         unless ($skipval{'done'}) {
                   3242:):             my $checkedon = '';
                   3243:):             my $checkedproc = '';
                   3244:):             my $currproctorkey = '';
                   3245:):             my $currprocdisplay = 'hidden';
                   3246:):             my $currdonetext = &mt('Done');
                   3247:):             my $checkedoff = ' checked="checked"';
                   3248:):             if ($currval =~ /^(?:\d+)_done$/) {
                   3249:):                 $checkedon = ' checked="checked"';
                   3250:):                 $checkedoff = '';
                   3251:):             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:$/) {
                   3252:):                 $currdonetext = $1;
                   3253:):                 $checkedon = ' checked="checked"';
                   3254:):                 $checkedoff = '';
                   3255:):             } elsif ($currval =~ /^(?:\d+)_done_proctor_(.+)$/) {
                   3256:):                 $currproctorkey = $1;
                   3257:):                 $checkedproc = ' checked="checked"';
                   3258:):                 $checkedoff = '';
                   3259:):                 $currprocdisplay = 'text';
                   3260:):             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:_proctor_(.+)$/) {
                   3261:):                 $currdonetext = $1;
                   3262:):                 $currproctorkey = $2;
                   3263:):                 $checkedproc = ' checked="checked"';
                   3264:):                 $checkedoff = '';
                   3265:):                 $currprocdisplay = 'text';
                   3266:):             }
                   3267:):             my $onclick = ' onclick="toggleSecret(this.form,'."'done_','$thiskey'".');"';
                   3268:):             my $disabled;
                   3269:):             if ($readonly) {
                   3270:):                 $disabled = ' disabled="disabled"';
                   3271:):             }
                   3272:):             $result .= '<br /><span class="LC_nobreak">'.&mt('Include "done" button').
                   3273:):                        '<label><input type="radio" value="" name="done_'.$thiskey.'"'.$checkedoff.$onclick.$disabled.' />'.
                   3274:):                        &mt('No').'</label>'.('&nbsp;'x2).
                   3275:):                        '<label><input type="radio" value="_done" name="done_'.$thiskey.'"'.$checkedon.$onclick.$disabled.' />'.
                   3276:):                        &mt('Yes').'</label>'.('&nbsp;'x2).
                   3277:):                        '<label><input type="radio" value="_done_proctor" name="done_'.$thiskey.'"'.$checkedproc.$onclick.$disabled.' />'.
                   3278:):                        &mt('Yes, with proctor key').'</label>'.
                   3279:):                        '<input type="'.$currprocdisplay.'" id="done_'.$thiskey.'_proctorkey" '.
                   3280:):                        'name="done_'.$thiskey.'_proctorkey" value="'.&HTML::Entities::encode($currproctorkey,'"<>&').'"'.$disabled.' /></span><br />'.
                   3281:):                        '<span class="LC_nobreak">'.&mt('Button text').': '.
                   3282:):                        '<input type="text" name="done_'.$thiskey.'_buttontext" value="'.&HTML::Entities::encode($currdonetext,'"<>&').'"'.$disabled.' /></span>';
                   3283:):         }
                   3284:):     }
1.522.2.19  raeburn  3285:     unless ($readonly) {
                   3286:         $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
                   3287:     }
1.385     albertel 3288:     return $result;
                   3289: 
                   3290: }
                   3291: 
                   3292: sub get_date_interval_from_form {
                   3293:     my ($key) = @_;
                   3294:     my $seconds = 0;
                   3295:     foreach my $which (['days', 86400],
1.473     amueller 3296:                ['hours', 3600],
                   3297:                ['minutes', 60],
                   3298:                ['seconds',  1]) {
                   3299:     my ($name, $factor) = @{ $which };
                   3300:     if (defined($env{'form.'.$name.'_'.$key})) {
                   3301:         $seconds += $env{'form.'.$name.'_'.$key} * $factor;
                   3302:     }
1.385     albertel 3303:     }
                   3304:     return $seconds;
                   3305: }
                   3306: 
                   3307: 
1.383     albertel 3308: sub default_selector {
1.522.2.19  raeburn  3309:     my ($thiskey, $showval, $readonly) = @_;
                   3310:     my $disabled;
                   3311:     if ($readonly) {
                   3312:         $disabled = ' disabled="disabled"';
                   3313:     }
                   3314:     return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'"'.$disabled.' />';
1.383     albertel 3315: }
                   3316: 
1.446     bisitz   3317: my %strings =
1.383     albertel 3318:     (
                   3319:      'string_yesno'
                   3320:              => [[ 'yes', 'Yes' ],
1.473     amueller 3321:          [ 'no', 'No' ]],
1.383     albertel 3322:      'string_problemstatus'
                   3323:              => [[ 'yes', 'Yes' ],
1.473     amueller 3324:          [ 'answer', 'Yes, and show correct answer if they exceed the maximum number of tries.' ],
                   3325:          [ 'no', 'No, don\'t show correct/incorrect feedback.' ],
                   3326:          [ 'no_feedback_ever', 'No, show no feedback at all.' ]],
1.504     raeburn  3327:      'string_questiontype'
                   3328:              => [[ 'problem', 'Standard Problem'],
                   3329:                  [ 'survey', 'Survey'],
                   3330:                  [ 'anonsurveycred', 'Anonymous Survey (credit for submission)'],
                   3331:                  [ 'exam', 'Exam'],
                   3332:                  [ 'anonsurvey', 'Anonymous Survey'],
                   3333:                  [ 'randomizetry', 'New Randomization Each N Tries (default N=1)'],
                   3334:                  [ 'practice', 'Practice'],
                   3335:                  [ 'surveycred', 'Survey (credit for submission)']],
1.514     raeburn  3336:      'string_lenient'
                   3337:              => [['yes', 'Yes' ],
                   3338:                  [ 'no', 'No' ],
1.521     raeburn  3339:                  [ 'default', 'Default - only bubblesheet grading is lenient' ]],
                   3340:      'string_discussvote'
                   3341:              => [['yes','Yes'],
                   3342:                  ['notended','Yes, unless discussion ended'],
                   3343:                  ['no','No']],
1.383     albertel 3344:      );
                   3345: 
1.505     raeburn  3346: sub standard_string_options {
                   3347:     my ($string_type) = @_;
                   3348:     if (ref($strings{$string_type}) eq 'ARRAY') {
                   3349:         return $strings{$string_type};
                   3350:     }
                   3351:     return;
                   3352: }
1.383     albertel 3353: 
                   3354: sub string_selector {
1.522.2.19  raeburn  3355:     my ($thistype, $thiskey, $showval, $name, $readonly) = @_;
1.446     bisitz   3356: 
1.383     albertel 3357:     if (!exists($strings{$thistype})) {
1.522.2.19  raeburn  3358:     return &default_selector($thiskey,$showval,$readonly);
1.383     albertel 3359:     }
                   3360: 
1.504     raeburn  3361:     my %skiptype;
1.514     raeburn  3362:     if (($thistype eq 'string_questiontype') || 
1.519     raeburn  3363:         ($thistype eq 'string_lenient') ||
1.521     raeburn  3364:         ($thistype eq 'string_discussvote') ||
1.519     raeburn  3365:         ($name eq 'retrypartial')) {
1.504     raeburn  3366:         my ($got_chostname,$chostname,$cmajor,$cminor); 
                   3367:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   3368:             next unless (ref($possibilities) eq 'ARRAY');
1.514     raeburn  3369:             my ($parmval, $description) = @{ $possibilities };
                   3370:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval"};
1.504     raeburn  3371:             if ($needsrelease) {
                   3372:                 unless ($got_chostname) {
1.514     raeburn  3373:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.504     raeburn  3374:                     $got_chostname = 1;
                   3375:                 }
1.514     raeburn  3376:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$needsrelease,
1.522.2.14  raeburn  3377:                                                        $cmajor,$cminor);
1.504     raeburn  3378:                 if ($needsnewer) {
1.514     raeburn  3379:                     $skiptype{$parmval} = 1;
1.504     raeburn  3380:                 }
                   3381:             }
                   3382:         }
                   3383:     }
1.522.2.19  raeburn  3384:  
                   3385:     my ($result,$disabled);
1.504     raeburn  3386: 
1.522.2.19  raeburn  3387:     if ($readonly) {
                   3388:         $disabled = ' disabled="disabled"';
                   3389:     }
1.504     raeburn  3390:     my $numinrow = 3;
                   3391:     if ($thistype eq 'string_problemstatus') {
                   3392:         $numinrow = 2;
                   3393:     } elsif ($thistype eq 'string_questiontype') {
                   3394:         if (keys(%skiptype) > 0) {
                   3395:              $numinrow = 4;
                   3396:         }
                   3397:     }
                   3398:     my $rem;
                   3399:     if (ref($strings{$thistype}) eq 'ARRAY') {
                   3400:         my $i=0;
                   3401:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   3402:             next unless (ref($possibilities) eq 'ARRAY');
                   3403:             my ($name, $description) = @{ $possibilities };
                   3404:             next if ($skiptype{$name}); 
                   3405:             $rem = $i%($numinrow);
                   3406:             if ($rem == 0) {
                   3407:                 if ($i > 0) {
                   3408:                     $result .= '</tr>';
                   3409:                 }
                   3410:                 $result .= '<tr>';
                   3411:             }
                   3412:             $result .= '<td class="LC_left_item">'.
                   3413:                        '<span class="LC_nobreak"><label>'.
                   3414:                        '<input type="radio" name="set_'.$thiskey.
1.522.2.19  raeburn  3415:                        '" value="'.$name.'"'.$disabled;
1.504     raeburn  3416:             if ($showval eq $name) {
                   3417:                 $result .= ' checked="checked"';
                   3418:             }
                   3419:             $result .= ' />'.&mt($description).'</label></span></td>';
                   3420:             $i++;
                   3421:         }
                   3422:         $rem = @{ $strings{$thistype} }%($numinrow);
                   3423:         my $colsleft = $numinrow - $rem;
                   3424:         if ($colsleft > 1 ) {
                   3425:             $result .= '<td colspan="'.$colsleft.'" class="LC_left_item">'.
                   3426:                        '&nbsp;</td>';
                   3427:         } elsif ($colsleft == 1) {
                   3428:             $result .= '<td class="LC_left_item">&nbsp;</td>';
                   3429:         }
                   3430:         $result .= '</tr>';
1.473     amueller 3431:     }
1.504     raeburn  3432:     if ($result) {
                   3433:         $result = '<table border="0">'.$result.'</table>';
1.383     albertel 3434:     }
                   3435:     return $result;
                   3436: }
                   3437: 
1.389     www      3438: #
                   3439: # Shift all start and end dates by $shift
                   3440: #
                   3441: 
                   3442: sub dateshift {
                   3443:     my ($shift)=@_;
                   3444:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3445:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3446:     my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   3447: # ugly retro fix for broken version of types
                   3448:     foreach my $key (keys %data) {
                   3449:         if ($key=~/\wtype$/) {
                   3450:             my $newkey=$key;
                   3451:             $newkey=~s/type$/\.type/;
                   3452:             $data{$newkey}=$data{$key};
                   3453:             delete $data{$key};
                   3454:         }
                   3455:     }
1.391     www      3456:     my %storecontent=();
1.389     www      3457: # go through all parameters and look for dates
                   3458:     foreach my $key (keys %data) {
                   3459:        if ($data{$key.'.type'}=~/^date_(start|end)$/) {
                   3460:           my $newdate=$data{$key}+$shift;
1.391     www      3461:           $storecontent{$key}=$newdate;
1.389     www      3462:        }
                   3463:     }
1.391     www      3464:     my $reply=&Apache::lonnet::cput
                   3465:                 ('resourcedata',\%storecontent,$dom,$crs);
                   3466:     if ($reply eq 'ok') {
                   3467:        &log_parmset(\%storecontent);
                   3468:     }
                   3469:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
                   3470:     return $reply;
1.389     www      3471: }
                   3472: 
1.208     www      3473: sub newoverview {
1.522.2.19  raeburn  3474:     my ($r,$parm_permission) = @_;
1.280     albertel 3475: 
1.208     www      3476:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3477:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.522.2.19  raeburn  3478:     my $readonly = 1;
                   3479:     if ($parm_permission->{'edit'}) {
                   3480:         undef($readonly);
                   3481:     }
1.414     droeschl 3482:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 3483:         text=>"Overview Mode"});
1.522.2.2  raeburn  3484: 
                   3485:     my %loaditems = (
                   3486:                       'onload'   => "showHide_courseContent(); resize_scrollbox('mapmenuscroll','1','1');",
                   3487:                     );
                   3488:     my $js = '
                   3489: <script type="text/javascript">
                   3490: // <![CDATA[
                   3491: '.
                   3492:             &Apache::lonhtmlcommon::resize_scrollbox_js('params')."\n".
                   3493:             &showhide_js()."\n".
1.522.2.23.2.  (raeburn 3494:):             &done_proctor_js()."\n".
1.522.2.2  raeburn  3495: '// ]]>
                   3496: </script>
                   3497: ';
                   3498:     my $start_page = &Apache::loncommon::start_page('Set Parameters',$js,
                   3499:                                                     {'add_entries' => \%loaditems,});
1.298     albertel 3500:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      3501:     $r->print($start_page.$breadcrumbs);
1.208     www      3502:     $r->print(<<ENDOVER);
1.232     albertel 3503: <form method="post" action="/adm/parmset?action=newoverview" name="parmform">
1.208     www      3504: ENDOVER
1.211     www      3505:     my @ids=();
                   3506:     my %typep=();
                   3507:     my %keyp=();
                   3508:     my %allparms=();
                   3509:     my %allparts=();
                   3510:     my %allmaps=();
                   3511:     my %mapp=();
                   3512:     my %symbp=();
                   3513:     my %maptitles=();
                   3514:     my %uris=();
                   3515:     my %keyorder=&standardkeyorder();
                   3516:     my %defkeytype=();
                   3517: 
                   3518:     my %alllevs=();
                   3519:     $alllevs{'Resource Level'}='full';
1.215     www      3520:     $alllevs{'Map/Folder Level'}='map';
1.211     www      3521:     $alllevs{'Course Level'}='general';
                   3522: 
                   3523:     my $csec=$env{'form.csec'};
1.269     raeburn  3524:     my $cgroup=$env{'form.cgroup'};
1.211     www      3525: 
                   3526:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   3527:     my $pschp=$env{'form.pschp'};
1.506     www      3528: 
1.211     www      3529:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.522.2.1  raeburn  3530:     if (!@psprt) { $psprt[0]='0'; }
1.211     www      3531: 
1.446     bisitz   3532:     my @selected_sections =
1.473     amueller 3533:     &Apache::loncommon::get_env_multiple('form.Section');
1.211     www      3534:     @selected_sections = ('all') if (! @selected_sections);
1.374     albertel 3535:     foreach my $sec (@selected_sections) {
                   3536:         if ($sec eq 'all') {
1.211     www      3537:             @selected_sections = ('all');
                   3538:         }
                   3539:     }
1.269     raeburn  3540:     my @selected_groups =
                   3541:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      3542: 
                   3543:     my $pssymb='';
                   3544:     my $parmlev='';
1.446     bisitz   3545: 
1.211     www      3546:     unless ($env{'form.parmlev'}) {
                   3547:         $parmlev = 'map';
                   3548:     } else {
                   3549:         $parmlev = $env{'form.parmlev'};
                   3550:     }
                   3551: 
1.446     bisitz   3552:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 3553:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   3554:                 \%keyorder,\%defkeytype);
1.211     www      3555: 
1.374     albertel 3556:     if (grep {$_ eq 'all'} (@psprt)) {
1.481     amueller 3557:         @psprt = keys(%allparts);
1.374     albertel 3558:     }
1.211     www      3559: # Menu to select levels, etc
                   3560: 
1.456     bisitz   3561:     $r->print('<div class="LC_Box">');
1.445     neumanie 3562:     #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452     bisitz   3563:     $r->print('<div>');
1.522.2.2  raeburn  3564:     $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.211     www      3565:     &levelmenu($r,\%alllevs,$parmlev);
                   3566:     if ($parmlev ne 'general') {
1.447     bisitz   3567:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.483     amueller 3568:         &mapmenu($r,\%allmaps,$pschp,\%maptitles,\%symbp);
1.211     www      3569:     }
1.447     bisitz   3570:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 3571:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3572:     $r->print('</div></div>');
1.446     bisitz   3573: 
1.456     bisitz   3574:     $r->print('<div class="LC_Box">');
1.452     bisitz   3575:     $r->print('<div>');
1.510     www      3576:     &displaymenu($r,\%allparms,\@pscat,\%keyorder);
1.453     schualex 3577:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   3578:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.481     amueller 3579:     $r->print('<table>'.
1.317     albertel 3580:               '<tr><th>'.&mt('Parts').'</th><th>'.&mt('Section(s)').
                   3581:               '</th><th>'.&mt('Group(s)').'</th></tr><tr><td>');
1.211     www      3582:     &partmenu($r,\%allparts,\@psprt);
1.317     albertel 3583:     $r->print('</td><td>');
1.211     www      3584:     &sectionmenu($r,\@selected_sections);
1.317     albertel 3585:     $r->print('</td><td>');
1.269     raeburn  3586:     &groupmenu($r,\@selected_groups);
                   3587:     $r->print('</td></tr></table>');
1.445     neumanie 3588:     #$r->print('</td></tr></table>');
1.447     bisitz   3589:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 3590:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3591:     $r->print('</div></div>');
                   3592: 
1.456     bisitz   3593:     $r->print('<div class="LC_Box">');
1.452     bisitz   3594:     $r->print('<div>');
1.214     www      3595:     my $sortorder=$env{'form.sortorder'};
                   3596:     unless ($sortorder) { $sortorder='realmstudent'; }
                   3597:     &sortmenu($r,$sortorder);
1.445     neumanie 3598:     $r->print('</div></div>');
1.446     bisitz   3599: 
1.214     www      3600:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446     bisitz   3601: 
1.211     www      3602: # Build the list data hash from the specified parms
                   3603: 
                   3604:     my $listdata;
                   3605:     %{$listdata}=();
                   3606: 
                   3607:     foreach my $cat (@pscat) {
1.269     raeburn  3608:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   3609:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      3610:     }
                   3611: 
1.212     www      3612:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      3613: 
1.481     amueller 3614:         if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      3615: 
                   3616: # Read modified data
                   3617: 
1.481     amueller 3618:         my $resourcedata=&readdata($crs,$dom);
1.211     www      3619: 
                   3620: # List data
                   3621: 
1.522.2.19  raeburn  3622:         &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview',undef,$readonly);
                   3623:     }
                   3624:     $r->print(&tableend());
                   3625:     unless ($readonly) {
                   3626:         $r->print(((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':''));
1.211     www      3627:     }
1.522.2.19  raeburn  3628:     $r->print('</form>');
1.507     www      3629:     $r->print(&Apache::loncommon::end_page());
1.208     www      3630: }
                   3631: 
1.269     raeburn  3632: sub secgroup_lister {
                   3633:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   3634:     foreach my $item (@{$selections}) {
                   3635:         foreach my $part (@{$psprt}) {
                   3636:             my $rootparmkey=$env{'request.course.id'};
                   3637:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   3638:                 $rootparmkey.='.['.$item.']';
                   3639:             }
                   3640:             if ($parmlev eq 'general') {
                   3641: # course-level parameter
                   3642:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   3643:                 $$listdata{$newparmkey}=1;
                   3644:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   3645:             } elsif ($parmlev eq 'map') {
                   3646: # map-level parameter
                   3647:                 foreach my $mapid (keys %{$allmaps}) {
                   3648:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   3649:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   3650:                     $$listdata{$newparmkey}=1;
                   3651:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   3652:                 }
                   3653:             } else {
                   3654: # resource-level parameter
                   3655:                 foreach my $rid (@{$ids}) {
                   3656:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   3657:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   3658:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   3659:                     $$listdata{$newparmkey}=1;
                   3660:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   3661:                 }
                   3662:             }
                   3663:         }
                   3664:     }
                   3665: }
                   3666: 
1.208     www      3667: sub overview {
1.522.2.19  raeburn  3668:     my ($r,$parm_permission) = @_;
1.208     www      3669:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3670:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.522.2.23.2.  (raeburn 3671:):     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   3672:):     my $js = '<script type="text/javascript">'."\n".
                   3673:):              '// <![CDATA['."\n".
                   3674:):              &done_proctor_js()."\n".
                   3675:):              '// ]]>'."\n".
                   3676:):              '</script>'."\n";
1.522.2.19  raeburn  3677:     my $readonly = 1;
                   3678:     if ($parm_permission->{'edit'}) {
                   3679:         undef($readonly);
                   3680:     }
1.414     droeschl 3681:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 3682:     text=>"Overview Mode"});
1.522.2.23.2.  (raeburn 3683:):     my $start_page=&Apache::loncommon::start_page('Modify Parameters'.$js);
1.298     albertel 3684:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      3685:     $r->print($start_page.$breadcrumbs);
                   3686:     $r->print('<form method="post" action="/adm/parmset?action=setoverview" name="parmform">');
                   3687: 
1.208     www      3688: # Store modified
1.522.2.19  raeburn  3689:     unless ($readonly) {
                   3690:         &storedata($r,$crs,$dom);
                   3691:     }
1.208     www      3692: 
                   3693: # Read modified data
                   3694: 
1.522.2.19  raeburn  3695:     my ($resourcedata,$classlist)=&readdata($crs,$dom);
1.208     www      3696: 
1.214     www      3697: 
                   3698:     my $sortorder=$env{'form.sortorder'};
                   3699:     unless ($sortorder) { $sortorder='realmstudent'; }
                   3700:     &sortmenu($r,$sortorder);
                   3701: 
1.522.2.19  raeburn  3702:     my $submitbutton = '<input type="submit" value="'.&mt('Save').'" />';
                   3703: 
                   3704:     if ($readonly) {
                   3705:         $r->print('<p>'.$submitbutton.'</p>');
                   3706:     }
                   3707: 
                   3708: 
1.208     www      3709: # List data
                   3710: 
1.522.2.19  raeburn  3711:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist,$readonly);
1.208     www      3712: 
1.522.2.19  raeburn  3713:     $r->print(&tableend().'<p>');
                   3714:     if ($foundkeys) {
                   3715:         unless ($readonly) {
                   3716:             $r->print('<p>'.$submitbutton.'</p>');
                   3717:         }
                   3718:     } else {
                   3719:         $r->print('<p class="LC_info">'.&mt('There are no parameters.').'</p>');
                   3720:     }
                   3721:     $r->print('</form>'.&Apache::loncommon::end_page());
1.120     www      3722: }
1.121     www      3723: 
1.333     albertel 3724: sub clean_parameters {
                   3725:     my ($r) = @_;
                   3726:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3727:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3728: 
1.414     droeschl 3729:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
1.473     amueller 3730:         text=>"Clean Parameters"});
1.333     albertel 3731:     my $start_page=&Apache::loncommon::start_page('Clean Parameters');
                   3732:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
                   3733:     $r->print(<<ENDOVER);
                   3734: $start_page
                   3735: $breadcrumbs
                   3736: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
                   3737: ENDOVER
                   3738: # Store modified
                   3739: 
                   3740:     &storedata($r,$crs,$dom);
                   3741: 
                   3742: # Read modified data
                   3743: 
                   3744:     my $resourcedata=&readdata($crs,$dom);
                   3745: 
                   3746: # List data
                   3747: 
                   3748:     $r->print('<h3>'.
1.473     amueller 3749:           &mt('These parameters refer to resources that do not exist.').
                   3750:           '</h3>'.
                   3751:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
                   3752:           '<br />');
1.333     albertel 3753:     $r->print(&Apache::loncommon::start_data_table().
1.473     amueller 3754:           '<tr>'.
                   3755:           '<th>'.&mt('Delete').'</th>'.
                   3756:           '<th>'.&mt('Parameter').'</th>'.
                   3757:           '</tr>');
1.333     albertel 3758:     foreach my $thiskey (sort(keys(%{$resourcedata}))) {
1.473     amueller 3759:     next if (!exists($resourcedata->{$thiskey.'.type'})
                   3760:          && $thiskey=~/\.type$/);
                   3761:     my %data = &parse_key($thiskey);
                   3762:     if (1) { #exists($data{'realm_exists'})
                   3763:         #&& !$data{'realm_exists'}) {
                   3764:         $r->print(&Apache::loncommon::start_data_table_row().
                   3765:               '<tr>'.
                   3766:               '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>'              );
                   3767: 
                   3768:         $r->print('<td>');
                   3769:         my $display_value = $resourcedata->{$thiskey};
                   3770:         if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
                   3771:         $display_value =
                   3772:             &Apache::lonlocal::locallocaltime($display_value);
                   3773:         }
1.470     raeburn  3774:             my $parmitem = &standard_parameter_names($data{'parameter_name'});
                   3775:             $parmitem = &mt($parmitem);
1.473     amueller 3776:         $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
                   3777:               $parmitem,$resourcedata->{$thiskey}));
                   3778:         $r->print('<br />');
                   3779:         if ($data{'scope_type'} eq 'all') {
                   3780:         $r->print(&mt('All users'));
                   3781:         } elsif ($data{'scope_type'} eq 'user') {
                   3782:         $r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
                   3783:         } elsif ($data{'scope_type'} eq 'section') {
                   3784:         $r->print(&mt('Section: [_1]',$data{'scope'}));
                   3785:         } elsif ($data{'scope_type'} eq 'group') {
                   3786:         $r->print(&mt('Group: [_1]',$data{'scope'}));
                   3787:         }
                   3788:         $r->print('<br />');
                   3789:         if ($data{'realm_type'} eq 'all') {
                   3790:         $r->print(&mt('All Resources'));
                   3791:         } elsif ($data{'realm_type'} eq 'folder') {
                   3792:         $r->print(&mt('Folder: [_1]'),$data{'realm'});
                   3793:         } elsif ($data{'realm_type'} eq 'symb') {
                   3794:         my ($map,$resid,$url) =
                   3795:             &Apache::lonnet::decode_symb($data{'realm'});
1.522.2.5  raeburn  3796:         $r->print(&mt('Resource: [_1]with ID: [_2]in folder [_3]',
                   3797:                   $url.' <br />&nbsp;&nbsp;&nbsp;',
                   3798:                   $resid.' <br />&nbsp;&nbsp;&nbsp;',$map));
1.473     amueller 3799:         }
                   3800:         $r->print(' <br />&nbsp;&nbsp;&nbsp;'.&mt('Part: [_1]',$data{'parameter_part'}));
                   3801:         $r->print('</td></tr>');
1.446     bisitz   3802: 
1.473     amueller 3803:     }
1.333     albertel 3804:     }
                   3805:     $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.473     amueller 3806:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.
1.507     www      3807:           '</p></form>');
                   3808:     $r->print(&Apache::loncommon::end_page());
1.333     albertel 3809: }
                   3810: 
1.390     www      3811: sub date_shift_one {
                   3812:     my ($r) = @_;
                   3813:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3814:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3815: 
1.414     droeschl 3816:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 3817:         text=>"Shifting Dates"});
1.390     www      3818:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   3819:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      3820:     $r->print($start_page.$breadcrumbs);
1.522.2.8  raeburn  3821:     $r->print('<form name="shiftform" method="post" action="">'.
1.390     www      3822:               '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
                   3823:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
                   3824:               '<tr><td>'.&mt('Shifted date:').'</td><td>'.
1.522.2.10  raeburn  3825:                     &Apache::lonhtmlcommon::date_setter('shiftform',
1.390     www      3826:                                                         'timeshifted',
                   3827:                                                         $env{'form.timebase'},,
                   3828:                                                         '').
                   3829:               '</td></tr></table>'.
                   3830:               '<input type="hidden" name="action" value="dateshift2" />'.
                   3831:               '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
                   3832:               '<input type="submit" value="'.&mt('Shift all dates accordingly').'" /></form>');
                   3833:     $r->print(&Apache::loncommon::end_page());
                   3834: }
                   3835: 
                   3836: sub date_shift_two {
                   3837:     my ($r) = @_;
                   3838:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3839:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.414     droeschl 3840:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 3841:         text=>"Shifting Dates"});
1.390     www      3842:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   3843:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      3844:     $r->print($start_page.$breadcrumbs);
1.390     www      3845:     my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
1.522.2.13  raeburn  3846:     $r->print('<h2>'.&mt('Shift Dates').'</h2>'.
                   3847:               '<p>'.&mt('Shifting all dates such that [_1] becomes [_2]',
1.390     www      3848:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
1.522.2.13  raeburn  3849:               &Apache::lonlocal::locallocaltime($timeshifted)).'</p>');
1.390     www      3850:     my $delta=$timeshifted-$env{'form.timebase'};
                   3851:     &dateshift($delta);
1.522.2.13  raeburn  3852:     $r->print(
                   3853:         &Apache::lonhtmlcommon::confirm_success(&mt('Done')).
                   3854:         '<br /><br />'.
                   3855:         &Apache::lonhtmlcommon::actionbox(
                   3856:             ['<a href="/adm/parmset">'.&mt('Content and Problem Settings').'</a>']));
1.390     www      3857:     $r->print(&Apache::loncommon::end_page());
                   3858: }
                   3859: 
1.333     albertel 3860: sub parse_key {
                   3861:     my ($key) = @_;
                   3862:     my %data;
                   3863:     my ($middle,$part,$name)=
1.473     amueller 3864:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.333     albertel 3865:     $data{'scope_type'} = 'all';
                   3866:     if ($middle=~/^\[(.*)\]/) {
1.473     amueller 3867:            $data{'scope'} = $1;
                   3868:     if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
                   3869:         $data{'scope_type'} = 'user';
                   3870:         $data{'scope'} = [$1,$2];
                   3871:     } else {
                   3872:         #FIXME check for group scope
                   3873:         $data{'scope_type'} = 'section';
                   3874:     }
                   3875:     $middle=~s/^\[(.*)\]//;
1.333     albertel 3876:     }
                   3877:     $middle=~s/\.+$//;
                   3878:     $middle=~s/^\.+//;
                   3879:     $data{'realm_type'}='all';
                   3880:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.473     amueller 3881:     $data{'realm'} = $1;
                   3882:     $data{'realm_type'} = 'folder';
                   3883:     $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   3884:     ($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
1.333     albertel 3885:     } elsif ($middle) {
1.473     amueller 3886:     $data{'realm'} = $middle;
                   3887:     $data{'realm_type'} = 'symb';
                   3888:     $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   3889:     my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
                   3890:     $data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
1.333     albertel 3891:     }
1.446     bisitz   3892: 
1.333     albertel 3893:     $data{'parameter_part'} = $part;
                   3894:     $data{'parameter_name'} = $name;
                   3895: 
                   3896:     return %data;
                   3897: }
                   3898: 
1.239     raeburn  3899: 
1.416     jms      3900: sub header {
1.522.2.3  raeburn  3901:     return &Apache::loncommon::start_page('Content and Problem Settings');
1.416     jms      3902: }
1.193     albertel 3903: 
                   3904: 
                   3905: 
                   3906: sub print_main_menu {
                   3907:     my ($r,$parm_permission)=@_;
                   3908:     #
1.414     droeschl 3909:     $r->print(&header());
1.522.2.3  raeburn  3910:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Content and Problem Settings'));
1.522.2.19  raeburn  3911:     my $crstype = &Apache::loncommon::course_type();
                   3912:     my $lc_crstype = lc($crstype);
                   3913: 
1.193     albertel 3914:     $r->print(<<ENDMAINFORMHEAD);
                   3915: <form method="post" enctype="multipart/form-data"
                   3916:       action="/adm/parmset" name="studentform">
                   3917: ENDMAINFORMHEAD
                   3918: #
1.195     albertel 3919:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3920:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 3921:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366     albertel 3922:     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.520     raeburn  3923:     my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});
1.522.2.19  raeburn  3924:     my $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'});
                   3925:     my $vpa = &Apache::lonnet::allowed('vpa',$env{'request.course.id'});
1.520     raeburn  3926:     if ((!$dcm) && ($env{'request.course.sec'} ne '')) {
                   3927:         $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.
                   3928:                                         '/'.$env{'request.course.sec'});
                   3929:     }
1.522.2.19  raeburn  3930:     if ((!$vcb) && ($env{'request.course.sec'} ne '')) {
                   3931:         $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'}.
                   3932:                                         '/'.$env{'request.course.sec'});
                   3933:     }
                   3934:     my (%linktext,%linktitle,%url);
                   3935:     if ($parm_permission->{'edit'}) {
                   3936:         %linktext = (
                   3937:                      newoverview     => 'Edit Resource Parameters - Overview Mode',
                   3938:                      settable        => 'Edit Resource Parameters - Table Mode',
                   3939:                      setoverview     => 'Modify Resource Parameters - Overview Mode',
                   3940:                     );
                   3941:         %linktitle = (
                   3942:                      newoverview     => 'Set/Modify resource parameters in overview mode.',
                   3943:                      settable        => 'Set/Modify resource parameters in table mode.',
                   3944:                      setoverview     => 'Set/Modify existing resource parameters in overview mode.',
                   3945:                      );
                   3946:     } else {
                   3947:         %linktext = (
                   3948:                      newoverview     => 'View Resource Parameters - Overview Mode',
                   3949:                      settable        => 'View Resource Parameters - Table Mode',
                   3950:                      setoverview     => 'View Resource Parameters - Overview Mode',
                   3951:                    );
                   3952:         %linktitle = (
                   3953:                      newoverview     => 'Display resource parameters in overview mode.',
                   3954:                      settable        => 'Display resource parameters in table mode.',
                   3955:                      setoverview     => 'Display existing resource parameters in overview mode.',
                   3956:                      );
                   3957:     }
                   3958:     if ($mgr) {
                   3959:         $linktext{'resettimes'} = 'Reset Student Access Times';
                   3960:         $linktitle{'resettimes'} = "Reset access times for folders/maps, resources or the $lc_crstype.";
                   3961:         $url{'resettimes'} = '/adm/helper/resettimes.helper';
                   3962:     } elsif ($vgr) {
                   3963:         $linktext{'resettimes'} = 'Display Student Access Times',
                   3964:         $linktitle{'resettimes'} = "Display access times for folders/maps, resources or the $lc_crstype.",
                   3965:         $url{'resettimes'} = '/adm/accesstimes';
                   3966:     }
1.193     albertel 3967:     my @menu =
1.507     www      3968:         ( { categorytitle=>"Content Settings for this $crstype",
1.473     amueller 3969:         items => [
                   3970:           { linktext => 'Portfolio Metadata',
                   3971:             url => '/adm/parmset?action=setrestrictmeta',
1.522.2.19  raeburn  3972:             permission => $parm_permission->{'setrestrictmeta'},
1.477     raeburn  3973:             linktitle => "Restrict metadata for this $lc_crstype." ,
1.473     amueller 3974:             icon =>'contact-new.png'   ,
                   3975:             },
1.522.2.19  raeburn  3976:           { linktext => $linktext{'resettimes'},
                   3977:             url => $url{'resettimes'},
1.522.2.20  raeburn  3978:             permission => ($vgr || $mgr),
1.522.2.19  raeburn  3979:             linktitle => $linktitle{'resettimes'},
                   3980:             icon => 'start-here.png',
1.473     amueller 3981:             },
1.520     raeburn  3982:           { linktext => 'Blocking Communication/Resource Access',
                   3983:             url => '/adm/setblock',
1.522.2.19  raeburn  3984:             permission => ($vcb || $dcm),
1.520     raeburn  3985:             linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',
                   3986:             icon => 'comblock.png',
                   3987:             },
1.473     amueller 3988:           { linktext => 'Set Parameter Setting Default Actions',
                   3989:             url => '/adm/parmset?action=setdefaults',
1.522.2.19  raeburn  3990:             permission => $parm_permission->{'setdefaults'},
1.473     amueller 3991:             linktitle =>'Set default actions for parameters.'  ,
                   3992:             icon => 'folder-new.png'  ,
                   3993:             }]},
                   3994:       { categorytitle => 'New and Existing Parameter Settings for Resources',
                   3995:         items => [
                   3996:           { linktext => 'Edit Resource Parameters - Helper Mode',
                   3997:             url => '/adm/helper/parameter.helper',
1.522.2.19  raeburn  3998:             permission => $parm_permission->{'helper'},
1.473     amueller 3999:             linktitle =>'Set/Modify resource parameters in helper mode.'  ,
                   4000:             icon => 'dialog-information.png'  ,
                   4001:             #help => 'Parameter_Helper',
                   4002:             },
1.522.2.19  raeburn  4003:           { linktext => $linktext{'newoverview'},
1.473     amueller 4004:             url => '/adm/parmset?action=newoverview',
1.522.2.19  raeburn  4005:             permission => $parm_permission->{'newoverview'},
                   4006:             linktitle => $linktitle{'newoverview'},
                   4007:             icon => 'edit-find.png',
1.473     amueller 4008:             #help => 'Parameter_Overview',
                   4009:             },
1.522.2.19  raeburn  4010:           { linktext => $linktext{'settable'},
1.473     amueller 4011:             url => '/adm/parmset?action=settable',
1.522.2.19  raeburn  4012:             permission => $parm_permission->{'settable'},
                   4013:             linktitle => $linktitle{'settable'},
                   4014:             icon => 'edit-copy.png',
1.473     amueller 4015:             #help => 'Table_Mode',
                   4016:             }]},
1.417     droeschl 4017:            { categorytitle => 'Existing Parameter Settings for Resources',
1.473     amueller 4018:          items => [
1.522.2.19  raeburn  4019:           { linktext => $linktext{'setoverview'},
1.473     amueller 4020:             url => '/adm/parmset?action=setoverview',
1.522.2.19  raeburn  4021:             permission => $parm_permission->{'setoverview'},
                   4022:             linktitle => $linktitle{'setoverview'},
                   4023:             icon => 'preferences-desktop-wallpaper.png',
1.473     amueller 4024:             #help => 'Parameter_Overview',
                   4025:             },
                   4026:           { linktext => 'Change Log',
                   4027:             url => '/adm/parmset?action=parameterchangelog',
1.522.2.19  raeburn  4028:             permission => $parm_permission->{'parameterchangelog'},
1.477     raeburn  4029:             linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,
1.487     wenzelju 4030:             icon => 'document-properties.png',
1.473     amueller 4031:             }]}
1.193     albertel 4032:           );
1.414     droeschl 4033:     $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.522.2.8  raeburn  4034:     $r->print('</form>'.&Apache::loncommon::end_page());
1.193     albertel 4035:     return;
                   4036: }
1.414     droeschl 4037: 
1.416     jms      4038: 
                   4039: 
1.252     banghart 4040: sub output_row {
1.347     banghart 4041:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 4042:     my $output;
1.263     banghart 4043:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   4044:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 4045:     if (!defined($options)) {
1.254     banghart 4046:         $options = 'active,stuadd';
1.261     banghart 4047:         $values = '';
1.252     banghart 4048:     }
1.337     banghart 4049:     if (!($options =~ /deleted/)) {
                   4050:         my @options= ( ['active', 'Show to student'],
1.418     schafran 4051:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 4052:                     ['choices','Provide choices for students to select from']);
1.473     amueller 4053: #           ['onlyone','Student may select only one choice']);
1.337     banghart 4054:         if ($added_flag) {
                   4055:             push @options,['deleted', 'Delete Metadata Field'];
                   4056:         }
1.351     banghart 4057:        $output = &Apache::loncommon::start_data_table_row();
1.451     bisitz   4058:         $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351     banghart 4059:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 4060:         foreach my $opt (@options) {
1.473     amueller 4061:         my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   4062:         $output .= &Apache::loncommon::continue_data_table_row();
                   4063:         $output .= '<td>'.('&nbsp;' x 5).'<label>
                   4064:                    <input type="checkbox" name="'.
                   4065:                    $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   4066:                    &mt($opt->[1]).'</label></td>';
                   4067:         $output .= &Apache::loncommon::end_data_table_row();
                   4068:     }
1.351     banghart 4069:         $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   4070:         $output .= '<td>'.('&nbsp;' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351     banghart 4071:         $output .= &Apache::loncommon::end_data_table_row();
                   4072:         my $multiple_checked;
                   4073:         my $single_checked;
                   4074:         if ($options =~ m/onlyone/) {
1.422     bisitz   4075:             $multiple_checked = '';
1.423     bisitz   4076:             $single_checked = ' checked="checked"';
1.351     banghart 4077:         } else {
1.423     bisitz   4078:             $multiple_checked = ' checked="checked"';
1.422     bisitz   4079:             $single_checked = '';
1.351     banghart 4080:         }
1.473     amueller 4081:     $output .= &Apache::loncommon::continue_data_table_row();
                   4082:     $output .= '<td>'.('&nbsp;' x 10).'
                   4083:                 <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
                   4084:                 '.&mt('Student may select multiple choices from list').'</td>';
                   4085:     $output .= &Apache::loncommon::end_data_table_row();
                   4086:     $output .= &Apache::loncommon::continue_data_table_row();
                   4087:     $output .= '<td>'.('&nbsp;' x 10).'
                   4088:                 <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />
                   4089:                 '.&mt('Student may select only one choice from list').'</td>';
                   4090:     $output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 4091:     }
                   4092:     return ($output);
                   4093: }
1.416     jms      4094: 
                   4095: 
                   4096: 
1.340     banghart 4097: sub order_meta_fields {
                   4098:     my ($r)=@_;
                   4099:     my $idx = 1;
                   4100:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4101:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.341     banghart 4102:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.414     droeschl 4103:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 4104:         text=>"Add Metadata Field"});
1.345     banghart 4105:     &Apache::lonhtmlcommon::add_breadcrumb
                   4106:             ({href=>"/adm/parmset?action=setrestrictmeta",
                   4107:               text=>"Restrict Metadata"},
                   4108:              {text=>"Order Metadata"});
                   4109:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.340     banghart 4110:     if ($env{'form.storeorder'}) {
                   4111:         my $newpos = $env{'form.newpos'} - 1;
                   4112:         my $currentpos = $env{'form.currentpos'} - 1;
                   4113:         my @neworder = ();
                   4114:         my @oldorder = split /,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'};
                   4115:         my $i;
1.341     banghart 4116:         if ($newpos > $currentpos) {
1.340     banghart 4117:         # moving stuff up
                   4118:             for ($i=0;$i<$currentpos;$i++) {
1.473     amueller 4119:             $neworder[$i]=$oldorder[$i];
1.340     banghart 4120:             }
                   4121:             for ($i=$currentpos;$i<$newpos;$i++) {
1.473     amueller 4122:             $neworder[$i]=$oldorder[$i+1];
1.340     banghart 4123:             }
                   4124:             $neworder[$newpos]=$oldorder[$currentpos];
                   4125:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
1.473     amueller 4126:             $neworder[$i]=$oldorder[$i];
1.340     banghart 4127:             }
                   4128:         } else {
                   4129:         # moving stuff down
1.473     amueller 4130:             for ($i=0;$i<$newpos;$i++) {
                   4131:                 $neworder[$i]=$oldorder[$i];
                   4132:             }
                   4133:             $neworder[$newpos]=$oldorder[$currentpos];
                   4134:             for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   4135:                 $neworder[$i]=$oldorder[$i-1];
                   4136:             }
                   4137:             for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   4138:                 $neworder[$i]=$oldorder[$i];
                   4139:             }
1.340     banghart 4140:         }
1.473     amueller 4141:     my $ordered_fields = join ",", @neworder;
1.343     banghart 4142:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   4143:                            {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
1.473     amueller 4144:     &Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 4145:     }
1.357     raeburn  4146:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 4147:     my $ordered_fields;
1.340     banghart 4148:     my @fields_in_order = split /,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'};
                   4149:     if (!@fields_in_order) {
                   4150:         # no order found, pick sorted order then create metadata.addedorder key.
                   4151:         foreach my $key (sort keys %$fields) {
                   4152:             push @fields_in_order, $key;
1.341     banghart 4153:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 4154:         }
1.341     banghart 4155:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   4156:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   4157:     }
1.340     banghart 4158:     $r->print('<table>');
                   4159:     my $num_fields = scalar(@fields_in_order);
                   4160:     foreach my $key (@fields_in_order) {
                   4161:         $r->print('<tr><td>');
                   4162:         $r->print('<form method="post" action="">');
1.522.2.8  raeburn  4163:         $r->print('<select name="newpos" onchange="this.form.submit()">');
1.340     banghart 4164:         for (my $i = 1;$i le $num_fields;$i ++) {
                   4165:             if ($i eq $idx) {
                   4166:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   4167:             } else {
                   4168:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   4169:             }
                   4170:         }
                   4171:         $r->print('</select></td><td>');
                   4172:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   4173:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   4174:         $r->print('</form>');
                   4175:         $r->print($$fields{$key}.'</td></tr>');
                   4176:         $idx ++;
                   4177:     }
                   4178:     $r->print('</table>');
                   4179:     return 'ok';
                   4180: }
1.416     jms      4181: 
                   4182: 
1.359     banghart 4183: sub continue {
                   4184:     my $output;
                   4185:     $output .= '<form action="" method="post">';
                   4186:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
                   4187:     $output .= '<input type="submit" value="Continue" />';
                   4188:     return ($output);
                   4189: }
1.416     jms      4190: 
                   4191: 
1.334     banghart 4192: sub addmetafield {
                   4193:     my ($r)=@_;
1.414     droeschl 4194:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 4195:         text=>"Add Metadata Field"});
1.334     banghart 4196:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   4197:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 4198:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4199:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.339     banghart 4200:     if (exists($env{'form.undelete'})) {
1.358     banghart 4201:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 4202:         foreach my $meta_field(@meta_fields) {
                   4203:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   4204:             $options =~ s/deleted//;
                   4205:             $options =~ s/,,/,/;
                   4206:             my $put_result = &Apache::lonnet::put('environment',
                   4207:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446     bisitz   4208: 
1.339     banghart 4209:             $r->print('Undeleted Metadata Field <strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}."</strong> with result ".$put_result.'<br />');
                   4210:         }
1.359     banghart 4211:         $r->print(&continue());
1.339     banghart 4212:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 4213:         my $meta_field = $env{'form.fieldname'};
                   4214:         my $display_field = $env{'form.fieldname'};
                   4215:         $meta_field =~ s/\W/_/g;
1.338     banghart 4216:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 4217:         my $put_result = &Apache::lonnet::put('environment',
                   4218:                             {'metadata.'.$meta_field.'.values'=>"",
                   4219:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   4220:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.359     banghart 4221:         $r->print('Added new Metadata Field <strong>'.$env{'form.fieldname'}."</strong> with result ".$put_result.'<br />');
                   4222:         $r->print(&continue());
1.335     banghart 4223:     } else {
1.357     raeburn  4224:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 4225:         if ($fields) {
                   4226:             $r->print('You may undelete previously deleted fields.<br />Check those you wish to undelete and click Undelete.<br />');
                   4227:             $r->print('<form method="post" action="">');
                   4228:             foreach my $key(keys(%$fields)) {
1.358     banghart 4229:                 $r->print('<input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'<br /');
1.339     banghart 4230:             }
                   4231:             $r->print('<input type="submit" name="undelete" value="Undelete" />');
                   4232:             $r->print('</form>');
                   4233:         }
1.522.2.23  raeburn  4234:         $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 4235:         $r->print('<input type="text" name="fieldname" /><br />');
                   4236:         $r->print('<input type="submit" value="Add Metadata Field" />');
1.334     banghart 4237:     }
1.361     albertel 4238:     $r->print('</form>');
1.334     banghart 4239: }
1.416     jms      4240: 
                   4241: 
                   4242: 
1.259     banghart 4243: sub setrestrictmeta {
1.240     banghart 4244:     my ($r)=@_;
1.242     banghart 4245:     my $next_meta;
1.244     banghart 4246:     my $output;
1.245     banghart 4247:     my $item_num;
1.246     banghart 4248:     my $put_result;
1.414     droeschl 4249:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
1.473     amueller 4250:         text=>"Restrict Metadata"});
1.280     albertel 4251:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 4252:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 4253:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4254:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.259     banghart 4255:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 4256:     my $save_field = '';
1.259     banghart 4257:     if ($env{'form.restrictmeta'}) {
1.254     banghart 4258:         foreach my $field (sort(keys(%env))) {
1.252     banghart 4259:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 4260:                 my $options;
1.252     banghart 4261:                 my $meta_field = $1;
                   4262:                 my $meta_key = $2;
1.253     banghart 4263:                 if ($save_field ne $meta_field) {
1.252     banghart 4264:                     $save_field = $meta_field;
1.473     amueller 4265:                     if ($env{'form.'.$meta_field.'_stuadd'}) {
                   4266:                         $options.='stuadd,';
                   4267:                     }
                   4268:                     if ($env{'form.'.$meta_field.'_choices'}) {
                   4269:                         $options.='choices,';
                   4270:                     }
                   4271:                     if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
                   4272:                         $options.='onlyone,';
                   4273:                     }
                   4274:                     if ($env{'form.'.$meta_field.'_active'}) {
                   4275:                         $options.='active,';
                   4276:                     }
                   4277:                     if ($env{'form.'.$meta_field.'_deleted'}) {
                   4278:                         $options.='deleted,';
                   4279:                     }
1.259     banghart 4280:                     my $name = $save_field;
1.253     banghart 4281:                      $put_result = &Apache::lonnet::put('environment',
1.262     banghart 4282:                                                   {'metadata.'.$meta_field.'.options'=>$options,
                   4283:                                                    'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
1.253     banghart 4284:                                                    },$dom,$crs);
1.252     banghart 4285:                 }
                   4286:             }
                   4287:         }
                   4288:     }
1.296     albertel 4289:     &Apache::lonnet::coursedescription($env{'request.course.id'},
1.473     amueller 4290:                        {'freshen_cache' => 1});
1.335     banghart 4291:     # Get the default metadata fields
1.258     albertel 4292:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 4293:     # Now get possible added metadata fields
1.357     raeburn  4294:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.346     banghart 4295:     my $row_alt = 1;
1.347     banghart 4296:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 4297:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 4298:         if ($field ne 'courserestricted') {
1.346     banghart 4299:             $row_alt = $row_alt ? 0 : 1;
1.473     amueller 4300:         $output.= &output_row($r, $field, $metadata_fields{$field});
                   4301:     }
1.255     banghart 4302:     }
1.351     banghart 4303:     my $buttons = (<<ENDButtons);
                   4304:         <input type="submit" name="restrictmeta" value="Save" />
                   4305:         </form><br />
                   4306:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
                   4307:         <input type="submit" name="restrictmeta" value="Add a Metadata Field" />
                   4308:         </form>
                   4309:         <br />
                   4310:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
                   4311:         <input type="submit" name="restrictmeta" value="Order Metadata Fields" />
                   4312: ENDButtons
1.337     banghart 4313:     my $added_flag = 1;
1.335     banghart 4314:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.346     banghart 4315:         $row_alt = $row_alt ? 0 : 1;
                   4316:         $output.= &output_row($r, $field, $$added_metadata_fields{$field},$added_flag, $row_alt);
1.335     banghart 4317:     }
1.347     banghart 4318:     $output .= &Apache::loncommon::end_data_table();
1.446     bisitz   4319:     $r->print(<<ENDenv);
1.259     banghart 4320:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 4321:         $output
1.351     banghart 4322:         $buttons
1.340     banghart 4323:         </form>
1.244     banghart 4324: ENDenv
1.280     albertel 4325:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 4326:     return 'ok';
                   4327: }
1.416     jms      4328: 
                   4329: 
                   4330: 
1.335     banghart 4331: sub get_added_meta_fieldnames {
1.357     raeburn  4332:     my ($cid) = @_;
1.335     banghart 4333:     my %fields;
                   4334:     foreach my $key(%env) {
1.357     raeburn  4335:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 4336:             my $field_name = $1;
                   4337:             my ($display_field_name) = $env{$key};
                   4338:             $fields{$field_name} = $display_field_name;
                   4339:         }
                   4340:     }
                   4341:     return \%fields;
                   4342: }
1.416     jms      4343: 
                   4344: 
                   4345: 
1.339     banghart 4346: sub get_deleted_meta_fieldnames {
1.357     raeburn  4347:     my ($cid) = @_;
1.339     banghart 4348:     my %fields;
                   4349:     foreach my $key(%env) {
1.357     raeburn  4350:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 4351:             my $field_name = $1;
                   4352:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   4353:                 my ($display_field_name) = $env{$key};
                   4354:                 $fields{$field_name} = $display_field_name;
                   4355:             }
                   4356:         }
                   4357:     }
                   4358:     return \%fields;
                   4359: }
1.220     www      4360: sub defaultsetter {
1.280     albertel 4361:     my ($r) = @_;
                   4362: 
1.414     droeschl 4363:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
1.473     amueller 4364:         text=>"Set Defaults"});
1.446     bisitz   4365:     my $start_page =
1.473     amueller 4366:     &Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 4367:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.507     www      4368:     $r->print($start_page.$breadcrumbs);
                   4369:     $r->print('<form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">');
1.280     albertel 4370: 
                   4371:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4372:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.221     www      4373:     my @ids=();
                   4374:     my %typep=();
                   4375:     my %keyp=();
                   4376:     my %allparms=();
                   4377:     my %allparts=();
                   4378:     my %allmaps=();
                   4379:     my %mapp=();
                   4380:     my %symbp=();
                   4381:     my %maptitles=();
                   4382:     my %uris=();
                   4383:     my %keyorder=&standardkeyorder();
                   4384:     my %defkeytype=();
                   4385: 
1.446     bisitz   4386:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 4387:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   4388:                 \%keyorder,\%defkeytype);
1.224     www      4389:     if ($env{'form.storerules'}) {
1.473     amueller 4390:     my %newrules=();
                   4391:     my @delrules=();
                   4392:     my %triggers=();
                   4393:     foreach my $key (keys(%env)) {
1.225     albertel 4394:             if ($key=~/^form\.(\w+)\_action$/) {
1.473     amueller 4395:         my $tempkey=$1;
                   4396:         my $action=$env{$key};
1.226     www      4397:                 if ($action) {
1.473     amueller 4398:             $newrules{$tempkey.'_action'}=$action;
                   4399:             if ($action ne 'default') {
                   4400:             my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   4401:             $triggers{$whichparm}.=$tempkey.':';
                   4402:             }
                   4403:             $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
                   4404:             if (&isdateparm($defkeytype{$tempkey})) {
                   4405:             $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
                   4406:             $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   4407:             $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   4408:             $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   4409:             } else {
                   4410:             $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
                   4411:             $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
                   4412:             }
                   4413:         } else {
                   4414:             push(@delrules,$tempkey.'_action');
                   4415:             push(@delrules,$tempkey.'_type');
                   4416:             push(@delrules,$tempkey.'_hours');
                   4417:             push(@delrules,$tempkey.'_min');
                   4418:             push(@delrules,$tempkey.'_sec');
                   4419:             push(@delrules,$tempkey.'_value');
                   4420:         }
                   4421:         }
                   4422:     }
                   4423:     foreach my $key (keys %allparms) {
                   4424:         $newrules{$key.'_triggers'}=$triggers{$key};
                   4425:     }
                   4426:     &Apache::lonnet::put('parmdefactions',\%newrules,$dom,$crs);
                   4427:     &Apache::lonnet::del('parmdefactions',\@delrules,$dom,$crs);
                   4428:     &resetrulescache();
1.224     www      4429:     }
1.227     www      4430:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
1.473     amueller 4431:                        'hours' => 'Hours',
                   4432:                        'min' => 'Minutes',
                   4433:                        'sec' => 'Seconds',
                   4434:                        'yes' => 'Yes',
                   4435:                        'no' => 'No');
1.222     www      4436:     my @standardoptions=('','default');
                   4437:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   4438:     my @dateoptions=('','default');
                   4439:     my @datedisplay=('',&mt('Default value when manually setting'));
                   4440:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.473     amueller 4441:     unless ($tempkey) { next; }
                   4442:     push @standardoptions,'when_setting_'.$tempkey;
                   4443:     push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   4444:     if (&isdateparm($defkeytype{$tempkey})) {
                   4445:         push @dateoptions,'later_than_'.$tempkey;
                   4446:         push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   4447:         push @dateoptions,'earlier_than_'.$tempkey;
                   4448:         push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   4449:     }
1.222     www      4450:     }
1.231     www      4451: $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
1.473     amueller 4452:       &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 4453:     $r->print("\n".&Apache::loncommon::start_data_table().
1.473     amueller 4454:           &Apache::loncommon::start_data_table_header_row().
                   4455:           "<th>".&mt('Rule for parameter').'</th><th>'.
                   4456:           &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   4457:           &Apache::loncommon::end_data_table_header_row());
1.221     www      4458:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.473     amueller 4459:     unless ($tempkey) { next; }
                   4460:     $r->print("\n".&Apache::loncommon::start_data_table_row().
                   4461:           "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
                   4462:     my $action=&rulescache($tempkey.'_action');
                   4463:     $r->print('<select name="'.$tempkey.'_action">');
                   4464:     if (&isdateparm($defkeytype{$tempkey})) {
                   4465:         for (my $i=0;$i<=$#dateoptions;$i++) {
                   4466:         if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   4467:         $r->print("\n<option value='$dateoptions[$i]'".
                   4468:               ($dateoptions[$i] eq $action?' selected="selected"':'').
                   4469:               ">$datedisplay[$i]</option>");
                   4470:         }
                   4471:     } else {
                   4472:         for (my $i=0;$i<=$#standardoptions;$i++) {
                   4473:         if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   4474:         $r->print("\n<option value='$standardoptions[$i]'".
                   4475:               ($standardoptions[$i] eq $action?' selected="selected"':'').
                   4476:               ">$standarddisplay[$i]</option>");
                   4477:         }
                   4478:     }
                   4479:     $r->print('</select>');
                   4480:     unless (&isdateparm($defkeytype{$tempkey})) {
                   4481:         $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   4482:               '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
                   4483:     }
                   4484:     $r->print("\n</td><td>\n");
1.222     www      4485: 
1.221     www      4486:         if (&isdateparm($defkeytype{$tempkey})) {
1.473     amueller 4487:         my $days=&rulescache($tempkey.'_days');
                   4488:         my $hours=&rulescache($tempkey.'_hours');
                   4489:         my $min=&rulescache($tempkey.'_min');
                   4490:         my $sec=&rulescache($tempkey.'_sec');
                   4491:         $r->print(<<ENDINPUTDATE);
1.227     www      4492: <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
1.222     www      4493: <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   4494: <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   4495: <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.221     www      4496: ENDINPUTDATE
1.473     amueller 4497:     } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
1.222     www      4498:             my $yeschecked='';
                   4499:             my $nochecked='';
1.444     bisitz   4500:             if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   4501:             if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
1.222     www      4502: 
1.473     amueller 4503:         $r->print(<<ENDYESNO);
1.444     bisitz   4504: <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   4505: <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.221     www      4506: ENDYESNO
                   4507:         } else {
1.473     amueller 4508:         $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
                   4509:     }
1.318     albertel 4510:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      4511:     }
1.318     albertel 4512:     $r->print(&Apache::loncommon::end_data_table().
1.473     amueller 4513:           "\n".'<input type="submit" name="storerules" value="'.
1.507     www      4514:           &mt('Save').'" /></form>'."\n");
                   4515:     $r->print(&Apache::loncommon::end_page());
1.220     www      4516:     return;
                   4517: }
1.193     albertel 4518: 
1.290     www      4519: sub components {
1.330     albertel 4520:     my ($key,$uname,$udom,$exeuser,$exedomain,$typeflag)=@_;
                   4521: 
                   4522:     if ($typeflag) {
1.473     amueller 4523:     $key=~s/\.type$//;
1.290     www      4524:     }
1.330     albertel 4525: 
                   4526:     my ($middle,$part,$name)=
1.473     amueller 4527:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.291     www      4528:     my $issection;
1.330     albertel 4529: 
1.290     www      4530:     my $section=&mt('All Students');
                   4531:     if ($middle=~/^\[(.*)\]/) {
1.473     amueller 4532:     $issection=$1;
                   4533:     $section=&mt('Group/Section').': '.$issection;
                   4534:     $middle=~s/^\[(.*)\]//;
1.290     www      4535:     }
                   4536:     $middle=~s/\.+$//;
                   4537:     $middle=~s/^\.+//;
1.291     www      4538:     if ($uname) {
1.473     amueller 4539:     $section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   4540:     $issection='';
1.291     www      4541:     }
1.316     albertel 4542:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446     bisitz   4543:     my $realmdescription=&mt('all resources');
1.290     www      4544:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.473     amueller 4545:     $realm='<span class="LC_parm_scope_folder">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <span class="LC_parm_folder"><br />('.$1.')</span></span>';
                   4546:      $realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($1);
1.304     www      4547:    } elsif ($middle) {
1.473     amueller 4548:     my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   4549:     $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.' in '.$map.' id: '.$id.')</span></span>';
                   4550:     $realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      4551:     }
1.291     www      4552:     my $what=$part.'.'.$name;
1.330     albertel 4553:     return ($realm,$section,$name,$part,
1.473     amueller 4554:         $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      4555: }
1.293     www      4556: 
1.328     albertel 4557: my %standard_parms;
1.469     raeburn  4558: my %standard_parms_types;
1.416     jms      4559: 
1.328     albertel 4560: sub load_parameter_names {
                   4561:     open(my $config,"<$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
                   4562:     while (my $configline=<$config>) {
1.473     amueller 4563:     if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   4564:     chomp($configline);
                   4565:     my ($short,$plain)=split(/:/,$configline);
                   4566:     my (undef,$name,$type)=split(/\&/,$short,3);
                   4567:     if ($type eq 'display') {
                   4568:         $standard_parms{$name} = $plain;
1.469     raeburn  4569:         } elsif ($type eq 'type') {
                   4570:             $standard_parms_types{$name} = $plain;
                   4571:         }
1.328     albertel 4572:     }
                   4573:     close($config);
                   4574:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   4575:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
                   4576: }
                   4577: 
1.292     www      4578: sub standard_parameter_names {
                   4579:     my ($name)=@_;
1.328     albertel 4580:     if (!%standard_parms) {
1.473     amueller 4581:     &load_parameter_names();
1.328     albertel 4582:     }
1.292     www      4583:     if ($standard_parms{$name}) {
1.473     amueller 4584:     return $standard_parms{$name};
1.446     bisitz   4585:     } else {
1.473     amueller 4586:     return $name;
1.292     www      4587:     }
                   4588: }
1.290     www      4589: 
1.469     raeburn  4590: sub standard_parameter_types {
                   4591:     my ($name)=@_;
                   4592:     if (!%standard_parms_types) {
                   4593:         &load_parameter_names();
                   4594:     }
                   4595:     if ($standard_parms_types{$name}) {
                   4596:         return $standard_parms_types{$name};
                   4597:     }
                   4598:     return;
                   4599: }
1.309     www      4600: 
1.285     albertel 4601: sub parm_change_log {
1.522.2.19  raeburn  4602:     my ($r,$parm_permission)=@_;
1.414     droeschl 4603:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.473     amueller 4604:     text=>"Parameter Change Log"});
1.522     raeburn  4605:     my $js = '<script type="text/javascript">'."\n".
                   4606:              '// <![CDATA['."\n".
                   4607:              &Apache::loncommon::display_filter_js('parmslog')."\n".
                   4608:              '// ]]>'."\n".
                   4609:              '</script>'."\n";
                   4610:     $r->print(&Apache::loncommon::start_page('Parameter Change Log',$js));
1.327     albertel 4611:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
1.286     www      4612:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',
1.473     amueller 4613:                       $env{'course.'.$env{'request.course.id'}.'.domain'},
                   4614:                       $env{'course.'.$env{'request.course.id'}.'.num'});
1.311     albertel 4615: 
1.301     www      4616:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 4617: 
1.522     raeburn  4618:     $r->print('<div class="LC_left_float">'.
                   4619:               '<fieldset><legend>'.&mt('Display of Changes').'</legend>'.
                   4620:               '<form action="/adm/parmset?action=parameterchangelog"
1.327     albertel 4621:                      method="post" name="parameterlog">');
1.446     bisitz   4622: 
1.311     albertel 4623:     my %saveable_parameters = ('show' => 'scalar',);
                   4624:     &Apache::loncommon::store_course_settings('parameter_log',
                   4625:                                               \%saveable_parameters);
                   4626:     &Apache::loncommon::restore_course_settings('parameter_log',
                   4627:                                                 \%saveable_parameters);
1.522     raeburn  4628:     $r->print(&Apache::loncommon::display_filter('parmslog').'&nbsp;'."\n".
                   4629:               '<input type="submit" value="'.&mt('Display').'" />'.
                   4630:               '</form></fieldset></div><br clear="all" />');
1.522.2.19  raeburn  4631:     my $readonly = 1;
                   4632:     if ($parm_permission->{'edit'}) {
                   4633:         undef($readonly);
                   4634:     }
1.291     www      4635:     my $courseopt=&Apache::lonnet::get_courseresdata($env{'course.'.$env{'request.course.id'}.'.num'},
1.473     amueller 4636:                              $env{'course.'.$env{'request.course.id'}.'.domain'});
1.301     www      4637:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
1.473     amueller 4638:           '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
1.522.2.19  raeburn  4639:           &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th>');
                   4640:     unless ($readonly) {
                   4641:         $r->print('<th>'.&mt('Announce').'</th>');
                   4642:     }
                   4643:     $r->print(&Apache::loncommon::end_data_table_header_row());
1.309     www      4644:     my $shown=0;
1.349     www      4645:     my $folder='';
                   4646:     if ($env{'form.displayfilter'} eq 'currentfolder') {
1.473     amueller 4647:     my $last='';
                   4648:     if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   4649:         &GDBM_READER(),0640)) {
                   4650:         $last=$hash{'last_known'};
                   4651:         untie(%hash);
                   4652:     }
                   4653:     if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
1.349     www      4654:     }
1.446     bisitz   4655:     foreach my $id (sort
1.473     amueller 4656:             {
                   4657:             if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   4658:                 return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   4659:             }
                   4660:             my $aid = (split('00000',$a))[-1];
                   4661:             my $bid = (split('00000',$b))[-1];
                   4662:             return $bid<=>$aid;
                   4663:             } (keys(%parmlog))) {
1.294     www      4664:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.473     amueller 4665:     my $count = 0;
                   4666:     my $time =
                   4667:         &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
                   4668:     my $plainname =
                   4669:         &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   4670:                       $parmlog{$id}{'exe_udom'});
                   4671:     my $about_me_link =
                   4672:         &Apache::loncommon::aboutmewrapper($plainname,
                   4673:                            $parmlog{$id}{'exe_uname'},
                   4674:                            $parmlog{$id}{'exe_udom'});
                   4675:     my $send_msg_link='';
1.522.2.19  raeburn  4676:     if ((!$readonly) && 
                   4677:         (($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
1.473     amueller 4678:          || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
                   4679:         $send_msg_link ='<br />'.
                   4680:         &Apache::loncommon::messagewrapper(&mt('Send message'),
                   4681:                            $parmlog{$id}{'exe_uname'},
                   4682:                            $parmlog{$id}{'exe_udom'});
                   4683:     }
                   4684:     my $row_start=&Apache::loncommon::start_data_table_row();
                   4685:     my $makenewrow=0;
                   4686:     my %istype=();
                   4687:     my $output;
                   4688:     foreach my $changed (reverse(sort(@changes))) {
1.330     albertel 4689:             my $value=$parmlog{$id}{'logentry'}{$changed};
1.473     amueller 4690:         my $typeflag = ($changed =~/\.type$/ &&
                   4691:                 !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 4692:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
1.473     amueller 4693:         &components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},undef,undef,$typeflag);
                   4694:         if ($env{'form.displayfilter'} eq 'currentfolder') {
                   4695:         if ($folder) {
                   4696:             if ($middle!~/^\Q$folder\E/) { next; }
                   4697:         }
                   4698:         }
                   4699:         if ($typeflag) {
                   4700:         $istype{$parmname}=$value;
                   4701:         if (!$env{'form.includetypes'}) { next; }
                   4702:         }
                   4703:         $count++;
                   4704:         if ($makenewrow) {
                   4705:         $output .= $row_start;
                   4706:         } else {
                   4707:         $makenewrow=1;
                   4708:         }
1.470     raeburn  4709:             my $parmitem = &standard_parameter_names($parmname);
1.473     amueller 4710:         $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
                   4711:               &mt($parmitem).'</td><td>'.
                   4712:               ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
                   4713:         my $stillactive=0;
                   4714:         if ($parmlog{$id}{'delflag'}) {
                   4715:         $output .= &mt('Deleted');
                   4716:         } else {
                   4717:         if ($typeflag) {
1.470     raeburn  4718:                     my $parmitem = &standard_parameter_names($value); 
                   4719:                     $parmitem = &mt($parmitem);
1.473     amueller 4720:             $output .= &mt('Type: [_1]',$parmitem);
                   4721:         } else {
                   4722:             my ($level,@all)=&parmval_by_symb($what,$middle,&Apache::lonnet::metadata($middle,$what),
                   4723:                               $uname,$udom,$issection,$issection,$courseopt);
1.469     raeburn  4724:                     my $showvalue = $value;
                   4725:                     if ($istype{$parmname} eq '') {
                   4726:                         my $type = &standard_parameter_types($parmname);
                   4727:                         if ($type ne '') {
                   4728:                             if (&isdateparm($type)) {
                   4729:                                 $showvalue =
                   4730:                                     &Apache::lonlocal::locallocaltime($value);
                   4731:                             }
                   4732:                         }
                   4733:                     } else {
1.473     amueller 4734:                 if (&isdateparm($istype{$parmname})) {
                   4735:                 $showvalue = 
1.469     raeburn  4736:                                 &Apache::lonlocal::locallocaltime($value);
1.473     amueller 4737:                 }
1.469     raeburn  4738:                     }
                   4739:                     $output .= $showvalue;
1.473     amueller 4740:             if ($value ne $all[$level]) {
                   4741:             $output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
                   4742:             } else {
                   4743:             $stillactive=1;
                   4744:             }
                   4745:         }
                   4746:         }
1.522.2.19  raeburn  4747:         $output .= '</td>';
                   4748: 
                   4749:             unless ($readonly) {
                   4750:                 $output .= '<td>';
                   4751:                 if ($stillactive) {
                   4752:                     my $parmitem = &standard_parameter_names($parmname);
                   4753:                     $parmitem = &mt($parmitem);
                   4754:                     my $title=&mt('Changed [_1]',$parmitem);
                   4755:                     my $description=&mt('Changed [_1] for [_2] to [_3]',
                   4756:                         $parmitem,$realmdescription,
                   4757:                         (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
                   4758:                     if (($uname) && ($udom)) {
                   4759:                         $output .=
                   4760:                             &Apache::loncommon::messagewrapper('Notify User',
                   4761:                                                                $uname,$udom,$title,
                   4762:                                                                $description);
                   4763:                     } else {
                   4764:                         $output .=
                   4765:                             &Apache::lonrss::course_blog_link($id,$title,
                   4766:                                                               $description);
                   4767:                     }
                   4768:                 }
                   4769:                 $output .= '</td>';
                   4770:             }
                   4771:         $output .= &Apache::loncommon::end_data_table_row();
1.473     amueller 4772:     }
1.349     www      4773:         if ($env{'form.displayfilter'} eq 'containing') {
1.473     amueller 4774:         my $wholeentry=$about_me_link.':'.
                   4775:         $parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   4776:         $output;
                   4777:         if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
                   4778:     }
1.349     www      4779:         if ($count) {
1.473     amueller 4780:         $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
1.332     albertel 4781:                        <td rowspan="'.$count.'">'.$about_me_link.
1.473     amueller 4782:           '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   4783:                       ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   4784:           $send_msg_link.'</td>'.$output);
                   4785:         $shown++;
                   4786:     }
                   4787:     if (!($env{'form.show'} eq &mt('all')
                   4788:           || $shown<=$env{'form.show'})) { last; }
1.286     www      4789:     }
1.301     www      4790:     $r->print(&Apache::loncommon::end_data_table());
1.284     www      4791:     $r->print(&Apache::loncommon::end_page());
                   4792: }
                   4793: 
1.437     raeburn  4794: sub update_slots {
                   4795:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   4796:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   4797:     if (!keys(%slot)) {
                   4798:         return 'error: slot does not exist';
                   4799:     }
                   4800:     my $max=$slot{'maxspace'};
                   4801:     if (!defined($max)) { $max=99999; }
                   4802: 
                   4803:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   4804:                                        "^$slot_name\0");
                   4805:     my ($tmp)=%consumed;
                   4806:     if ($tmp=~/^error: 2 / ) {
                   4807:         return 'error: unable to determine current slot status';
                   4808:     }
                   4809:     my $last=0;
                   4810:     foreach my $key (keys(%consumed)) {
                   4811:         my $num=(split('\0',$key))[1];
                   4812:         if ($num > $last) { $last=$num; }
                   4813:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   4814:             return 'ok';
                   4815:         }
                   4816:     }
                   4817: 
                   4818:     if (scalar(keys(%consumed)) >= $max) {
                   4819:         return 'error: no space left in slot';
                   4820:     }
                   4821:     my $wanted=$last+1;
                   4822: 
                   4823:     my %reservation=('name'      => $uname.':'.$udom,
                   4824:                      'timestamp' => time,
                   4825:                      'symb'      => $symb);
                   4826: 
                   4827:     my $success=&Apache::lonnet::newput('slot_reservations',
                   4828:                                         {"$slot_name\0$wanted" =>
                   4829:                                              \%reservation},
                   4830:                                         $cdom, $cnum);
1.438     raeburn  4831:     if ($success eq 'ok') {
                   4832:         my %storehash = (
                   4833:                           symb    => $symb,
                   4834:                           slot    => $slot_name,
                   4835:                           action  => 'reserve',
                   4836:                           context => 'parameter',
                   4837:                         );
1.522.2.3  raeburn  4838:         &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.438     raeburn  4839:                                         '',$uname,$udom,$cnum,$cdom);
                   4840: 
1.522.2.3  raeburn  4841:         &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.438     raeburn  4842:                                         '',$uname,$udom,$uname,$udom);
                   4843:     }
1.437     raeburn  4844:     return $success;
                   4845: }
                   4846: 
                   4847: sub delete_slots {
                   4848:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   4849:     my $delresult;
                   4850:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   4851:                                          $cnum, "^$slot_name\0");
                   4852:     if (&Apache::lonnet::error(%consumed)) {
                   4853:         return 'error: unable to determine current slot status';
                   4854:     }
                   4855:     my ($tmp)=%consumed;
                   4856:     if ($tmp=~/^error: 2 /) {
                   4857:         return 'error: unable to determine current slot status';
                   4858:     }
                   4859:     foreach my $key (keys(%consumed)) {
                   4860:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   4861:             my $num=(split('\0',$key))[1];
                   4862:             my $entry = $slot_name.'\0'.$num;
                   4863:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   4864:                                               $cdom,$cnum);
                   4865:             if ($delresult eq 'ok') {
                   4866:                 my %storehash = (
                   4867:                                   symb    => $symb,
                   4868:                                   slot    => $slot_name,
                   4869:                                   action  => 'release',
                   4870:                                   context => 'parameter',
                   4871:                                 );
1.522.2.3  raeburn  4872:                 &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.437     raeburn  4873:                                                 1,$uname,$udom,$cnum,$cdom);
1.522.2.3  raeburn  4874:                 &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.438     raeburn  4875:                                                 1,$uname,$udom,$uname,$udom);
1.437     raeburn  4876:             }
                   4877:         }
                   4878:     }
                   4879:     return $delresult;
                   4880: }
                   4881: 
1.355     albertel 4882: sub check_for_course_info {
                   4883:     my $navmap = Apache::lonnavmaps::navmap->new();
                   4884:     return 1 if ($navmap);
                   4885:     return 0;
                   4886: }
                   4887: 
1.514     raeburn  4888: sub parameter_release_vars { 
1.504     raeburn  4889:    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4890:    my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   4891:    my $chostname = &Apache::lonnet::hostname($chome);
                   4892:    my ($cmajor,$cminor) = 
                   4893:        split(/\./,&Apache::lonnet::get_server_loncaparev($cdom,$chome));
                   4894:    return ($chostname,$cmajor,$cminor);
                   4895: }
                   4896: 
1.514     raeburn  4897: sub parameter_releasecheck {
1.522.2.14  raeburn  4898:     my ($name,$value,$needsrelease,$cmajor,$cminor) = @_;
1.504     raeburn  4899:     my $needsnewer;
                   4900:     my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
                   4901:     if (($cmajor < $needsmajor) || 
                   4902:         ($cmajor == $needsmajor && $cminor < $needsminor)) {
                   4903:         $needsnewer = 1;
                   4904:     } else {
1.514     raeburn  4905:         &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.':'.$value});
1.504     raeburn  4906:     }
                   4907:     return $needsnewer;
                   4908: }
                   4909: 
                   4910: sub oldversion_warning {
1.514     raeburn  4911:     my ($name,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_;
1.504     raeburn  4912:     my $desc;
1.514     raeburn  4913:     my %stringtypes = (
1.519     raeburn  4914:                         type         => 'string_questiontype',
                   4915:                         lenient      => 'string_lenient',
                   4916:                         retrypartial => 'string_yesno',
1.521     raeburn  4917:                         discussvote  => 'string_discussvote',
1.522.2.7  raeburn  4918:                         examcode     => 'string_examcode',
1.514     raeburn  4919:                       );
                   4920:     if (exists($stringtypes{$name})) {
1.522.2.7  raeburn  4921:         if ($name eq 'examcode') {
                   4922:             $desc = $value;
                   4923:         } elsif (ref($strings{$stringtypes{$name}}) eq 'ARRAY') {
1.514     raeburn  4924:             foreach my $possibilities (@{ $strings{$stringtypes{$name}} }) {
                   4925:                 next unless (ref($possibilities) eq 'ARRAY');
                   4926:                 my ($parmval, $description) = @{ $possibilities };
                   4927:                 if ($parmval eq $value) {
                   4928:                     $desc = $description;
                   4929:                     last;
                   4930:                 }
1.504     raeburn  4931:             }
                   4932:         }
1.522.2.16  raeburn  4933:     } elsif (($name eq 'printstartdate') || ($name eq 'printenddate')) {
                   4934:         my $now = time;
                   4935:         if ($value =~ /^\d+$/) {
                   4936:             if ($name eq 'printstartdate') {
                   4937:                 if ($value > $now) {
                   4938:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   4939:                 }
                   4940:             } elsif ($name eq 'printenddate') {
                   4941:                 if ($value < $now) {
                   4942:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   4943:                 }
                   4944:             }
                   4945:         }
1.504     raeburn  4946:     }
1.514     raeburn  4947:     my $standard_name = &standard_parameter_names($name);
1.504     raeburn  4948:     return '<p class="LC_warning">'.
1.514     raeburn  4949:            &mt('[_1] was [_2]not[_3] set to [_4].',
                   4950:                $standard_name,'<b>','</b>','"'.$desc.'"').'<br />'.
1.504     raeburn  4951:            &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   4952:            $cmajor.'.'.$cminor,$chostname,
                   4953:            $needsrelease).
                   4954:            '</p>';
                   4955: }
1.259     banghart 4956: 
1.522.2.19  raeburn  4957: sub get_permission {
                   4958:     my %permission;
                   4959:     my $allowed = 0;
                   4960:     return (\%permission,$allowed) unless ($env{'request.course.id'});
                   4961:     if ((&Apache::lonnet::allowed('opa',$env{'request.course.id'})) ||
                   4962:         (&Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
                   4963:                   $env{'request.course.sec'}))) {
                   4964:         %permission= (
                   4965:                        'edit'               => 1,
                   4966:                        'set'                => 1,
                   4967:                        'setoverview'        => 1,
                   4968:                        'addmetadata'        => 1,
                   4969:                        'ordermetadata'      => 1,
                   4970:                        'setrestrictmeta'    => 1,
                   4971:                        'newoverview'        => 1,
                   4972:                        'setdefaults'        => 1,
                   4973:                        'settable'           => 1,
                   4974:                        'parameterchangelog' => 1,
                   4975:                        'cleanparameters'    => 1,
                   4976:                        'dateshift1'         => 1,
                   4977:                        'dateshift2'         => 1,
                   4978:                        'helper'             => 1,
                   4979:          );
                   4980:     } elsif ((&Apache::lonnet::allowed('vpa',$env{'request.course.id'})) ||
                   4981:              (&Apache::lonnet::allowed('vpa',$env{'request.course.id'}.'/'.
                   4982:                   $env{'request.course.sec'}))) {
                   4983:         %permission = (
                   4984:                        'set'                => 1,
                   4985:                        'settable'           => 1,
                   4986:                        'newoverview'        => 1,
                   4987:                        'setoverview'        => 1,
                   4988:                        'parameterchangelog' => 1,
                   4989:                       );
                   4990:     }
                   4991:     foreach my $perm (values(%permission)) {
                   4992:         if ($perm) { $allowed=1; last; }
                   4993:     }
                   4994:     return (\%permission,$allowed);
                   4995: }
                   4996: 
1.30      www      4997: sub handler {
1.43      albertel 4998:     my $r=shift;
1.30      www      4999: 
1.376     albertel 5000:     &reset_caches();
                   5001: 
1.414     droeschl 5002:     &Apache::loncommon::content_type($r,'text/html');
                   5003:     $r->send_http_header;
                   5004:     return OK if $r->header_only;
                   5005: 
1.193     albertel 5006:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.473     amueller 5007:                         ['action','state',
1.205     www      5008:                                              'pres_marker',
                   5009:                                              'pres_value',
1.206     www      5010:                                              'pres_type',
1.506     www      5011:                                              'filter','part',
1.390     www      5012:                                              'udom','uname','symb','serial','timebase']);
1.131     www      5013: 
1.83      bowersj2 5014: 
1.193     albertel 5015:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 5016:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
1.522.2.3  raeburn  5017:                         text=>"Content and Problem Settings",
1.473     amueller 5018:                         faq=>10,
                   5019:                         bug=>'Instructor Interface',
1.442     droeschl 5020:                                             help =>
                   5021:                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203     www      5022: 
1.30      www      5023: # ----------------------------------------------------- Needs to be in a course
1.522.2.19  raeburn  5024:     my ($parm_permission,$allowed) = &get_permission();
1.355     albertel 5025:     my $exists = &check_for_course_info();
                   5026: 
1.522.2.19  raeburn  5027:     if ($env{'request.course.id'} && $allowed && $exists) {
1.193     albertel 5028:         #
                   5029:         # Main switch on form.action and form.state, as appropriate
                   5030:         #
                   5031:         # Check first if coming from someone else headed directly for
                   5032:         #  the table mode
1.522.2.19  raeburn  5033:         if (($parm_permission->{'set'}) &&
                   5034:             ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   5035:                && (!$env{'form.dis'})) || ($env{'form.symb'}))) {
                   5036:             &assessparms($r,$parm_permission);
1.193     albertel 5037:         } elsif (! exists($env{'form.action'})) {
                   5038:             &print_main_menu($r,$parm_permission);
1.522.2.19  raeburn  5039:         } elsif (!$parm_permission->{$env{'form.action'}}) {
                   5040:             &print_main_menu($r,$parm_permission);
1.414     droeschl 5041:         } elsif ($env{'form.action'} eq 'setoverview') {
1.522.2.19  raeburn  5042:             &overview($r,$parm_permission);
                   5043:         } elsif ($env{'form.action'} eq 'addmetadata') {
                   5044:             &addmetafield($r);
                   5045:         } elsif ($env{'form.action'} eq 'ordermetadata') {
                   5046:             &order_meta_fields($r);
1.414     droeschl 5047:         } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.522.2.19  raeburn  5048:             &setrestrictmeta($r);
1.414     droeschl 5049:         } elsif ($env{'form.action'} eq 'newoverview') {
1.522.2.19  raeburn  5050:             &newoverview($r,$parm_permission);
1.414     droeschl 5051:         } elsif ($env{'form.action'} eq 'setdefaults') {
1.522.2.19  raeburn  5052:             &defaultsetter($r);
                   5053:         } elsif ($env{'form.action'} eq 'settable') {
                   5054:             &assessparms($r,$parm_permission);
1.414     droeschl 5055:         } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.522.2.19  raeburn  5056:             &parm_change_log($r,$parm_permission);
1.414     droeschl 5057:         } elsif ($env{'form.action'} eq 'cleanparameters') {
1.522.2.19  raeburn  5058:             &clean_parameters($r);
1.414     droeschl 5059:         } elsif ($env{'form.action'} eq 'dateshift1') {
1.390     www      5060:             &date_shift_one($r);
1.414     droeschl 5061:         } elsif ($env{'form.action'} eq 'dateshift2') {
1.390     www      5062:             &date_shift_two($r);
1.446     bisitz   5063:         }
1.43      albertel 5064:     } else {
1.1       www      5065: # ----------------------------- Not in a course, or not allowed to modify parms
1.473     amueller 5066:     if ($exists) {
                   5067:         $env{'user.error.msg'}=
                   5068:         "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   5069:     } else {
                   5070:         $env{'user.error.msg'}=
                   5071:         "/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   5072:     }
                   5073:     return HTTP_NOT_ACCEPTABLE;
1.43      albertel 5074:     }
1.376     albertel 5075:     &reset_caches();
                   5076: 
1.43      albertel 5077:     return OK;
1.1       www      5078: }
                   5079: 
                   5080: 1;
                   5081: __END__
                   5082: 
                   5083: 

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