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

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

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