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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.482   ! amueller    4: # $Id: lonparmset.pm,v 1.481 2009/11/14 16:07:16 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.445     neumanie 1771:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Enclosing Map or Folder')));
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('<div id="mapmenu">');
                   2226:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
                   2227:         &mapmenu($r,\%allmaps,$pschp,\%maptitles, \%symbp);
                   2228:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   2229:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   2230:         $r->print('</div>');
1.473     amueller 2231:         #Display Unit 2 "Select Parameter"   
1.479     raeburn  2232:         $r->print(&Apache::lonhtmlcommon::topic_bar(2,&mt('Parameter Specification')));
1.473     amueller 2233:         &displaymenu($r,\%allparms,\%allparts,\@pscat,\@psprt,\%keyorder);
1.479     raeburn  2234:         $r->print(&Apache::lonhtmlcommon::topic_bar(3,&mt('User Specification (optional)')));
1.44      albertel 2235:     } else {
1.478     amueller 2236:         # parameter screen for a single resource. 
1.125     www      2237:         my ($map,$id,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.473     amueller 2238:         my $title = &Apache::lonnet::gettitle($pssymb);
1.312     albertel 2239:         $r->print(&mt('Specific Resource: [_1] ([_2])',$title,$resource).
1.472     amueller 2240:                 '<input type="hidden" value="'.$pssymb.'" name="symb" />'.
1.473     amueller 2241:                   '<br /><label><b>'.&mt('Show all parts').': <input type="checkbox" name="psprt" value="all"'.
                   2242:                   ($env{'form.psprt'}?' checked="checked"':'').' /></b></label><br />');
1.479     raeburn  2243:         $r->print(&Apache::lonhtmlcommon::topic_bar('',&mt('User Specification (optional)')));
1.57      albertel 2244:     }
1.445     neumanie 2245:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
                   2246:     &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups);
1.447     bisitz   2247:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 2248:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.449     neumanie 2249:     
1.459     bisitz   2250:     # parm selection is shown: display parm update button
                   2251:     $r->print('<p>'
                   2252:              .'<input type="submit" name="dis"'
                   2253:              .' value="'.&mt('Update Parameter Display').'" />'
                   2254:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
                   2255:              .'</p>'
                   2256:     );
                   2257: 
                   2258:     $r->print('</div>');
                   2259:     # ----- End Parameter Selection
                   2260: 
                   2261:     # Offer link to display parameter selection again
                   2262:     $r->print('<p id="parmsellink"');
                   2263:     if($env{'form.hideparmsel'} ne 'hidden') {
                   2264:         $r->print($parmselhiddenstyle);
                   2265:     }
                   2266:     $r->print('>'
                   2267:              .'<a href="javascript:parmsel_show()">'
                   2268:              .&mt('Change Parameter Selection')
                   2269:              .'</a>'
1.472     amueller 2270:              .'</p>'
1.473     amueller 2271:     );
1.478     amueller 2272:     
1.57      albertel 2273: 
1.459     bisitz   2274:     # Display Messages
                   2275:     $r->print('<div>'.$message.'</div>');
1.210     www      2276: 
1.57      albertel 2277: 
                   2278:     my @temp_pscat;
                   2279:     map {
                   2280:         my $cat = $_;
                   2281:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   2282:     } @pscat;
                   2283: 
                   2284:     @pscat = @temp_pscat;
                   2285: 
1.209     www      2286:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      2287: # ----------------------------------------------------------------- Start Table
1.57      albertel 2288:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 2289:         my $csuname=$env{'user.name'};
                   2290:         my $csudom=$env{'user.domain'};
1.57      albertel 2291: 
1.203     www      2292:         if ($parmlev eq 'full') {
1.473     amueller 2293:                my $coursespan=$csec?8:5;
                   2294:                my $userspan=3;
                   2295:                if ($cgroup ne '') {
                   2296:                   $coursespan += 3;
                   2297:                }
                   2298: 
                   2299:                $r->print('<p><table border="2">');
                   2300:                $r->print('<tr><td colspan="5"></td>');
                   2301:                $r->print('<th colspan="'.($coursespan).'">'.&mt('Any User').'</th>');
                   2302:                if ($uname) {
                   2303:                 if (@usersgroups > 1) {
                   2304:                        $userspan ++;
                   2305:                    }
                   2306:                    $r->print('<th colspan="'.$userspan.'" rowspan="2">');
                   2307:                    $r->print(&mt("User")." $uname ".&mt('at Domain')." $udom</th>");
                   2308:                }
                   2309:                my %lt=&Apache::lonlocal::texthash(
                   2310:                 'pie'    => "Parameter in Effect",
                   2311:                 'csv'    => "Current Session Value",
1.472     amueller 2312:                 'at'     => 'at',
                   2313:                 'rl'     => "Resource Level",
1.473     amueller 2314:                 'ic'     => 'in Course',
                   2315:                 'aut'    => "Assessment URL and Title",
                   2316:                 'type'   => 'Type',
                   2317:                 'emof'   => "Enclosing Map or Folder",
                   2318:                 'part'   => 'Part',
1.472     amueller 2319:                 'pn'     => 'Parameter Name',
1.473     amueller 2320:                 'def'    => 'default',
                   2321:                 'femof'  => 'from Enclosing Map or Folder',
                   2322:                 'gen'    => 'general',
                   2323:                 'foremf' => 'for Enclosing Map or Folder',
                   2324:                 'fr'     => 'for Resource'
                   2325:             );
                   2326:                $r->print(<<ENDTABLETWO);
1.419     bisitz   2327: <th rowspan="3">$lt{'pie'}</th>
                   2328: <th rowspan="3">$lt{'csv'}<br />($csuname $lt{'at'} $csudom)</th>
                   2329: </tr><tr><td colspan="5"></td><th colspan="2">$lt{'ic'}</th><th colspan="2">$lt{'rl'}</th>
                   2330: <th colspan="1">$lt{'ic'}</th>
1.182     albertel 2331: 
1.10      www      2332: ENDTABLETWO
1.473     amueller 2333:                if ($csec) {
                   2334:                    $r->print('<th colspan="3">'.
                   2335:                   &mt("in Section")." $csec</th>");
                   2336:                }
                   2337:                if ($cgroup) {
1.419     bisitz   2338:                 $r->print('<th colspan="3">'.
1.472     amueller 2339:                 &mt("in Group")." $cgroup</th>");
1.473     amueller 2340:                }
                   2341:                $r->print(<<ENDTABLEHEADFOUR);
1.133     www      2342: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   2343: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.192     albertel 2344: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
                   2345: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      2346: ENDTABLEHEADFOUR
1.57      albertel 2347: 
1.473     amueller 2348:                if ($csec) {
                   2349:                    $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
                   2350:                }
                   2351: 
                   2352:                if ($cgroup) {
                   2353:                 $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
                   2354:                }
                   2355: 
                   2356:                if ($uname) {
                   2357:                 if (@usersgroups > 1) {
                   2358:                     $r->print('<th>'.&mt('Control by other group?').'</th>');
                   2359:                    }
                   2360:                    $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
                   2361:                }
                   2362: 
                   2363:                $r->print('</tr>');
                   2364: 
                   2365:                my $defbgone='';
                   2366:                my $defbgtwo='';
                   2367:                my $defbgthree = '';
1.57      albertel 2368: 
1.473     amueller 2369:                foreach (@ids) {
1.57      albertel 2370: 
1.473     amueller 2371:                 my $rid=$_;
1.57      albertel 2372:                 my ($inmapid)=($rid=~/\.(\d+)$/);
                   2373: 
1.446     bisitz   2374:                 if ((!$pssymb &&
1.473     amueller 2375:                  (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   2376:                 ||
                   2377:                 ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      2378: # ------------------------------------------------------ Entry for one resource
1.473     amueller 2379:                     if ($defbgone eq '#E0E099') {
                   2380:                         $defbgone='#E0E0DD';
1.57      albertel 2381:                     } else {
1.419     bisitz   2382:                         $defbgone='#E0E099';
1.57      albertel 2383:                     }
1.419     bisitz   2384:                     if ($defbgtwo eq '#FFFF99') {
1.473     amueller 2385:                         $defbgtwo='#FFFFDD';
1.57      albertel 2386:                     } else {
1.473     amueller 2387:                         $defbgtwo='#FFFF99';
1.57      albertel 2388:                     }
1.419     bisitz   2389:                     if ($defbgthree eq '#FFBB99') {
                   2390:                         $defbgthree='#FFBBDD';
1.269     raeburn  2391:                     } else {
1.419     bisitz   2392:                         $defbgthree='#FFBB99';
1.269     raeburn  2393:                     }
                   2394: 
1.57      albertel 2395:                     my $thistitle='';
                   2396:                     my %name=   ();
                   2397:                     undef %name;
                   2398:                     my %part=   ();
                   2399:                     my %display=();
                   2400:                     my %type=   ();
                   2401:                     my %default=();
1.196     www      2402:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 2403: 
1.210     www      2404:                     foreach (&keysplit($keyp{$rid})) {
1.57      albertel 2405:                         my $tempkeyp = $_;
                   2406:                         if (grep $_ eq $tempkeyp, @catmarker) {
                   2407:                           $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
                   2408:                           $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
1.433     raeburn  2409:                           my $parmdis=&Apache::lonnet::metadata($uri,$_.'.display');
                   2410:                           if ($allparms{$name{$_}} ne '') {
                   2411:                               my $identifier;
                   2412:                               if ($parmdis =~ /(\s*\[Part.*)$/) {
                   2413:                                   $identifier = $1;
                   2414:                               }
                   2415:                               $display{$_} = $allparms{$name{$_}}.$identifier;
                   2416:                           } else {
                   2417:                               $display{$_} = $parmdis;
                   2418:                           }
1.57      albertel 2419:                           unless ($display{$_}) { $display{$_}=''; }
                   2420:                           $display{$_}.=' ('.$name{$_}.')';
                   2421:                           $default{$_}=&Apache::lonnet::metadata($uri,$_);
                   2422:                           $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
                   2423:                           $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
                   2424:                         }
                   2425:                     }
                   2426:                     my $totalparms=scalar keys %name;
                   2427:                     if ($totalparms>0) {
1.473     amueller 2428:                            my $firstrow=1;
                   2429:                         my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.419     bisitz   2430:                         $r->print('<tr><td style="background-color:'.$defbgone.';"'.
1.57      albertel 2431:                              ' rowspan='.$totalparms.
1.419     bisitz   2432:                              '><tt><font size="-1">'.
1.57      albertel 2433:                              join(' / ',split(/\//,$uri)).
                   2434:                              '</font></tt><p><b>'.
1.154     albertel 2435:                              "<a href=\"javascript:openWindow('".
1.473     amueller 2436:                           &Apache::lonnet::clutter($uri).'?symb='.
                   2437:                           &escape($symbp{$rid}).
1.336     albertel 2438:                              "', 'metadatafile', '450', '500', 'no', 'yes');\"".
                   2439:                              " target=\"_self\">$title");
1.57      albertel 2440: 
                   2441:                         if ($thistitle) {
1.473     amueller 2442:                             $r->print(' ('.$thistitle.')');
1.57      albertel 2443:                         }
                   2444:                         $r->print('</a></b></td>');
1.419     bisitz   2445:                         $r->print('<td style="background-color:'.$defbgtwo.';"'.
1.57      albertel 2446:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   2447:                                       '</td>');
                   2448: 
1.419     bisitz   2449:                         $r->print('<td style="background-color:'.$defbgone.';"'.
1.57      albertel 2450:                                       ' rowspan='.$totalparms.
1.238     www      2451:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.57      albertel 2452: 
1.236     albertel 2453:                         foreach (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 2454:                             unless ($firstrow) {
                   2455:                                 $r->print('<tr>');
                   2456:                             } else {
                   2457:                                 undef $firstrow;
                   2458:                             }
1.201     www      2459:                             &print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 2460:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  2461:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.275     raeburn  2462:                                                             $cgroup,\@usersgroups);
1.57      albertel 2463:                         }
                   2464:                     }
                   2465:                 }
                   2466:             } # end foreach ids
1.43      albertel 2467: # -------------------------------------------------- End entry for one resource
1.57      albertel 2468:             $r->print('</table>');
1.203     www      2469:         } # end of  full
1.57      albertel 2470: #--------------------------------------------------- Entry for parm level map
                   2471:         if ($parmlev eq 'map') {
1.419     bisitz   2472:             my $defbgone = '#E0E099';
                   2473:             my $defbgtwo = '#FFFF99';
                   2474:             my $defbgthree = '#FFBB99';
1.57      albertel 2475: 
                   2476:             my %maplist;
                   2477: 
                   2478:             if ($pschp eq 'all') {
1.446     bisitz   2479:                 %maplist = %allmaps;
1.57      albertel 2480:             } else {
                   2481:                 %maplist = ($pschp => $mapp{$pschp});
                   2482:             }
                   2483: 
                   2484: #-------------------------------------------- for each map, gather information
                   2485:             my $mapid;
1.473     amueller 2486:                foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
1.60      albertel 2487:                 my $maptitle = $maplist{$mapid};
1.57      albertel 2488: 
                   2489: #-----------------------  loop through ids and get all parameter types for map
                   2490: #-----------------------------------------          and associated information
                   2491:                 my %name = ();
                   2492:                 my %part = ();
                   2493:                 my %display = ();
                   2494:                 my %type = ();
                   2495:                 my %default = ();
                   2496:                 my $map = 0;
                   2497: 
1.473     amueller 2498: #        $r->print("Catmarker: @catmarker<br />\n");
1.446     bisitz   2499: 
1.57      albertel 2500:                 foreach (@ids) {
1.473     amueller 2501:                     ($map)=(/([\d]*?)\./);
                   2502:                       my $rid = $_;
1.446     bisitz   2503: 
1.57      albertel 2504: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   2505: 
1.473     amueller 2506:                      if ($map eq $mapid) {
                   2507:                         my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 2508: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   2509: 
                   2510: #--------------------------------------------------------------------
                   2511: # @catmarker contains list of all possible parameters including part #s
                   2512: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   2513: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   2514: # When storing information, store as part 0
                   2515: # When requesting information, request from full part
                   2516: #-------------------------------------------------------------------
1.473     amueller 2517:                         foreach (&keysplit($keyp{$rid})) {
                   2518:                              my $tempkeyp = $_;
                   2519:                               my $fullkeyp = $tempkeyp;
                   2520:                               $tempkeyp =~ s/_\w+_/_0_/;
                   2521: 
                   2522:                               if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   2523:                                 $part{$tempkeyp}="0";
                   2524:                                 $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   2525:                                 my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   2526:                                 if ($allparms{$name{$tempkeyp}} ne '') {
                   2527:                                     my $identifier;
                   2528:                                     if ($parmdis =~ /(\s*\[Part.*)$/) {
                   2529:                                         $identifier = $1;
                   2530:                                     }
                   2531:                                     $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   2532:                                 } else {
                   2533:                                     $display{$tempkeyp} = $parmdis;
                   2534:                                 }
                   2535:                                 unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   2536:                                 $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   2537:                                 $display{$tempkeyp} =~ s/_\w+_/_0_/;
                   2538:                                 $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   2539:                                 $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   2540:                               }
                   2541:                         } # end loop through keys
                   2542:                       }
1.57      albertel 2543:                 } # end loop through ids
1.446     bisitz   2544: 
1.57      albertel 2545: #---------------------------------------------------- print header information
1.133     www      2546:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      2547:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.401     bisitz   2548:                 my $tmp="";
1.57      albertel 2549:                 if ($uname) {
1.473     amueller 2550:                     my $person=&Apache::loncommon::plainname($uname,$udom);
1.401     bisitz   2551:                     $tmp.=&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
                   2552:                         &mt('in')." \n";
1.57      albertel 2553:                 } else {
1.401     bisitz   2554:                     $tmp.="<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n";
1.57      albertel 2555:                 }
1.269     raeburn  2556:                 if ($cgroup) {
1.401     bisitz   2557:                     $tmp.=&mt("Group")." <font color=\"red\"><i>$cgroup".
                   2558:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  2559:                     $csec = '';
                   2560:                 } elsif ($csec) {
1.401     bisitz   2561:                     $tmp.=&mt("Section")." <font color=\"red\"><i>$csec".
                   2562:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  2563:                 }
1.401     bisitz   2564:                 $r->print('<div align="center"><h4>'
                   2565:                          .&mt('Set Defaults for All Resources in [_1]Specifically for [_2][_3]'
1.404     bisitz   2566:                              ,$foldermap.'<br /><font color="red"><i>'.$showtitle.'</i></font><br />'
1.401     bisitz   2567:                              ,$tmp
                   2568:                              ,'<font color="red"><i>'.$coursename.'</i></font>'
                   2569:                              )
                   2570:                          ."<br /></h4>\n"
1.422     bisitz   2571:                 );
1.57      albertel 2572: #---------------------------------------------------------------- print table
1.419     bisitz   2573:                 $r->print('<p>'.&Apache::loncommon::start_data_table()
                   2574:                          .&Apache::loncommon::start_data_table_header_row()
                   2575:                          .'<th>'.&mt('Parameter Name').'</th>'
                   2576:                          .'<th>'.&mt('Default Value').'</th>'
                   2577:                          .'<th>'.&mt('Parameter in Effect').'</th>'
                   2578:                          .&Apache::loncommon::end_data_table_header_row()
                   2579:                 );
1.57      albertel 2580: 
1.473     amueller 2581:                 foreach (&keysinorder(\%name,\%keyorder)) {
                   2582:                     $r->print(&Apache::loncommon::start_data_table_row());
1.201     www      2583:                     &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  2584:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   2585:                            $parmlev,$uname,$udom,$csec,$cgroup);
1.57      albertel 2586:                 }
1.422     bisitz   2587:                 $r->print(&Apache::loncommon::end_data_table().'</p>'
                   2588:                          .'</div>'
                   2589:                 );
1.57      albertel 2590:             } # end each map
                   2591:         } # end of $parmlev eq map
                   2592: #--------------------------------- Entry for parm level general (Course level)
                   2593:         if ($parmlev eq 'general') {
1.473     amueller 2594:             my $defbgone = '#E0E099';
1.419     bisitz   2595:             my $defbgtwo = '#FFFF99';
                   2596:             my $defbgthree = '#FFBB99';
1.57      albertel 2597: 
                   2598: #-------------------------------------------- for each map, gather information
                   2599:             my $mapid="0.0";
                   2600: #-----------------------  loop through ids and get all parameter types for map
                   2601: #-----------------------------------------          and associated information
                   2602:             my %name = ();
                   2603:             my %part = ();
                   2604:             my %display = ();
                   2605:             my %type = ();
                   2606:             my %default = ();
1.446     bisitz   2607: 
1.57      albertel 2608:             foreach (@ids) {
                   2609:                 my $rid = $_;
1.446     bisitz   2610: 
1.196     www      2611:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 2612: 
                   2613: #--------------------------------------------------------------------
                   2614: # @catmarker contains list of all possible parameters including part #s
                   2615: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   2616: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   2617: # When storing information, store as part 0
                   2618: # When requesting information, request from full part
                   2619: #-------------------------------------------------------------------
1.473     amueller 2620:                 foreach (&keysplit($keyp{$rid})) {
                   2621:                     my $tempkeyp = $_;
                   2622:                       my $fullkeyp = $tempkeyp;
                   2623:                       $tempkeyp =~ s/_\w+_/_0_/;
                   2624:                       if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   2625:                         $part{$tempkeyp}="0";
                   2626:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   2627:                         my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   2628:                         if ($allparms{$name{$tempkeyp}} ne '') {
                   2629:                             my $identifier;
                   2630:                             if ($parmdis =~ /(\s*\[Part.*)$/) {
                   2631:                                 $identifier = $1;
                   2632:                             }
                   2633:                             $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   2634:                         } else {
                   2635:                             $display{$tempkeyp} = $parmdis;
                   2636:                         }
                   2637:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   2638:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   2639:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
                   2640:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   2641:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   2642:                       }
1.57      albertel 2643:                 } # end loop through keys
                   2644:             } # end loop through ids
1.446     bisitz   2645: 
1.57      albertel 2646: #---------------------------------------------------- print header information
1.473     amueller 2647:             my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 2648:             $r->print(<<ENDMAPONE);
1.419     bisitz   2649: <center>
                   2650: <h4>$setdef
1.135     albertel 2651: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 2652: ENDMAPONE
                   2653:             if ($uname) {
1.473     amueller 2654:                 my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 2655:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 2656:             } else {
1.135     albertel 2657:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 2658:             }
1.446     bisitz   2659: 
1.135     albertel 2660:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.306     albertel 2661:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$cgroup</i></font>\n")};
1.135     albertel 2662:             $r->print("</h4>\n");
1.57      albertel 2663: #---------------------------------------------------------------- print table
1.419     bisitz   2664:             $r->print('<p>'.&Apache::loncommon::start_data_table()
                   2665:                      .&Apache::loncommon::start_data_table_header_row()
                   2666:                      .'<th>'.&mt('Parameter Name').'</th>'
                   2667:                      .'<th>'.&mt('Default Value').'</th>'
                   2668:                      .'<th>'.&mt('Parameter in Effect').'</th>'
                   2669:                      .&Apache::loncommon::end_data_table_header_row()
                   2670:             );
1.57      albertel 2671: 
1.473     amueller 2672:             foreach (&keysinorder(\%name,\%keyorder)) {
1.419     bisitz   2673:                 $r->print(&Apache::loncommon::start_data_table_row());
1.201     www      2674:                 &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  2675:                        \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   2676:                                    $parmlev,$uname,$udom,$csec,$cgroup);
1.57      albertel 2677:             }
1.419     bisitz   2678:             $r->print(&Apache::loncommon::end_data_table()
                   2679:                      .'</p>'
                   2680:                      .'</center>'
                   2681:             );
1.57      albertel 2682:         } # end of $parmlev eq general
1.43      albertel 2683:     }
1.280     albertel 2684:     $r->print('</form>'.&Apache::loncommon::end_page());
1.57      albertel 2685: } # end sub assessparms
1.30      www      2686: 
1.120     www      2687: ##################################################
1.207     www      2688: # Overview mode
                   2689: ##################################################
1.124     www      2690: my $tableopen;
                   2691: 
                   2692: sub tablestart {
                   2693:     if ($tableopen) {
1.473     amueller 2694:     return '';
1.124     www      2695:     } else {
1.473     amueller 2696:     $tableopen=1;
                   2697:     return &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th><th>'.
                   2698:         &mt('Delete').'</th><th>'.&mt('Set to ...').'</th></tr>';
1.124     www      2699:     }
                   2700: }
                   2701: 
                   2702: sub tableend {
                   2703:     if ($tableopen) {
1.473     amueller 2704:     $tableopen=0;
                   2705:     return &Apache::loncommon::end_data_table();
1.124     www      2706:     } else {
1.473     amueller 2707:     return'';
1.124     www      2708:     }
                   2709: }
                   2710: 
1.207     www      2711: sub readdata {
                   2712:     my ($crs,$dom)=@_;
                   2713: # Read coursedata
                   2714:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   2715: # Read userdata
                   2716: 
                   2717:     my $classlist=&Apache::loncoursedata::get_classlist();
                   2718:     foreach (keys %$classlist) {
1.350     albertel 2719:         if ($_=~/^($match_username)\:($match_domain)$/) {
1.473     amueller 2720:         my ($tuname,$tudom)=($1,$2);
                   2721:         my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
1.207     www      2722:             foreach my $userkey (keys %{$useropt}) {
1.473     amueller 2723:         if ($userkey=~/^$env{'request.course.id'}/) {
1.207     www      2724:                     my $newkey=$userkey;
1.473     amueller 2725:             $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   2726:             $$resourcedata{$newkey}=$$useropt{$userkey};
                   2727:         }
                   2728:         }
                   2729:     }
1.207     www      2730:     }
                   2731:     return $resourcedata;
                   2732: }
                   2733: 
                   2734: 
1.124     www      2735: # Setting
1.208     www      2736: 
                   2737: sub storedata {
                   2738:     my ($r,$crs,$dom)=@_;
1.207     www      2739: # Set userlevel immediately
                   2740: # Do an intermediate store of course level
                   2741:     my $olddata=&readdata($crs,$dom);
1.124     www      2742:     my %newdata=();
                   2743:     undef %newdata;
                   2744:     my @deldata=();
                   2745:     undef @deldata;
1.190     albertel 2746:     foreach (keys %env) {
1.473     amueller 2747:     if ($_=~/^form\.([a-z]+)\_(.+)$/) {
                   2748:         my $cmd=$1;
                   2749:         my $thiskey=$2;
                   2750:         my ($tuname,$tudom)=&extractuser($thiskey);
                   2751:         my $tkey=$thiskey;
                   2752:             if ($tuname) {
                   2753:         $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   2754:         }
                   2755:         if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
                   2756:         my ($data, $typeof, $text);
                   2757:         if ($cmd eq 'set') {
                   2758:             $data=$env{$_};
                   2759:             $typeof=$env{'form.typeof_'.$thiskey};
                   2760:             $text = &mt('Saved modified parameter for');
                   2761:         } elsif ($cmd eq 'datepointer') {
                   2762:             $data=&Apache::lonhtmlcommon::get_date_from_form($env{$_});
                   2763:             $typeof=$env{'form.typeof_'.$thiskey};
                   2764:             $text = &mt('Saved modified date for');
                   2765:         } elsif ($cmd eq 'dateinterval') {
                   2766:             $data=&get_date_interval_from_form($thiskey);
                   2767:             $typeof=$env{'form.typeof_'.$thiskey};
                   2768:             $text = &mt('Saved modified date for');
                   2769:         }
                   2770:         if (defined($data) and $$olddata{$thiskey} ne $data) {
1.207     www      2771:             if ($tuname) {
1.473     amueller 2772:             if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
                   2773:                                  $tkey.'.type' => $typeof},
                   2774:                          $tudom,$tuname) eq 'ok') {
                   2775:                 &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom);
                   2776:                 $r->print('<br />'.$text.' '.
                   2777:                       &Apache::loncommon::plainname($tuname,$tudom));
                   2778:             } else {
                   2779:                 $r->print('<div class="LC_error">'.
                   2780:                       &mt('Error saving parameters').'</div>');
                   2781:             }
                   2782:             &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2783:             } else {
                   2784:             $newdata{$thiskey}=$data;
                   2785:              $newdata{$thiskey.'.type'}=$typeof;
1.446     bisitz   2786:                    }
1.473     amueller 2787:         }
                   2788:         } elsif ($cmd eq 'del') {
                   2789:         if ($tuname) {
                   2790:             if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') {
                   2791:                 &log_parmset({$tkey=>''},1,$tuname,$tudom);
                   2792:             $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   2793:             } else {
                   2794:             $r->print('<div class="LC_error">'.
                   2795:                   &mt('Error deleting parameters').'</div>');
                   2796:             }
                   2797:             &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2798:         } else {
                   2799:             push (@deldata,$thiskey,$thiskey.'.type');
                   2800:         }
                   2801:         }
                   2802:     }
1.124     www      2803:     }
1.207     www      2804: # Store all course level
1.144     www      2805:     my $delentries=$#deldata+1;
                   2806:     my @newdatakeys=keys %newdata;
                   2807:     my $putentries=$#newdatakeys+1;
                   2808:     if ($delentries) {
1.473     amueller 2809:     if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {
                   2810:         my %loghash=map { $_ => '' } @deldata;
                   2811:         &log_parmset(\%loghash,1);
                   2812:         $r->print('<h2>'.&mt('Deleted [_1] parameter(s)</h2>',$delentries));
                   2813:     } else {
                   2814:         $r->print('<div class="LC_error">'.
                   2815:               &mt('Error deleting parameters').'</div>');
                   2816:     }
                   2817:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      2818:     }
                   2819:     if ($putentries) {
1.473     amueller 2820:     if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
                   2821:                 &log_parmset(\%newdata,0);
                   2822:         $r->print('<h3>'.&mt('Saved [_1] parameter(s)',$putentries/2).'</h3>');
                   2823:     } else {
                   2824:         $r->print('<div class="LC_error">'.
                   2825:               &mt('Error saving parameters').'</div>');
                   2826:     }
                   2827:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      2828:     }
1.208     www      2829: }
1.207     www      2830: 
1.208     www      2831: sub extractuser {
                   2832:     my $key=shift;
1.350     albertel 2833:     return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
1.208     www      2834: }
1.206     www      2835: 
1.381     albertel 2836: sub parse_listdata_key {
                   2837:     my ($key,$listdata) = @_;
                   2838:     # split into student/section affected, and
                   2839:     # the realm (folder/resource part and parameter
1.446     bisitz   2840:     my ($student,$realm) =
1.473     amueller 2841:     ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
1.381     albertel 2842:     # if course wide student would be undefined
                   2843:     if (!defined($student)) {
1.473     amueller 2844:     ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.381     albertel 2845:     }
                   2846:     # strip off the .type if it's not the Question type parameter
                   2847:     if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
1.473     amueller 2848:     $realm=~s/\.type//;
1.381     albertel 2849:     }
                   2850:     # split into resource+part and parameter name
1.388     albertel 2851:     my ($res,    $parm) = ($realm=~/^(.*)\.(.*)$/);
                   2852:        ($res, my $part) = ($res  =~/^(.*)\.(.*)$/);
1.381     albertel 2853:     return ($student,$res,$part,$parm);
                   2854: }
                   2855: 
1.208     www      2856: sub listdata {
1.214     www      2857:     my ($r,$resourcedata,$listdata,$sortorder)=@_;
1.207     www      2858: # Start list output
1.206     www      2859: 
1.122     www      2860:     my $oldsection='';
                   2861:     my $oldrealm='';
                   2862:     my $oldpart='';
1.123     www      2863:     my $pointer=0;
1.124     www      2864:     $tableopen=0;
1.145     www      2865:     my $foundkeys=0;
1.248     albertel 2866:     my %keyorder=&standardkeyorder();
1.381     albertel 2867: 
1.214     www      2868:     foreach my $thiskey (sort {
1.473     amueller 2869:     my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
                   2870:     my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
1.381     albertel 2871: 
1.473     amueller 2872:     # get the numerical order for the param
                   2873:     $aparm=$keyorder{'parameter_0_'.$aparm};
                   2874:     $bparm=$keyorder{'parameter_0_'.$bparm};
1.381     albertel 2875: 
1.473     amueller 2876:     my $result=0;
1.381     albertel 2877: 
1.473     amueller 2878:     if ($sortorder eq 'realmstudent') {
1.381     albertel 2879:             if ($ares     ne $bres    ) {
1.473     amueller 2880:         $result = ($ares     cmp $bres);
1.446     bisitz   2881:             } elsif ($astudent ne $bstudent) {
1.473     amueller 2882:         $result = ($astudent cmp $bstudent);
                   2883:         } elsif ($apart    ne $bpart   ) {
                   2884:         $result = ($apart    cmp $bpart);
                   2885:         }
                   2886:     } else {
                   2887:         if      ($astudent ne $bstudent) {
                   2888:         $result = ($astudent cmp $bstudent);
                   2889:         } elsif ($ares     ne $bres    ) {
                   2890:         $result = ($ares     cmp $bres);
                   2891:         } elsif ($apart    ne $bpart   ) {
                   2892:         $result = ($apart    cmp $bpart);
                   2893:         }
                   2894:     }
1.446     bisitz   2895: 
1.473     amueller 2896:     if (!$result) {
1.381     albertel 2897:             if (defined($aparm) && defined($bparm)) {
1.473     amueller 2898:         $result = ($aparm <=> $bparm);
1.381     albertel 2899:             } elsif (defined($aparm)) {
1.473     amueller 2900:         $result = -1;
1.381     albertel 2901:             } elsif (defined($bparm)) {
1.473     amueller 2902:         $result = 1;
                   2903:         }
                   2904:     }
1.381     albertel 2905: 
1.473     amueller 2906:     $result;
1.214     www      2907:     } keys %{$listdata}) {
1.381     albertel 2908: 
1.473     amueller 2909:     if ($$listdata{$thiskey.'.type'}) {
1.211     www      2910:             my $thistype=$$listdata{$thiskey.'.type'};
                   2911:             if ($$resourcedata{$thiskey.'.type'}) {
1.473     amueller 2912:         $thistype=$$resourcedata{$thiskey.'.type'};
                   2913:         }
                   2914:         my ($middle,$part,$name)=
                   2915:         ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
                   2916:         my $section=&mt('All Students');
                   2917:         if ($middle=~/^\[(.*)\]/) {
                   2918:         my $issection=$1;
                   2919:         if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
                   2920:             $section=&mt('User').": ".&Apache::loncommon::plainname($1,$2);
                   2921:         } else {
                   2922:             $section=&mt('Group/Section').': '.$issection;
                   2923:         }
                   2924:         $middle=~s/^\[(.*)\]//;
                   2925:         }
                   2926:         $middle=~s/\.+$//;
                   2927:         $middle=~s/^\.+//;
                   2928:         my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
                   2929:         if ($middle=~/^(.+)\_\_\_\(all\)$/) {
                   2930:         $realm='<span class="LC_parm_scope_folder">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><span class="LC_parm_folder">('.$1.')</span></span>';
                   2931:         } elsif ($middle) {
                   2932:         my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   2933:         $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>';
                   2934:         }
                   2935:         if ($sortorder eq 'realmstudent') {
                   2936:         if ($realm ne $oldrealm) {
                   2937:             $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   2938:             $oldrealm=$realm;
                   2939:             $oldsection='';
                   2940:         }
                   2941:         if ($section ne $oldsection) {
                   2942:             $r->print(&tableend()."\n<h2>$section</h2>");
                   2943:             $oldsection=$section;
                   2944:             $oldpart='';
                   2945:         }
                   2946:         } else {
                   2947:         if ($section ne $oldsection) {
                   2948:             $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   2949:             $oldsection=$section;
                   2950:             $oldrealm='';
                   2951:         }
                   2952:         if ($realm ne $oldrealm) {
                   2953:             $r->print(&tableend()."\n<h2>$realm</h2>");
                   2954:             $oldrealm=$realm;
                   2955:             $oldpart='';
                   2956:         }
                   2957:         }
                   2958:         if ($part ne $oldpart) {
                   2959:         $r->print(&tableend().
                   2960:               "\n".'<span class="LC_parm_part">'.&mt('Part').": $part</span>");
                   2961:         $oldpart=$part;
                   2962:         }
1.123     www      2963: #
                   2964: # Ready to print
                   2965: #
1.470     raeburn  2966:             my $parmitem = &standard_parameter_names($name);
1.473     amueller 2967:         $r->print(&tablestart().
                   2968:               &Apache::loncommon::start_data_table_row().
                   2969:               '<td><b>'.&mt($parmitem).
                   2970:               '</b></td><td><input type="checkbox" name="del_'.
                   2971:               $thiskey.'" /></td><td>');
                   2972:         $foundkeys++;
                   2973:         if (&isdateparm($thistype)) {
                   2974:         my $jskey='key_'.$pointer;
                   2975:         $pointer++;
                   2976:         $r->print(
                   2977:               &Apache::lonhtmlcommon::date_setter('parmform',
                   2978:                                   $jskey,
                   2979:                               $$resourcedata{$thiskey},
                   2980:                                   '',1,'','').
1.277     www      2981: '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
1.413     bisitz   2982: (($$resourcedata{$thiskey}!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$$resourcedata{$thiskey}.'">'.
                   2983: &mt('Shift all dates based on this date').'</a></span>':'').
1.277     www      2984: &date_sanity_info($$resourcedata{$thiskey})
1.473     amueller 2985:               );
                   2986:         } elsif ($thistype eq 'date_interval') {
                   2987:         $r->print(&date_interval_selector($thiskey,
                   2988:                           $$resourcedata{$thiskey}));
                   2989:         } elsif ($thistype =~ m/^string/) {
                   2990:         $r->print(&string_selector($thistype,$thiskey,
                   2991:                        $$resourcedata{$thiskey}));
                   2992:         } else {
                   2993:         $r->print(&default_selector($thiskey,$$resourcedata{$thiskey}));
                   2994:         }
                   2995:         $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   2996:               $thistype.'" />');
                   2997:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
                   2998:     }
1.121     www      2999:     }
1.208     www      3000:     return $foundkeys;
                   3001: }
                   3002: 
1.385     albertel 3003: 
                   3004: sub date_interval_selector {
                   3005:     my ($thiskey, $showval) = @_;
                   3006:     my $result;
                   3007:     foreach my $which (['days', 86400, 31],
1.473     amueller 3008:                ['hours', 3600, 23],
                   3009:                ['minutes', 60, 59],
                   3010:                ['seconds',  1, 59]) {
                   3011:     my ($name, $factor, $max) = @{ $which };
                   3012:     my $amount = int($showval/$factor);
                   3013:     $showval  %= $factor;
                   3014:     my %select = ((map {$_ => $_} (0..$max)),
                   3015:               'select_form_order' => [0..$max]);
                   3016:     $result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey,
                   3017:                            %select);
                   3018:     $result .= ' '.&mt($name);
1.385     albertel 3019:     }
                   3020:     $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
                   3021:     return $result;
                   3022: 
                   3023: }
                   3024: 
                   3025: sub get_date_interval_from_form {
                   3026:     my ($key) = @_;
                   3027:     my $seconds = 0;
                   3028:     foreach my $which (['days', 86400],
1.473     amueller 3029:                ['hours', 3600],
                   3030:                ['minutes', 60],
                   3031:                ['seconds',  1]) {
                   3032:     my ($name, $factor) = @{ $which };
                   3033:     if (defined($env{'form.'.$name.'_'.$key})) {
                   3034:         $seconds += $env{'form.'.$name.'_'.$key} * $factor;
                   3035:     }
1.385     albertel 3036:     }
                   3037:     return $seconds;
                   3038: }
                   3039: 
                   3040: 
1.383     albertel 3041: sub default_selector {
                   3042:     my ($thiskey, $showval) = @_;
1.385     albertel 3043:     return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'" />';
1.383     albertel 3044: }
                   3045: 
1.446     bisitz   3046: my %strings =
1.383     albertel 3047:     (
                   3048:      'string_yesno'
                   3049:              => [[ 'yes', 'Yes' ],
1.473     amueller 3050:          [ 'no', 'No' ]],
1.383     albertel 3051:      'string_problemstatus'
                   3052:              => [[ 'yes', 'Yes' ],
1.473     amueller 3053:          [ 'answer', 'Yes, and show correct answer if they exceed the maximum number of tries.' ],
                   3054:          [ 'no', 'No, don\'t show correct/incorrect feedback.' ],
                   3055:          [ 'no_feedback_ever', 'No, show no feedback at all.' ]],
1.383     albertel 3056:      );
                   3057: 
                   3058: 
                   3059: sub string_selector {
                   3060:     my ($thistype, $thiskey, $showval) = @_;
1.446     bisitz   3061: 
1.383     albertel 3062:     if (!exists($strings{$thistype})) {
1.473     amueller 3063:     return &default_selector($thiskey,$showval);
1.383     albertel 3064:     }
                   3065: 
                   3066:     my $result;
                   3067:     foreach my $possibilities (@{ $strings{$thistype} }) {
1.473     amueller 3068:     my ($name, $description) = @{ $possibilities };
                   3069:     $result .= '<label><input type="radio" name="set_'.$thiskey.
                   3070:           '" value="'.$name.'"';
                   3071:     if ($showval eq $name) {
                   3072:         $result .= ' checked="checked"';
                   3073:     }
                   3074:     $result .= ' />'.&mt($description).'</label> ';
1.383     albertel 3075:     }
                   3076:     return $result;
                   3077: }
                   3078: 
1.389     www      3079: #
                   3080: # Shift all start and end dates by $shift
                   3081: #
                   3082: 
                   3083: sub dateshift {
                   3084:     my ($shift)=@_;
                   3085:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3086:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3087:     my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   3088: # ugly retro fix for broken version of types
                   3089:     foreach my $key (keys %data) {
                   3090:         if ($key=~/\wtype$/) {
                   3091:             my $newkey=$key;
                   3092:             $newkey=~s/type$/\.type/;
                   3093:             $data{$newkey}=$data{$key};
                   3094:             delete $data{$key};
                   3095:         }
                   3096:     }
1.391     www      3097:     my %storecontent=();
1.389     www      3098: # go through all parameters and look for dates
                   3099:     foreach my $key (keys %data) {
                   3100:        if ($data{$key.'.type'}=~/^date_(start|end)$/) {
                   3101:           my $newdate=$data{$key}+$shift;
1.391     www      3102:           $storecontent{$key}=$newdate;
1.389     www      3103:        }
                   3104:     }
1.391     www      3105:     my $reply=&Apache::lonnet::cput
                   3106:                 ('resourcedata',\%storecontent,$dom,$crs);
                   3107:     if ($reply eq 'ok') {
                   3108:        &log_parmset(\%storecontent);
                   3109:     }
                   3110:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
                   3111:     return $reply;
1.389     www      3112: }
                   3113: 
1.208     www      3114: sub newoverview {
1.280     albertel 3115:     my ($r) = @_;
                   3116: 
1.208     www      3117:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3118:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.414     droeschl 3119:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 3120:         text=>"Overview Mode"});
1.280     albertel 3121:     my $start_page = &Apache::loncommon::start_page('Set Parameters');
1.298     albertel 3122:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.208     www      3123:     $r->print(<<ENDOVER);
1.280     albertel 3124: $start_page
1.208     www      3125: $breadcrumbs
1.232     albertel 3126: <form method="post" action="/adm/parmset?action=newoverview" name="parmform">
1.208     www      3127: ENDOVER
1.211     www      3128:     my @ids=();
                   3129:     my %typep=();
                   3130:     my %keyp=();
                   3131:     my %allparms=();
                   3132:     my %allparts=();
                   3133:     my %allmaps=();
                   3134:     my %mapp=();
                   3135:     my %symbp=();
                   3136:     my %maptitles=();
                   3137:     my %uris=();
                   3138:     my %keyorder=&standardkeyorder();
                   3139:     my %defkeytype=();
                   3140: 
                   3141:     my %alllevs=();
                   3142:     $alllevs{'Resource Level'}='full';
1.215     www      3143:     $alllevs{'Map/Folder Level'}='map';
1.211     www      3144:     $alllevs{'Course Level'}='general';
                   3145: 
                   3146:     my $csec=$env{'form.csec'};
1.269     raeburn  3147:     my $cgroup=$env{'form.cgroup'};
1.211     www      3148: 
                   3149:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   3150:     my $pschp=$env{'form.pschp'};
                   3151:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
                   3152:     if (!@psprt) { $psprt[0]='0'; }
                   3153: 
1.446     bisitz   3154:     my @selected_sections =
1.473     amueller 3155:     &Apache::loncommon::get_env_multiple('form.Section');
1.211     www      3156:     @selected_sections = ('all') if (! @selected_sections);
1.374     albertel 3157:     foreach my $sec (@selected_sections) {
                   3158:         if ($sec eq 'all') {
1.211     www      3159:             @selected_sections = ('all');
                   3160:         }
                   3161:     }
1.269     raeburn  3162:     my @selected_groups =
                   3163:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      3164: 
                   3165:     my $pssymb='';
                   3166:     my $parmlev='';
1.446     bisitz   3167: 
1.211     www      3168:     unless ($env{'form.parmlev'}) {
                   3169:         $parmlev = 'map';
                   3170:     } else {
                   3171:         $parmlev = $env{'form.parmlev'};
                   3172:     }
                   3173: 
1.446     bisitz   3174:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 3175:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   3176:                 \%keyorder,\%defkeytype);
1.211     www      3177: 
1.374     albertel 3178:     if (grep {$_ eq 'all'} (@psprt)) {
1.481     amueller 3179:         @psprt = keys(%allparts);
1.374     albertel 3180:     }
1.211     www      3181: # Menu to select levels, etc
                   3182: 
1.445     neumanie 3183:     #$r->print('<table id="LC_parm_overview_scope">
                   3184:     #           <tr><td class="LC_parm_overview_level_menu">');
1.456     bisitz   3185:     $r->print('<div class="LC_Box">');
1.445     neumanie 3186:     #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452     bisitz   3187:     $r->print('<div>');
1.445     neumanie 3188:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.211     www      3189:     &levelmenu($r,\%alllevs,$parmlev);
                   3190:     if ($parmlev ne 'general') {
1.481     amueller 3191:         #$r->print('<td class="LC_parm_overview_map_menu">');
1.447     bisitz   3192:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.481     amueller 3193:         &mapmenu($r,\%allmaps,$pschp,\%maptitles);
                   3194:         #$r->print('</td>');
1.211     www      3195:     }
1.447     bisitz   3196:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 3197:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3198:     $r->print('</div></div>');
                   3199:     #$r->print('</td></tr></table>');
1.446     bisitz   3200: 
1.445     neumanie 3201:     #$r->print('<table id="LC_parm_overview_controls">
                   3202:     #           <tr><td class="LC_parm_overview_parm_selectors">');
1.456     bisitz   3203:     $r->print('<div class="LC_Box">');
1.452     bisitz   3204:     $r->print('<div>');
1.446     bisitz   3205:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.445     neumanie 3206:     &parmmenu($r,\%allparms,\@pscat,\%keyorder);
1.453     schualex 3207:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3208:     &parmboxes($r,\%allparms,\@pscat,\%keyorder);
                   3209:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   3210:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.445     neumanie 3211:     #$r->print('</td><td class="LC_parm_overview_restrictions">'.
1.481     amueller 3212:     $r->print('<table>'.
1.317     albertel 3213:               '<tr><th>'.&mt('Parts').'</th><th>'.&mt('Section(s)').
                   3214:               '</th><th>'.&mt('Group(s)').'</th></tr><tr><td>');
1.211     www      3215:     &partmenu($r,\%allparts,\@psprt);
1.317     albertel 3216:     $r->print('</td><td>');
1.211     www      3217:     &sectionmenu($r,\@selected_sections);
1.317     albertel 3218:     $r->print('</td><td>');
1.269     raeburn  3219:     &groupmenu($r,\@selected_groups);
                   3220:     $r->print('</td></tr></table>');
1.445     neumanie 3221:     #$r->print('</td></tr></table>');
1.447     bisitz   3222:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 3223:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3224:     $r->print('</div></div>');
                   3225: 
1.456     bisitz   3226:     $r->print('<div class="LC_Box">');
1.452     bisitz   3227:     $r->print('<div>');
1.214     www      3228:     my $sortorder=$env{'form.sortorder'};
                   3229:     unless ($sortorder) { $sortorder='realmstudent'; }
                   3230:     &sortmenu($r,$sortorder);
1.445     neumanie 3231:     $r->print('</div></div>');
1.446     bisitz   3232: 
1.214     www      3233:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446     bisitz   3234: 
1.211     www      3235: # Build the list data hash from the specified parms
                   3236: 
                   3237:     my $listdata;
                   3238:     %{$listdata}=();
                   3239: 
                   3240:     foreach my $cat (@pscat) {
1.269     raeburn  3241:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   3242:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      3243:     }
                   3244: 
1.212     www      3245:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      3246: 
1.481     amueller 3247:         if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      3248: 
                   3249: # Read modified data
                   3250: 
1.481     amueller 3251:         my $resourcedata=&readdata($crs,$dom);
1.211     www      3252: 
                   3253: # List data
                   3254: 
1.481     amueller 3255:         &listdata($r,$resourcedata,$listdata,$sortorder);
1.211     www      3256:     }
                   3257:     $r->print(&tableend().
1.473     amueller 3258:          ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'').
                   3259:           '</form>'.&Apache::loncommon::end_page());
1.208     www      3260: }
                   3261: 
1.269     raeburn  3262: sub secgroup_lister {
                   3263:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   3264:     foreach my $item (@{$selections}) {
                   3265:         foreach my $part (@{$psprt}) {
                   3266:             my $rootparmkey=$env{'request.course.id'};
                   3267:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   3268:                 $rootparmkey.='.['.$item.']';
                   3269:             }
                   3270:             if ($parmlev eq 'general') {
                   3271: # course-level parameter
                   3272:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   3273:                 $$listdata{$newparmkey}=1;
                   3274:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   3275:             } elsif ($parmlev eq 'map') {
                   3276: # map-level parameter
                   3277:                 foreach my $mapid (keys %{$allmaps}) {
                   3278:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   3279:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   3280:                     $$listdata{$newparmkey}=1;
                   3281:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   3282:                 }
                   3283:             } else {
                   3284: # resource-level parameter
                   3285:                 foreach my $rid (@{$ids}) {
                   3286:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   3287:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   3288:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   3289:                     $$listdata{$newparmkey}=1;
                   3290:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   3291:                 }
                   3292:             }
                   3293:         }
                   3294:     }
                   3295: }
                   3296: 
1.208     www      3297: sub overview {
1.280     albertel 3298:     my ($r) = @_;
1.208     www      3299:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3300:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.280     albertel 3301: 
1.414     droeschl 3302:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 3303:     text=>"Overview Mode"});
1.280     albertel 3304:     my $start_page=&Apache::loncommon::start_page('Modify Parameters');
1.298     albertel 3305:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.208     www      3306:     $r->print(<<ENDOVER);
1.280     albertel 3307: $start_page
1.208     www      3308: $breadcrumbs
1.232     albertel 3309: <form method="post" action="/adm/parmset?action=setoverview" name="parmform">
1.208     www      3310: ENDOVER
                   3311: # Store modified
                   3312: 
                   3313:     &storedata($r,$crs,$dom);
                   3314: 
                   3315: # Read modified data
                   3316: 
                   3317:     my $resourcedata=&readdata($crs,$dom);
                   3318: 
1.214     www      3319: 
                   3320:     my $sortorder=$env{'form.sortorder'};
                   3321:     unless ($sortorder) { $sortorder='realmstudent'; }
                   3322:     &sortmenu($r,$sortorder);
                   3323: 
1.208     www      3324: # List data
                   3325: 
1.214     www      3326:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder);
1.208     www      3327: 
1.145     www      3328:     $r->print(&tableend().'<p>'.
1.473     amueller 3329:     ($foundkeys?'<input type="submit" value="'.&mt('Save').'" />':&mt('There are no parameters.')).'</p></form>'.
                   3330:           &Apache::loncommon::end_page());
1.120     www      3331: }
1.121     www      3332: 
1.333     albertel 3333: sub clean_parameters {
                   3334:     my ($r) = @_;
                   3335:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3336:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3337: 
1.414     droeschl 3338:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
1.473     amueller 3339:         text=>"Clean Parameters"});
1.333     albertel 3340:     my $start_page=&Apache::loncommon::start_page('Clean Parameters');
                   3341:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
                   3342:     $r->print(<<ENDOVER);
                   3343: $start_page
                   3344: $breadcrumbs
                   3345: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
                   3346: ENDOVER
                   3347: # Store modified
                   3348: 
                   3349:     &storedata($r,$crs,$dom);
                   3350: 
                   3351: # Read modified data
                   3352: 
                   3353:     my $resourcedata=&readdata($crs,$dom);
                   3354: 
                   3355: # List data
                   3356: 
                   3357:     $r->print('<h3>'.
1.473     amueller 3358:           &mt('These parameters refer to resources that do not exist.').
                   3359:           '</h3>'.
                   3360:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
                   3361:           '<br />');
1.333     albertel 3362:     $r->print(&Apache::loncommon::start_data_table().
1.473     amueller 3363:           '<tr>'.
                   3364:           '<th>'.&mt('Delete').'</th>'.
                   3365:           '<th>'.&mt('Parameter').'</th>'.
                   3366:           '</tr>');
1.333     albertel 3367:     foreach my $thiskey (sort(keys(%{$resourcedata}))) {
1.473     amueller 3368:     next if (!exists($resourcedata->{$thiskey.'.type'})
                   3369:          && $thiskey=~/\.type$/);
                   3370:     my %data = &parse_key($thiskey);
                   3371:     if (1) { #exists($data{'realm_exists'})
                   3372:         #&& !$data{'realm_exists'}) {
                   3373:         $r->print(&Apache::loncommon::start_data_table_row().
                   3374:               '<tr>'.
                   3375:               '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>'              );
                   3376: 
                   3377:         $r->print('<td>');
                   3378:         my $display_value = $resourcedata->{$thiskey};
                   3379:         if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
                   3380:         $display_value =
                   3381:             &Apache::lonlocal::locallocaltime($display_value);
                   3382:         }
1.470     raeburn  3383:             my $parmitem = &standard_parameter_names($data{'parameter_name'});
                   3384:             $parmitem = &mt($parmitem);
1.473     amueller 3385:         $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
                   3386:               $parmitem,$resourcedata->{$thiskey}));
                   3387:         $r->print('<br />');
                   3388:         if ($data{'scope_type'} eq 'all') {
                   3389:         $r->print(&mt('All users'));
                   3390:         } elsif ($data{'scope_type'} eq 'user') {
                   3391:         $r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
                   3392:         } elsif ($data{'scope_type'} eq 'section') {
                   3393:         $r->print(&mt('Section: [_1]',$data{'scope'}));
                   3394:         } elsif ($data{'scope_type'} eq 'group') {
                   3395:         $r->print(&mt('Group: [_1]',$data{'scope'}));
                   3396:         }
                   3397:         $r->print('<br />');
                   3398:         if ($data{'realm_type'} eq 'all') {
                   3399:         $r->print(&mt('All Resources'));
                   3400:         } elsif ($data{'realm_type'} eq 'folder') {
                   3401:         $r->print(&mt('Folder: [_1]'),$data{'realm'});
                   3402:         } elsif ($data{'realm_type'} eq 'symb') {
                   3403:         my ($map,$resid,$url) =
                   3404:             &Apache::lonnet::decode_symb($data{'realm'});
                   3405:         $r->print(&mt('Resource: [_1] <br />&nbsp;&nbsp;&nbsp;with ID: [_2] <br />&nbsp;&nbsp;&nbsp;in folder [_3]',
                   3406:                   $url,$resid,$map));
                   3407:         }
                   3408:         $r->print(' <br />&nbsp;&nbsp;&nbsp;'.&mt('Part: [_1]',$data{'parameter_part'}));
                   3409:         $r->print('</td></tr>');
1.446     bisitz   3410: 
1.473     amueller 3411:     }
1.333     albertel 3412:     }
                   3413:     $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.473     amueller 3414:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.
                   3415:           '</p></form>'.
                   3416:           &Apache::loncommon::end_page());
1.333     albertel 3417: }
                   3418: 
1.390     www      3419: sub date_shift_one {
                   3420:     my ($r) = @_;
                   3421:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3422:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3423: 
1.414     droeschl 3424:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 3425:         text=>"Shifting Dates"});
1.390     www      3426:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   3427:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
                   3428:     $r->print(<<ENDOVER);
                   3429: $start_page
                   3430: $breadcrumbs
                   3431: ENDOVER
                   3432:     $r->print('<form name="shiftform" method="post">'.
                   3433:               '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
                   3434:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
                   3435:               '<tr><td>'.&mt('Shifted date:').'</td><td>'.
                   3436:                     &Apache::lonhtmlcommon::date_setter('shiftform',
                   3437:                                                         'timeshifted',
                   3438:                                                         $env{'form.timebase'},,
                   3439:                                                         '').
                   3440:               '</td></tr></table>'.
                   3441:               '<input type="hidden" name="action" value="dateshift2" />'.
                   3442:               '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
                   3443:               '<input type="submit" value="'.&mt('Shift all dates accordingly').'" /></form>');
                   3444:     $r->print(&Apache::loncommon::end_page());
                   3445: }
                   3446: 
                   3447: sub date_shift_two {
                   3448:     my ($r) = @_;
                   3449:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3450:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.414     droeschl 3451:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 3452:         text=>"Shifting Dates"});
1.390     www      3453:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   3454:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
                   3455:     $r->print(<<ENDOVER);
                   3456: $start_page
                   3457: $breadcrumbs
                   3458: ENDOVER
                   3459:     my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
                   3460:     $r->print(&mt('Shifting all dates such that [_1] becomes [_2]',
                   3461:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
                   3462:               &Apache::lonlocal::locallocaltime($timeshifted)));
                   3463:     my $delta=$timeshifted-$env{'form.timebase'};
                   3464:     &dateshift($delta);
                   3465:     $r->print(&Apache::loncommon::end_page());
                   3466: }
                   3467: 
1.333     albertel 3468: sub parse_key {
                   3469:     my ($key) = @_;
                   3470:     my %data;
                   3471:     my ($middle,$part,$name)=
1.473     amueller 3472:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.333     albertel 3473:     $data{'scope_type'} = 'all';
                   3474:     if ($middle=~/^\[(.*)\]/) {
1.473     amueller 3475:            $data{'scope'} = $1;
                   3476:     if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
                   3477:         $data{'scope_type'} = 'user';
                   3478:         $data{'scope'} = [$1,$2];
                   3479:     } else {
                   3480:         #FIXME check for group scope
                   3481:         $data{'scope_type'} = 'section';
                   3482:     }
                   3483:     $middle=~s/^\[(.*)\]//;
1.333     albertel 3484:     }
                   3485:     $middle=~s/\.+$//;
                   3486:     $middle=~s/^\.+//;
                   3487:     $data{'realm_type'}='all';
                   3488:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.473     amueller 3489:     $data{'realm'} = $1;
                   3490:     $data{'realm_type'} = 'folder';
                   3491:     $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   3492:     ($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
1.333     albertel 3493:     } elsif ($middle) {
1.473     amueller 3494:     $data{'realm'} = $middle;
                   3495:     $data{'realm_type'} = 'symb';
                   3496:     $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   3497:     my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
                   3498:     $data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
1.333     albertel 3499:     }
1.446     bisitz   3500: 
1.333     albertel 3501:     $data{'parameter_part'} = $part;
                   3502:     $data{'parameter_name'} = $name;
                   3503: 
                   3504:     return %data;
                   3505: }
                   3506: 
1.239     raeburn  3507: 
1.178     raeburn  3508: 
1.239     raeburn  3509: sub extract_cloners {
                   3510:     my ($clonelist,$allowclone) = @_;
                   3511:     if ($clonelist =~ /,/) {
1.380     albertel 3512:         @{$allowclone} = split(/,/,$clonelist);
1.239     raeburn  3513:     } else {
                   3514:         $$allowclone[0] = $clonelist;
                   3515:     }
                   3516: }
                   3517: 
                   3518: sub check_cloners {
                   3519:     my ($clonelist,$oldcloner) = @_;
1.379     raeburn  3520:     my ($clean_clonelist,%disallowed);
1.239     raeburn  3521:     my @allowclone = ();
                   3522:     &extract_cloners($$clonelist,\@allowclone);
                   3523:     foreach my $currclone (@allowclone) {
1.380     albertel 3524:         if (!grep(/^\Q$currclone\E$/,@$oldcloner)) {
1.379     raeburn  3525:             if ($currclone eq '*') {
                   3526:                 $clean_clonelist .= $currclone.',';
                   3527:             } else {
                   3528:                 my ($uname,$udom) = split(/:/,$currclone);
                   3529:                 if ($uname eq '*') {
                   3530:                     if ($udom =~ /^$match_domain$/) {
1.380     albertel 3531:                         if (!&Apache::lonnet::domain($udom)) {
1.379     raeburn  3532:                             $disallowed{'domain'} .= $currclone.',';
                   3533:                         } else {
                   3534:                             $clean_clonelist .= $currclone.',';
                   3535:                         }
                   3536:                     } else {
                   3537:                         $disallowed{'format'} .= $currclone.',';
                   3538:                     }
                   3539:                 } elsif ($currclone !~/^($match_username)\:($match_domain)$/) {
1.446     bisitz   3540:                     $disallowed{'format'} .= $currclone.',';
1.239     raeburn  3541:                 } else {
1.379     raeburn  3542:                     if (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   3543:                         $disallowed{'newuser'} .= $currclone.',';
                   3544:                     } else {
                   3545:                         $clean_clonelist .= $currclone.',';
                   3546:                     }
1.239     raeburn  3547:                 }
                   3548:             }
                   3549:         } else {
                   3550:             $clean_clonelist .= $currclone.',';
                   3551:         }
                   3552:     }
1.379     raeburn  3553:     foreach my $key (keys(%disallowed)) {
                   3554:         $disallowed{$key} =~ s/,$//;
1.239     raeburn  3555:     }
                   3556:     if ($clean_clonelist) {
                   3557:         $clean_clonelist =~ s/,$//;
                   3558:     }
                   3559:     $$clonelist = $clean_clonelist;
1.379     raeburn  3560:     return %disallowed;
                   3561: }
1.178     raeburn  3562: 
                   3563: sub change_clone {
                   3564:     my ($clonelist,$oldcloner) = @_;
                   3565:     my ($uname,$udom);
1.190     albertel 3566:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3567:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.178     raeburn  3568:     my $clone_crs = $cnum.':'.$cdom;
1.446     bisitz   3569: 
1.178     raeburn  3570:     if ($cnum && $cdom) {
1.239     raeburn  3571:         my @allowclone;
                   3572:         &extract_cloners($clonelist,\@allowclone);
1.178     raeburn  3573:         foreach my $currclone (@allowclone) {
1.380     albertel 3574:             if (!grep(/^$currclone$/,@$oldcloner)) {
1.379     raeburn  3575:                 if ($currclone ne '*') {
1.380     albertel 3576:                     ($uname,$udom) = split(/:/,$currclone);
1.379     raeburn  3577:                     if ($uname && $udom && $uname ne '*') {
                   3578:                         if (&Apache::lonnet::homeserver($uname,$udom) ne 'no_host') {
                   3579:                             my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   3580:                             if ($currclonecrs{'cloneable'} !~ /\Q$clone_crs\E/) {
                   3581:                                 if ($currclonecrs{'cloneable'} eq '') {
                   3582:                                     $currclonecrs{'cloneable'} = $clone_crs;
                   3583:                                 } else {
                   3584:                                     $currclonecrs{'cloneable'} .= ','.$clone_crs;
                   3585:                                 }
                   3586:                                 &Apache::lonnet::put('environment',\%currclonecrs,$udom,$uname);
1.178     raeburn  3587:                             }
                   3588:                         }
                   3589:                     }
                   3590:                 }
                   3591:             }
                   3592:         }
                   3593:         foreach my $oldclone (@$oldcloner) {
1.380     albertel 3594:             if (!grep(/^\Q$oldclone\E$/,@allowclone)) {
1.379     raeburn  3595:                 if ($oldclone ne '*') {
1.380     albertel 3596:                     ($uname,$udom) = split(/:/,$oldclone);
1.379     raeburn  3597:                     if ($uname && $udom && $uname ne '*' ) {
                   3598:                         if (&Apache::lonnet::homeserver($uname,$udom) ne 'no_host') {
                   3599:                             my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   3600:                             my %newclonecrs = ();
                   3601:                             if ($currclonecrs{'cloneable'} =~ /\Q$clone_crs\E/) {
                   3602:                                 if ($currclonecrs{'cloneable'} =~ /,/) {
                   3603:                                     my @currclonecrs = split/,/,$currclonecrs{'cloneable'};
                   3604:                                     foreach my $crs (@currclonecrs) {
                   3605:                                         if ($crs ne $clone_crs) {
                   3606:                                             $newclonecrs{'cloneable'} .= $crs.',';
                   3607:                                         }
1.178     raeburn  3608:                                     }
1.379     raeburn  3609:                                     $newclonecrs{'cloneable'} =~ s/,$//;
                   3610:                                 } else {
                   3611:                                     $newclonecrs{'cloneable'} = '';
1.178     raeburn  3612:                                 }
1.379     raeburn  3613:                                 &Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname);
1.178     raeburn  3614:                             }
                   3615:                         }
                   3616:                     }
                   3617:                 }
                   3618:             }
                   3619:         }
                   3620:     }
                   3621: }
                   3622: 
1.193     albertel 3623: 
                   3624: 
1.416     jms      3625: sub header {
                   3626:     return &Apache::loncommon::start_page('Parameter Manager');
                   3627: }
1.193     albertel 3628: 
                   3629: 
                   3630: 
                   3631: sub print_main_menu {
                   3632:     my ($r,$parm_permission)=@_;
                   3633:     #
1.414     droeschl 3634:     $r->print(&header());
                   3635:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Manager'));
1.193     albertel 3636:     $r->print(<<ENDMAINFORMHEAD);
                   3637: <form method="post" enctype="multipart/form-data"
                   3638:       action="/adm/parmset" name="studentform">
                   3639: ENDMAINFORMHEAD
                   3640: #
1.195     albertel 3641:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3642:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 3643:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366     albertel 3644:     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.268     albertel 3645: 
1.477     raeburn  3646:     my $crstype = &Apache::loncommon::course_type();
                   3647:     my $lc_crstype = lc($crstype);
1.417     droeschl 3648: 
1.193     albertel 3649:     my @menu =
1.477     raeburn  3650:         ( { categorytitle=>"Settings for this $crstype",
1.473     amueller 3651:         items => [
1.477     raeburn  3652:           { linktext => "$crstype Configuration",
1.473     amueller 3653:             url => '/adm/courseprefs?origin=params',
                   3654:             permission => $parm_permission,
1.477     raeburn  3655:             linktitle => "Edit $lc_crstype configuration."  ,
1.473     amueller 3656:             icon => 'preferences-desktop-remote-desktop.png'  ,
                   3657:             #help => 'Course_Environment',
                   3658:             },
                   3659:           { linktext => 'Portfolio Metadata',
                   3660:             url => '/adm/parmset?action=setrestrictmeta',
                   3661:             permission => $parm_permission,
1.477     raeburn  3662:             linktitle => "Restrict metadata for this $lc_crstype." ,
1.473     amueller 3663:             icon =>'contact-new.png'   ,
                   3664:             },
1.477     raeburn  3665:           { linktext => "Manage $crstype Slots",
1.473     amueller 3666:             url => '/adm/slotrequest?command=showslots',
                   3667:             permission => $vgr,
1.477     raeburn  3668:             linktitle => "Manage slots for this $lc_crstype."  ,
1.473     amueller 3669:             icon => 'format-justify-fill.png'  ,
                   3670:             },
                   3671:           { linktext => 'Reset Student Access Times',
                   3672:             url => '/adm/helper/resettimes.helper',
                   3673:             permission => $mgr,
1.477     raeburn  3674:             linktitle => "Reset access times for folders/maps, resources or the $lc_crstype."  ,
1.473     amueller 3675:             icon => 'start-here.png'  ,
                   3676:             },
                   3677: 
                   3678:           { linktext => 'Set Parameter Setting Default Actions',
                   3679:             url => '/adm/parmset?action=setdefaults',
                   3680:             permission => $parm_permission,
                   3681:             linktitle =>'Set default actions for parameters.'  ,
                   3682:             icon => 'folder-new.png'  ,
                   3683:             }]},
                   3684:       { categorytitle => 'New and Existing Parameter Settings for Resources',
                   3685:         items => [
                   3686:           { linktext => 'Edit Resource Parameters - Helper Mode',
                   3687:             url => '/adm/helper/parameter.helper',
                   3688:             permission => $parm_permission,
                   3689:             linktitle =>'Set/Modify resource parameters in helper mode.'  ,
                   3690:             icon => 'dialog-information.png'  ,
                   3691:             #help => 'Parameter_Helper',
                   3692:             },
                   3693:           { linktext => 'Edit Resource Parameters - Overview Mode',
                   3694:             url => '/adm/parmset?action=newoverview',
                   3695:             permission => $parm_permission,
                   3696:             linktitle =>'Set/Modify resource parameters in overview mode.'  ,
                   3697:             icon => 'edit-find.png'  ,
                   3698:             #help => 'Parameter_Overview',
                   3699:             },
                   3700:           { linktext => 'Edit Resource Parameters - Table Mode',
                   3701:             url => '/adm/parmset?action=settable',
                   3702:             permission => $parm_permission,
                   3703:             linktitle =>'Set/Modify resource parameters in table mode.'  ,
                   3704:             icon => 'edit-copy.png'  ,
                   3705:             #help => 'Table_Mode',
                   3706:             }]},
1.417     droeschl 3707:            { categorytitle => 'Existing Parameter Settings for Resources',
1.473     amueller 3708:          items => [
                   3709:           { linktext => 'Modify Resource Parameters - Overview Mode',
                   3710:             url => '/adm/parmset?action=setoverview',
                   3711:             permission => $parm_permission,
                   3712:             linktitle =>'Set/Modify existing resource parameters in overview mode.'  ,
                   3713:             icon => 'preferences-desktop-wallpaper.png'  ,
                   3714:             #help => 'Parameter_Overview',
                   3715:             },
                   3716:           { linktext => 'Change Log',
                   3717:             url => '/adm/parmset?action=parameterchangelog',
                   3718:             permission => $parm_permission,
1.477     raeburn  3719:             linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,
1.473     amueller 3720:             icon => 'emblem-system.png'   ,
                   3721:             }]}
1.193     albertel 3722:           );
1.414     droeschl 3723:     $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.193     albertel 3724:     return;
                   3725: }
1.414     droeschl 3726: 
1.416     jms      3727: 
                   3728: 
1.252     banghart 3729: sub output_row {
1.347     banghart 3730:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 3731:     my $output;
1.263     banghart 3732:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   3733:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 3734:     if (!defined($options)) {
1.254     banghart 3735:         $options = 'active,stuadd';
1.261     banghart 3736:         $values = '';
1.252     banghart 3737:     }
1.337     banghart 3738:     if (!($options =~ /deleted/)) {
                   3739:         my @options= ( ['active', 'Show to student'],
1.418     schafran 3740:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 3741:                     ['choices','Provide choices for students to select from']);
1.473     amueller 3742: #           ['onlyone','Student may select only one choice']);
1.337     banghart 3743:         if ($added_flag) {
                   3744:             push @options,['deleted', 'Delete Metadata Field'];
                   3745:         }
1.351     banghart 3746:        $output = &Apache::loncommon::start_data_table_row();
1.451     bisitz   3747:         $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351     banghart 3748:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 3749:         foreach my $opt (@options) {
1.473     amueller 3750:         my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   3751:         $output .= &Apache::loncommon::continue_data_table_row();
                   3752:         $output .= '<td>'.('&nbsp;' x 5).'<label>
                   3753:                    <input type="checkbox" name="'.
                   3754:                    $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   3755:                    &mt($opt->[1]).'</label></td>';
                   3756:         $output .= &Apache::loncommon::end_data_table_row();
                   3757:     }
1.351     banghart 3758:         $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   3759:         $output .= '<td>'.('&nbsp;' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351     banghart 3760:         $output .= &Apache::loncommon::end_data_table_row();
                   3761:         my $multiple_checked;
                   3762:         my $single_checked;
                   3763:         if ($options =~ m/onlyone/) {
1.422     bisitz   3764:             $multiple_checked = '';
1.423     bisitz   3765:             $single_checked = ' checked="checked"';
1.351     banghart 3766:         } else {
1.423     bisitz   3767:             $multiple_checked = ' checked="checked"';
1.422     bisitz   3768:             $single_checked = '';
1.351     banghart 3769:         }
1.473     amueller 3770:     $output .= &Apache::loncommon::continue_data_table_row();
                   3771:     $output .= '<td>'.('&nbsp;' x 10).'
                   3772:                 <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
                   3773:                 '.&mt('Student may select multiple choices from list').'</td>';
                   3774:     $output .= &Apache::loncommon::end_data_table_row();
                   3775:     $output .= &Apache::loncommon::continue_data_table_row();
                   3776:     $output .= '<td>'.('&nbsp;' x 10).'
                   3777:                 <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />
                   3778:                 '.&mt('Student may select only one choice from list').'</td>';
                   3779:     $output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 3780:     }
                   3781:     return ($output);
                   3782: }
1.416     jms      3783: 
                   3784: 
                   3785: 
1.340     banghart 3786: sub order_meta_fields {
                   3787:     my ($r)=@_;
                   3788:     my $idx = 1;
                   3789:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3790:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.341     banghart 3791:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.414     droeschl 3792:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 3793:         text=>"Add Metadata Field"});
1.345     banghart 3794:     &Apache::lonhtmlcommon::add_breadcrumb
                   3795:             ({href=>"/adm/parmset?action=setrestrictmeta",
                   3796:               text=>"Restrict Metadata"},
                   3797:              {text=>"Order Metadata"});
                   3798:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.340     banghart 3799:     if ($env{'form.storeorder'}) {
                   3800:         my $newpos = $env{'form.newpos'} - 1;
                   3801:         my $currentpos = $env{'form.currentpos'} - 1;
                   3802:         my @neworder = ();
                   3803:         my @oldorder = split /,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'};
                   3804:         my $i;
1.341     banghart 3805:         if ($newpos > $currentpos) {
1.340     banghart 3806:         # moving stuff up
                   3807:             for ($i=0;$i<$currentpos;$i++) {
1.473     amueller 3808:             $neworder[$i]=$oldorder[$i];
1.340     banghart 3809:             }
                   3810:             for ($i=$currentpos;$i<$newpos;$i++) {
1.473     amueller 3811:             $neworder[$i]=$oldorder[$i+1];
1.340     banghart 3812:             }
                   3813:             $neworder[$newpos]=$oldorder[$currentpos];
                   3814:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
1.473     amueller 3815:             $neworder[$i]=$oldorder[$i];
1.340     banghart 3816:             }
                   3817:         } else {
                   3818:         # moving stuff down
1.473     amueller 3819:             for ($i=0;$i<$newpos;$i++) {
                   3820:                 $neworder[$i]=$oldorder[$i];
                   3821:             }
                   3822:             $neworder[$newpos]=$oldorder[$currentpos];
                   3823:             for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   3824:                 $neworder[$i]=$oldorder[$i-1];
                   3825:             }
                   3826:             for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   3827:                 $neworder[$i]=$oldorder[$i];
                   3828:             }
1.340     banghart 3829:         }
1.473     amueller 3830:     my $ordered_fields = join ",", @neworder;
1.343     banghart 3831:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   3832:                            {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
1.473     amueller 3833:     &Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 3834:     }
1.357     raeburn  3835:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 3836:     my $ordered_fields;
1.340     banghart 3837:     my @fields_in_order = split /,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'};
                   3838:     if (!@fields_in_order) {
                   3839:         # no order found, pick sorted order then create metadata.addedorder key.
                   3840:         foreach my $key (sort keys %$fields) {
                   3841:             push @fields_in_order, $key;
1.341     banghart 3842:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 3843:         }
1.341     banghart 3844:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   3845:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   3846:     }
1.340     banghart 3847:     $r->print('<table>');
                   3848:     my $num_fields = scalar(@fields_in_order);
                   3849:     foreach my $key (@fields_in_order) {
                   3850:         $r->print('<tr><td>');
                   3851:         $r->print('<form method="post" action="">');
                   3852:         $r->print('<select name="newpos" onChange="this.form.submit()">');
                   3853:         for (my $i = 1;$i le $num_fields;$i ++) {
                   3854:             if ($i eq $idx) {
                   3855:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   3856:             } else {
                   3857:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   3858:             }
                   3859:         }
                   3860:         $r->print('</select></td><td>');
                   3861:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   3862:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   3863:         $r->print('</form>');
                   3864:         $r->print($$fields{$key}.'</td></tr>');
                   3865:         $idx ++;
                   3866:     }
                   3867:     $r->print('</table>');
                   3868:     return 'ok';
                   3869: }
1.416     jms      3870: 
                   3871: 
1.359     banghart 3872: sub continue {
                   3873:     my $output;
                   3874:     $output .= '<form action="" method="post">';
                   3875:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
                   3876:     $output .= '<input type="submit" value="Continue" />';
                   3877:     return ($output);
                   3878: }
1.416     jms      3879: 
                   3880: 
1.334     banghart 3881: sub addmetafield {
                   3882:     my ($r)=@_;
1.414     droeschl 3883:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 3884:         text=>"Add Metadata Field"});
1.334     banghart 3885:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   3886:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 3887:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3888:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.339     banghart 3889:     if (exists($env{'form.undelete'})) {
1.358     banghart 3890:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 3891:         foreach my $meta_field(@meta_fields) {
                   3892:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   3893:             $options =~ s/deleted//;
                   3894:             $options =~ s/,,/,/;
                   3895:             my $put_result = &Apache::lonnet::put('environment',
                   3896:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446     bisitz   3897: 
1.339     banghart 3898:             $r->print('Undeleted Metadata Field <strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}."</strong> with result ".$put_result.'<br />');
                   3899:         }
1.359     banghart 3900:         $r->print(&continue());
1.339     banghart 3901:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 3902:         my $meta_field = $env{'form.fieldname'};
                   3903:         my $display_field = $env{'form.fieldname'};
                   3904:         $meta_field =~ s/\W/_/g;
1.338     banghart 3905:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 3906:         my $put_result = &Apache::lonnet::put('environment',
                   3907:                             {'metadata.'.$meta_field.'.values'=>"",
                   3908:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   3909:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.359     banghart 3910:         $r->print('Added new Metadata Field <strong>'.$env{'form.fieldname'}."</strong> with result ".$put_result.'<br />');
                   3911:         $r->print(&continue());
1.335     banghart 3912:     } else {
1.357     raeburn  3913:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 3914:         if ($fields) {
                   3915:             $r->print('You may undelete previously deleted fields.<br />Check those you wish to undelete and click Undelete.<br />');
                   3916:             $r->print('<form method="post" action="">');
                   3917:             foreach my $key(keys(%$fields)) {
1.358     banghart 3918:                 $r->print('<input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'<br /');
1.339     banghart 3919:             }
                   3920:             $r->print('<input type="submit" name="undelete" value="Undelete" />');
                   3921:             $r->print('</form>');
                   3922:         }
                   3923:         $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 3924:         $r->print('<input type="text" name="fieldname" /><br />');
                   3925:         $r->print('<input type="submit" value="Add Metadata Field" />');
1.334     banghart 3926:     }
1.361     albertel 3927:     $r->print('</form>');
1.334     banghart 3928: }
1.416     jms      3929: 
                   3930: 
                   3931: 
1.259     banghart 3932: sub setrestrictmeta {
1.240     banghart 3933:     my ($r)=@_;
1.242     banghart 3934:     my $next_meta;
1.244     banghart 3935:     my $output;
1.245     banghart 3936:     my $item_num;
1.246     banghart 3937:     my $put_result;
1.414     droeschl 3938:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
1.473     amueller 3939:         text=>"Restrict Metadata"});
1.280     albertel 3940:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 3941:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 3942:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3943:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.259     banghart 3944:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 3945:     my $save_field = '';
1.259     banghart 3946:     if ($env{'form.restrictmeta'}) {
1.254     banghart 3947:         foreach my $field (sort(keys(%env))) {
1.252     banghart 3948:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 3949:                 my $options;
1.252     banghart 3950:                 my $meta_field = $1;
                   3951:                 my $meta_key = $2;
1.253     banghart 3952:                 if ($save_field ne $meta_field) {
1.252     banghart 3953:                     $save_field = $meta_field;
1.473     amueller 3954:                     if ($env{'form.'.$meta_field.'_stuadd'}) {
                   3955:                         $options.='stuadd,';
                   3956:                     }
                   3957:                     if ($env{'form.'.$meta_field.'_choices'}) {
                   3958:                         $options.='choices,';
                   3959:                     }
                   3960:                     if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
                   3961:                         $options.='onlyone,';
                   3962:                     }
                   3963:                     if ($env{'form.'.$meta_field.'_active'}) {
                   3964:                         $options.='active,';
                   3965:                     }
                   3966:                     if ($env{'form.'.$meta_field.'_deleted'}) {
                   3967:                         $options.='deleted,';
                   3968:                     }
1.259     banghart 3969:                     my $name = $save_field;
1.253     banghart 3970:                      $put_result = &Apache::lonnet::put('environment',
1.262     banghart 3971:                                                   {'metadata.'.$meta_field.'.options'=>$options,
                   3972:                                                    'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
1.253     banghart 3973:                                                    },$dom,$crs);
1.252     banghart 3974:                 }
                   3975:             }
                   3976:         }
                   3977:     }
1.296     albertel 3978:     &Apache::lonnet::coursedescription($env{'request.course.id'},
1.473     amueller 3979:                        {'freshen_cache' => 1});
1.335     banghart 3980:     # Get the default metadata fields
1.258     albertel 3981:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 3982:     # Now get possible added metadata fields
1.357     raeburn  3983:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.346     banghart 3984:     my $row_alt = 1;
1.347     banghart 3985:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 3986:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 3987:         if ($field ne 'courserestricted') {
1.346     banghart 3988:             $row_alt = $row_alt ? 0 : 1;
1.473     amueller 3989:         $output.= &output_row($r, $field, $metadata_fields{$field});
                   3990:     }
1.255     banghart 3991:     }
1.351     banghart 3992:     my $buttons = (<<ENDButtons);
                   3993:         <input type="submit" name="restrictmeta" value="Save" />
                   3994:         </form><br />
                   3995:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
                   3996:         <input type="submit" name="restrictmeta" value="Add a Metadata Field" />
                   3997:         </form>
                   3998:         <br />
                   3999:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
                   4000:         <input type="submit" name="restrictmeta" value="Order Metadata Fields" />
                   4001: ENDButtons
1.337     banghart 4002:     my $added_flag = 1;
1.335     banghart 4003:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.346     banghart 4004:         $row_alt = $row_alt ? 0 : 1;
                   4005:         $output.= &output_row($r, $field, $$added_metadata_fields{$field},$added_flag, $row_alt);
1.335     banghart 4006:     }
1.347     banghart 4007:     $output .= &Apache::loncommon::end_data_table();
1.446     bisitz   4008:     $r->print(<<ENDenv);
1.259     banghart 4009:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 4010:         $output
1.351     banghart 4011:         $buttons
1.340     banghart 4012:         </form>
1.244     banghart 4013: ENDenv
1.280     albertel 4014:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 4015:     return 'ok';
                   4016: }
1.416     jms      4017: 
                   4018: 
                   4019: 
1.335     banghart 4020: sub get_added_meta_fieldnames {
1.357     raeburn  4021:     my ($cid) = @_;
1.335     banghart 4022:     my %fields;
                   4023:     foreach my $key(%env) {
1.357     raeburn  4024:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 4025:             my $field_name = $1;
                   4026:             my ($display_field_name) = $env{$key};
                   4027:             $fields{$field_name} = $display_field_name;
                   4028:         }
                   4029:     }
                   4030:     return \%fields;
                   4031: }
1.416     jms      4032: 
                   4033: 
                   4034: 
1.339     banghart 4035: sub get_deleted_meta_fieldnames {
1.357     raeburn  4036:     my ($cid) = @_;
1.339     banghart 4037:     my %fields;
                   4038:     foreach my $key(%env) {
1.357     raeburn  4039:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 4040:             my $field_name = $1;
                   4041:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   4042:                 my ($display_field_name) = $env{$key};
                   4043:                 $fields{$field_name} = $display_field_name;
                   4044:             }
                   4045:         }
                   4046:     }
                   4047:     return \%fields;
                   4048: }
1.220     www      4049: sub defaultsetter {
1.280     albertel 4050:     my ($r) = @_;
                   4051: 
1.414     droeschl 4052:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
1.473     amueller 4053:         text=>"Set Defaults"});
1.446     bisitz   4054:     my $start_page =
1.473     amueller 4055:     &Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 4056:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.220     www      4057:     $r->print(<<ENDDEFHEAD);
1.280     albertel 4058: $start_page
1.220     www      4059: $breadcrumbs
                   4060: <form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">
                   4061: ENDDEFHEAD
1.280     albertel 4062: 
                   4063:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4064:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.221     www      4065:     my @ids=();
                   4066:     my %typep=();
                   4067:     my %keyp=();
                   4068:     my %allparms=();
                   4069:     my %allparts=();
                   4070:     my %allmaps=();
                   4071:     my %mapp=();
                   4072:     my %symbp=();
                   4073:     my %maptitles=();
                   4074:     my %uris=();
                   4075:     my %keyorder=&standardkeyorder();
                   4076:     my %defkeytype=();
                   4077: 
1.446     bisitz   4078:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 4079:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   4080:                 \%keyorder,\%defkeytype);
1.224     www      4081:     if ($env{'form.storerules'}) {
1.473     amueller 4082:     my %newrules=();
                   4083:     my @delrules=();
                   4084:     my %triggers=();
                   4085:     foreach my $key (keys(%env)) {
1.225     albertel 4086:             if ($key=~/^form\.(\w+)\_action$/) {
1.473     amueller 4087:         my $tempkey=$1;
                   4088:         my $action=$env{$key};
1.226     www      4089:                 if ($action) {
1.473     amueller 4090:             $newrules{$tempkey.'_action'}=$action;
                   4091:             if ($action ne 'default') {
                   4092:             my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   4093:             $triggers{$whichparm}.=$tempkey.':';
                   4094:             }
                   4095:             $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
                   4096:             if (&isdateparm($defkeytype{$tempkey})) {
                   4097:             $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
                   4098:             $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   4099:             $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   4100:             $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   4101:             } else {
                   4102:             $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
                   4103:             $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
                   4104:             }
                   4105:         } else {
                   4106:             push(@delrules,$tempkey.'_action');
                   4107:             push(@delrules,$tempkey.'_type');
                   4108:             push(@delrules,$tempkey.'_hours');
                   4109:             push(@delrules,$tempkey.'_min');
                   4110:             push(@delrules,$tempkey.'_sec');
                   4111:             push(@delrules,$tempkey.'_value');
                   4112:         }
                   4113:         }
                   4114:     }
                   4115:     foreach my $key (keys %allparms) {
                   4116:         $newrules{$key.'_triggers'}=$triggers{$key};
                   4117:     }
                   4118:     &Apache::lonnet::put('parmdefactions',\%newrules,$dom,$crs);
                   4119:     &Apache::lonnet::del('parmdefactions',\@delrules,$dom,$crs);
                   4120:     &resetrulescache();
1.224     www      4121:     }
1.227     www      4122:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
1.473     amueller 4123:                        'hours' => 'Hours',
                   4124:                        'min' => 'Minutes',
                   4125:                        'sec' => 'Seconds',
                   4126:                        'yes' => 'Yes',
                   4127:                        'no' => 'No');
1.222     www      4128:     my @standardoptions=('','default');
                   4129:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   4130:     my @dateoptions=('','default');
                   4131:     my @datedisplay=('',&mt('Default value when manually setting'));
                   4132:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.473     amueller 4133:     unless ($tempkey) { next; }
                   4134:     push @standardoptions,'when_setting_'.$tempkey;
                   4135:     push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   4136:     if (&isdateparm($defkeytype{$tempkey})) {
                   4137:         push @dateoptions,'later_than_'.$tempkey;
                   4138:         push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   4139:         push @dateoptions,'earlier_than_'.$tempkey;
                   4140:         push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   4141:     }
1.222     www      4142:     }
1.231     www      4143: $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
1.473     amueller 4144:       &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 4145:     $r->print("\n".&Apache::loncommon::start_data_table().
1.473     amueller 4146:           &Apache::loncommon::start_data_table_header_row().
                   4147:           "<th>".&mt('Rule for parameter').'</th><th>'.
                   4148:           &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   4149:           &Apache::loncommon::end_data_table_header_row());
1.221     www      4150:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.473     amueller 4151:     unless ($tempkey) { next; }
                   4152:     $r->print("\n".&Apache::loncommon::start_data_table_row().
                   4153:           "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
                   4154:     my $action=&rulescache($tempkey.'_action');
                   4155:     $r->print('<select name="'.$tempkey.'_action">');
                   4156:     if (&isdateparm($defkeytype{$tempkey})) {
                   4157:         for (my $i=0;$i<=$#dateoptions;$i++) {
                   4158:         if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   4159:         $r->print("\n<option value='$dateoptions[$i]'".
                   4160:               ($dateoptions[$i] eq $action?' selected="selected"':'').
                   4161:               ">$datedisplay[$i]</option>");
                   4162:         }
                   4163:     } else {
                   4164:         for (my $i=0;$i<=$#standardoptions;$i++) {
                   4165:         if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   4166:         $r->print("\n<option value='$standardoptions[$i]'".
                   4167:               ($standardoptions[$i] eq $action?' selected="selected"':'').
                   4168:               ">$standarddisplay[$i]</option>");
                   4169:         }
                   4170:     }
                   4171:     $r->print('</select>');
                   4172:     unless (&isdateparm($defkeytype{$tempkey})) {
                   4173:         $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   4174:               '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
                   4175:     }
                   4176:     $r->print("\n</td><td>\n");
1.222     www      4177: 
1.221     www      4178:         if (&isdateparm($defkeytype{$tempkey})) {
1.473     amueller 4179:         my $days=&rulescache($tempkey.'_days');
                   4180:         my $hours=&rulescache($tempkey.'_hours');
                   4181:         my $min=&rulescache($tempkey.'_min');
                   4182:         my $sec=&rulescache($tempkey.'_sec');
                   4183:         $r->print(<<ENDINPUTDATE);
1.227     www      4184: <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
1.222     www      4185: <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   4186: <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   4187: <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.221     www      4188: ENDINPUTDATE
1.473     amueller 4189:     } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
1.222     www      4190:             my $yeschecked='';
                   4191:             my $nochecked='';
1.444     bisitz   4192:             if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   4193:             if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
1.222     www      4194: 
1.473     amueller 4195:         $r->print(<<ENDYESNO);
1.444     bisitz   4196: <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   4197: <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.221     www      4198: ENDYESNO
                   4199:         } else {
1.473     amueller 4200:         $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
                   4201:     }
1.318     albertel 4202:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      4203:     }
1.318     albertel 4204:     $r->print(&Apache::loncommon::end_data_table().
1.473     amueller 4205:           "\n".'<input type="submit" name="storerules" value="'.
                   4206:           &mt('Save').'" /></form>'."\n".
                   4207:           &Apache::loncommon::end_page());
1.220     www      4208:     return;
                   4209: }
1.193     albertel 4210: 
1.290     www      4211: sub components {
1.330     albertel 4212:     my ($key,$uname,$udom,$exeuser,$exedomain,$typeflag)=@_;
                   4213: 
                   4214:     if ($typeflag) {
1.473     amueller 4215:     $key=~s/\.type$//;
1.290     www      4216:     }
1.330     albertel 4217: 
                   4218:     my ($middle,$part,$name)=
1.473     amueller 4219:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.291     www      4220:     my $issection;
1.330     albertel 4221: 
1.290     www      4222:     my $section=&mt('All Students');
                   4223:     if ($middle=~/^\[(.*)\]/) {
1.473     amueller 4224:     $issection=$1;
                   4225:     $section=&mt('Group/Section').': '.$issection;
                   4226:     $middle=~s/^\[(.*)\]//;
1.290     www      4227:     }
                   4228:     $middle=~s/\.+$//;
                   4229:     $middle=~s/^\.+//;
1.291     www      4230:     if ($uname) {
1.473     amueller 4231:     $section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   4232:     $issection='';
1.291     www      4233:     }
1.316     albertel 4234:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446     bisitz   4235:     my $realmdescription=&mt('all resources');
1.290     www      4236:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.473     amueller 4237:     $realm='<span class="LC_parm_scope_folder">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <span class="LC_parm_folder"><br />('.$1.')</span></span>';
                   4238:      $realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($1);
1.304     www      4239:    } elsif ($middle) {
1.473     amueller 4240:     my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   4241:     $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>';
                   4242:     $realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      4243:     }
1.291     www      4244:     my $what=$part.'.'.$name;
1.330     albertel 4245:     return ($realm,$section,$name,$part,
1.473     amueller 4246:         $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      4247: }
1.293     www      4248: 
1.328     albertel 4249: my %standard_parms;
1.469     raeburn  4250: my %standard_parms_types;
1.416     jms      4251: 
1.328     albertel 4252: sub load_parameter_names {
                   4253:     open(my $config,"<$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
                   4254:     while (my $configline=<$config>) {
1.473     amueller 4255:     if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   4256:     chomp($configline);
                   4257:     my ($short,$plain)=split(/:/,$configline);
                   4258:     my (undef,$name,$type)=split(/\&/,$short,3);
                   4259:     if ($type eq 'display') {
                   4260:         $standard_parms{$name} = $plain;
1.469     raeburn  4261:         } elsif ($type eq 'type') {
                   4262:             $standard_parms_types{$name} = $plain;
                   4263:         }
1.328     albertel 4264:     }
                   4265:     close($config);
                   4266:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   4267:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
                   4268: }
                   4269: 
1.292     www      4270: sub standard_parameter_names {
                   4271:     my ($name)=@_;
1.328     albertel 4272:     if (!%standard_parms) {
1.473     amueller 4273:     &load_parameter_names();
1.328     albertel 4274:     }
1.292     www      4275:     if ($standard_parms{$name}) {
1.473     amueller 4276:     return $standard_parms{$name};
1.446     bisitz   4277:     } else {
1.473     amueller 4278:     return $name;
1.292     www      4279:     }
                   4280: }
1.290     www      4281: 
1.469     raeburn  4282: sub standard_parameter_types {
                   4283:     my ($name)=@_;
                   4284:     if (!%standard_parms_types) {
                   4285:         &load_parameter_names();
                   4286:     }
                   4287:     if ($standard_parms_types{$name}) {
                   4288:         return $standard_parms_types{$name};
                   4289:     }
                   4290:     return;
                   4291: }
1.309     www      4292: 
1.285     albertel 4293: sub parm_change_log {
1.284     www      4294:     my ($r)=@_;
1.414     droeschl 4295:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.473     amueller 4296:     text=>"Parameter Change Log"});
1.327     albertel 4297:     $r->print(&Apache::loncommon::start_page('Parameter Change Log'));
                   4298:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
                   4299: 
1.286     www      4300:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',
1.473     amueller 4301:                       $env{'course.'.$env{'request.course.id'}.'.domain'},
                   4302:                       $env{'course.'.$env{'request.course.id'}.'.num'});
1.311     albertel 4303: 
1.301     www      4304:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 4305: 
1.327     albertel 4306:     $r->print('<form action="/adm/parmset?action=parameterchangelog"
                   4307:                      method="post" name="parameterlog">');
1.446     bisitz   4308: 
1.311     albertel 4309:     my %saveable_parameters = ('show' => 'scalar',);
                   4310:     &Apache::loncommon::store_course_settings('parameter_log',
                   4311:                                               \%saveable_parameters);
                   4312:     &Apache::loncommon::restore_course_settings('parameter_log',
                   4313:                                                 \%saveable_parameters);
1.348     www      4314:     $r->print(&Apache::loncommon::display_filter().
1.326     www      4315:               '<label>'.&Apache::lonhtmlcommon::checkbox('includetypes',$env{'form.includetypes'},'1').
1.473     amueller 4316:           ' '.&mt('Include parameter types').'</label>'.
                   4317:           '<input type="submit" value="'.&mt('Display').'" /></form>');
1.301     www      4318: 
1.291     www      4319:     my $courseopt=&Apache::lonnet::get_courseresdata($env{'course.'.$env{'request.course.id'}.'.num'},
1.473     amueller 4320:                              $env{'course.'.$env{'request.course.id'}.'.domain'});
1.301     www      4321:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
1.473     amueller 4322:           '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
                   4323:           &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th><th>'.&mt('Announce').'</th>'.
                   4324:           &Apache::loncommon::end_data_table_header_row());
1.309     www      4325:     my $shown=0;
1.349     www      4326:     my $folder='';
                   4327:     if ($env{'form.displayfilter'} eq 'currentfolder') {
1.473     amueller 4328:     my $last='';
                   4329:     if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   4330:         &GDBM_READER(),0640)) {
                   4331:         $last=$hash{'last_known'};
                   4332:         untie(%hash);
                   4333:     }
                   4334:     if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
1.349     www      4335:     }
1.446     bisitz   4336:     foreach my $id (sort
1.473     amueller 4337:             {
                   4338:             if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   4339:                 return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   4340:             }
                   4341:             my $aid = (split('00000',$a))[-1];
                   4342:             my $bid = (split('00000',$b))[-1];
                   4343:             return $bid<=>$aid;
                   4344:             } (keys(%parmlog))) {
1.294     www      4345:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.473     amueller 4346:     my $count = 0;
                   4347:     my $time =
                   4348:         &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
                   4349:     my $plainname =
                   4350:         &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   4351:                       $parmlog{$id}{'exe_udom'});
                   4352:     my $about_me_link =
                   4353:         &Apache::loncommon::aboutmewrapper($plainname,
                   4354:                            $parmlog{$id}{'exe_uname'},
                   4355:                            $parmlog{$id}{'exe_udom'});
                   4356:     my $send_msg_link='';
                   4357:     if ((($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
                   4358:          || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
                   4359:         $send_msg_link ='<br />'.
                   4360:         &Apache::loncommon::messagewrapper(&mt('Send message'),
                   4361:                            $parmlog{$id}{'exe_uname'},
                   4362:                            $parmlog{$id}{'exe_udom'});
                   4363:     }
                   4364:     my $row_start=&Apache::loncommon::start_data_table_row();
                   4365:     my $makenewrow=0;
                   4366:     my %istype=();
                   4367:     my $output;
                   4368:     foreach my $changed (reverse(sort(@changes))) {
1.330     albertel 4369:             my $value=$parmlog{$id}{'logentry'}{$changed};
1.473     amueller 4370:         my $typeflag = ($changed =~/\.type$/ &&
                   4371:                 !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 4372:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
1.473     amueller 4373:         &components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},undef,undef,$typeflag);
                   4374:         if ($env{'form.displayfilter'} eq 'currentfolder') {
                   4375:         if ($folder) {
                   4376:             if ($middle!~/^\Q$folder\E/) { next; }
                   4377:         }
                   4378:         }
                   4379:         if ($typeflag) {
                   4380:         $istype{$parmname}=$value;
                   4381:         if (!$env{'form.includetypes'}) { next; }
                   4382:         }
                   4383:         $count++;
                   4384:         if ($makenewrow) {
                   4385:         $output .= $row_start;
                   4386:         } else {
                   4387:         $makenewrow=1;
                   4388:         }
1.470     raeburn  4389:             my $parmitem = &standard_parameter_names($parmname);
1.473     amueller 4390:         $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
                   4391:               &mt($parmitem).'</td><td>'.
                   4392:               ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
                   4393:         my $stillactive=0;
                   4394:         if ($parmlog{$id}{'delflag'}) {
                   4395:         $output .= &mt('Deleted');
                   4396:         } else {
                   4397:         if ($typeflag) {
1.470     raeburn  4398:                     my $parmitem = &standard_parameter_names($value); 
                   4399:                     $parmitem = &mt($parmitem);
1.473     amueller 4400:             $output .= &mt('Type: [_1]',$parmitem);
                   4401:         } else {
                   4402:             my ($level,@all)=&parmval_by_symb($what,$middle,&Apache::lonnet::metadata($middle,$what),
                   4403:                               $uname,$udom,$issection,$issection,$courseopt);
1.469     raeburn  4404:                     my $showvalue = $value;
                   4405:                     if ($istype{$parmname} eq '') {
                   4406:                         my $type = &standard_parameter_types($parmname);
                   4407:                         if ($type ne '') {
                   4408:                             if (&isdateparm($type)) {
                   4409:                                 $showvalue =
                   4410:                                     &Apache::lonlocal::locallocaltime($value);
                   4411:                             }
                   4412:                         }
                   4413:                     } else {
1.473     amueller 4414:                 if (&isdateparm($istype{$parmname})) {
                   4415:                 $showvalue = 
1.469     raeburn  4416:                                 &Apache::lonlocal::locallocaltime($value);
1.473     amueller 4417:                 }
1.469     raeburn  4418:                     }
                   4419:                     $output .= $showvalue;
1.473     amueller 4420:             if ($value ne $all[$level]) {
                   4421:             $output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
                   4422:             } else {
                   4423:             $stillactive=1;
                   4424:             }
                   4425:         }
                   4426:         }
                   4427:         $output .= '</td><td>';
1.470     raeburn  4428:             
1.473     amueller 4429:         if ($stillactive) {
1.470     raeburn  4430:                 my $parmitem = &standard_parameter_names($parmname);
                   4431:                 $parmitem = &mt($parmitem);
1.473     amueller 4432:         my $title=&mt('Changed [_1]',$parmitem);
1.471     raeburn  4433:                 my $description=&mt('Changed [_1] for [_2] to [_3]',
                   4434:                                     $parmitem,$realmdescription,
1.473     amueller 4435:                     (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
                   4436:         if (($uname) && ($udom)) {
                   4437:             $output .=
                   4438:             &Apache::loncommon::messagewrapper('Notify User',
                   4439:                                $uname,$udom,$title,
                   4440:                                $description);
                   4441:         } else {
                   4442:             $output .=
                   4443:             &Apache::lonrss::course_blog_link($id,$title,
                   4444:                               $description);
                   4445:         }
                   4446:         }
                   4447:         $output .= '</td>'.&Apache::loncommon::end_data_table_row();
                   4448:     }
1.349     www      4449:         if ($env{'form.displayfilter'} eq 'containing') {
1.473     amueller 4450:         my $wholeentry=$about_me_link.':'.
                   4451:         $parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   4452:         $output;
                   4453:         if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
                   4454:     }
1.349     www      4455:         if ($count) {
1.473     amueller 4456:         $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
1.332     albertel 4457:                        <td rowspan="'.$count.'">'.$about_me_link.
1.473     amueller 4458:           '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   4459:                       ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   4460:           $send_msg_link.'</td>'.$output);
                   4461:         $shown++;
                   4462:     }
                   4463:     if (!($env{'form.show'} eq &mt('all')
                   4464:           || $shown<=$env{'form.show'})) { last; }
1.286     www      4465:     }
1.301     www      4466:     $r->print(&Apache::loncommon::end_data_table());
1.284     www      4467:     $r->print(&Apache::loncommon::end_page());
                   4468: }
                   4469: 
1.437     raeburn  4470: sub update_slots {
                   4471:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   4472:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   4473:     if (!keys(%slot)) {
                   4474:         return 'error: slot does not exist';
                   4475:     }
                   4476:     my $max=$slot{'maxspace'};
                   4477:     if (!defined($max)) { $max=99999; }
                   4478: 
                   4479:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   4480:                                        "^$slot_name\0");
                   4481:     my ($tmp)=%consumed;
                   4482:     if ($tmp=~/^error: 2 / ) {
                   4483:         return 'error: unable to determine current slot status';
                   4484:     }
                   4485:     my $last=0;
                   4486:     foreach my $key (keys(%consumed)) {
                   4487:         my $num=(split('\0',$key))[1];
                   4488:         if ($num > $last) { $last=$num; }
                   4489:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   4490:             return 'ok';
                   4491:         }
                   4492:     }
                   4493: 
                   4494:     if (scalar(keys(%consumed)) >= $max) {
                   4495:         return 'error: no space left in slot';
                   4496:     }
                   4497:     my $wanted=$last+1;
                   4498: 
                   4499:     my %reservation=('name'      => $uname.':'.$udom,
                   4500:                      'timestamp' => time,
                   4501:                      'symb'      => $symb);
                   4502: 
                   4503:     my $success=&Apache::lonnet::newput('slot_reservations',
                   4504:                                         {"$slot_name\0$wanted" =>
                   4505:                                              \%reservation},
                   4506:                                         $cdom, $cnum);
1.438     raeburn  4507:     if ($success eq 'ok') {
                   4508:         my %storehash = (
                   4509:                           symb    => $symb,
                   4510:                           slot    => $slot_name,
                   4511:                           action  => 'reserve',
                   4512:                           context => 'parameter',
                   4513:                         );
                   4514:         &Apache::lonnet::instructor_log('slotreservationslog',\%storehash,
                   4515:                                         '',$uname,$udom,$cnum,$cdom);
                   4516: 
                   4517:         &Apache::lonnet::instructor_log($cdom.'_'.$cnum.'_slotlog',\%storehash,
                   4518:                                         '',$uname,$udom,$uname,$udom);
                   4519:     }
1.437     raeburn  4520:     return $success;
                   4521: }
                   4522: 
                   4523: sub delete_slots {
                   4524:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   4525:     my $delresult;
                   4526:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   4527:                                          $cnum, "^$slot_name\0");
                   4528:     if (&Apache::lonnet::error(%consumed)) {
                   4529:         return 'error: unable to determine current slot status';
                   4530:     }
                   4531:     my ($tmp)=%consumed;
                   4532:     if ($tmp=~/^error: 2 /) {
                   4533:         return 'error: unable to determine current slot status';
                   4534:     }
                   4535:     foreach my $key (keys(%consumed)) {
                   4536:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   4537:             my $num=(split('\0',$key))[1];
                   4538:             my $entry = $slot_name.'\0'.$num;
                   4539:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   4540:                                               $cdom,$cnum);
                   4541:             if ($delresult eq 'ok') {
                   4542:                 my %storehash = (
                   4543:                                   symb    => $symb,
                   4544:                                   slot    => $slot_name,
                   4545:                                   action  => 'release',
                   4546:                                   context => 'parameter',
                   4547:                                 );
                   4548:                 &Apache::lonnet::instructor_log('slotreservationslog',\%storehash,
                   4549:                                                 1,$uname,$udom,$cnum,$cdom);
1.438     raeburn  4550:                 &Apache::lonnet::instructor_log($cdom.'_'.$cnum.'_slotlog',\%storehash,
                   4551:                                                 1,$uname,$udom,$uname,$udom);
1.437     raeburn  4552:             }
                   4553:         }
                   4554:     }
                   4555:     return $delresult;
                   4556: }
                   4557: 
1.355     albertel 4558: sub check_for_course_info {
                   4559:     my $navmap = Apache::lonnavmaps::navmap->new();
                   4560:     return 1 if ($navmap);
                   4561:     return 0;
                   4562: }
                   4563: 
1.259     banghart 4564: 
1.30      www      4565: sub handler {
1.43      albertel 4566:     my $r=shift;
1.30      www      4567: 
1.376     albertel 4568:     &reset_caches();
                   4569: 
1.414     droeschl 4570:     &Apache::loncommon::content_type($r,'text/html');
                   4571:     $r->send_http_header;
                   4572:     return OK if $r->header_only;
                   4573: 
1.193     albertel 4574:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.473     amueller 4575:                         ['action','state',
1.205     www      4576:                                              'pres_marker',
                   4577:                                              'pres_value',
1.206     www      4578:                                              'pres_type',
1.390     www      4579:                                              'udom','uname','symb','serial','timebase']);
1.131     www      4580: 
1.83      bowersj2 4581: 
1.193     albertel 4582:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 4583:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
1.473     amueller 4584:                         text=>"Parameter Manager",
                   4585:                         faq=>10,
                   4586:                         bug=>'Instructor Interface',
1.442     droeschl 4587:                                             help =>
                   4588:                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203     www      4589: 
1.30      www      4590: # ----------------------------------------------------- Needs to be in a course
1.194     albertel 4591:     my $parm_permission =
1.473     amueller 4592:     (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||
                   4593:      &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
                   4594:                   $env{'request.course.sec'}));
1.355     albertel 4595:     my $exists = &check_for_course_info();
                   4596: 
                   4597:     if ($env{'request.course.id'} &&  $parm_permission && $exists) {
1.193     albertel 4598:         #
                   4599:         # Main switch on form.action and form.state, as appropriate
                   4600:         #
                   4601:         # Check first if coming from someone else headed directly for
                   4602:         #  the table mode
                   4603:         if ((($env{'form.command'} eq 'set') && ($env{'form.url'})
1.473     amueller 4604:          && (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   4605:         &assessparms($r);
1.193     albertel 4606:         } elsif (! exists($env{'form.action'})) {
                   4607:             &print_main_menu($r,$parm_permission);
1.414     droeschl 4608:         } elsif ($env{'form.action'} eq 'setoverview') {
1.473     amueller 4609:         &overview($r);
                   4610:     } elsif ($env{'form.action'} eq 'addmetadata') {
                   4611:         &addmetafield($r);
                   4612:     } elsif ($env{'form.action'} eq 'ordermetadata') {
                   4613:         &order_meta_fields($r);
1.414     droeschl 4614:         } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.473     amueller 4615:         &setrestrictmeta($r);
1.414     droeschl 4616:         } elsif ($env{'form.action'} eq 'newoverview') {
1.473     amueller 4617:         &newoverview($r);
1.414     droeschl 4618:         } elsif ($env{'form.action'} eq 'setdefaults') {
1.473     amueller 4619:         &defaultsetter($r);
                   4620:     } elsif ($env{'form.action'} eq 'settable') {
                   4621:         &assessparms($r);
1.414     droeschl 4622:         } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.473     amueller 4623:         &parm_change_log($r);
1.414     droeschl 4624:         } elsif ($env{'form.action'} eq 'cleanparameters') {
1.473     amueller 4625:         &clean_parameters($r);
1.414     droeschl 4626:         } elsif ($env{'form.action'} eq 'dateshift1') {
1.390     www      4627:             &date_shift_one($r);
1.414     droeschl 4628:         } elsif ($env{'form.action'} eq 'dateshift2') {
1.390     www      4629:             &date_shift_two($r);
1.473     amueller 4630:     } elsif ($env{'form.action'} eq 'categorizecourse') {
1.403     raeburn  4631:             &assign_course_categories($r);
1.446     bisitz   4632:         }
1.43      albertel 4633:     } else {
1.1       www      4634: # ----------------------------- Not in a course, or not allowed to modify parms
1.473     amueller 4635:     if ($exists) {
                   4636:         $env{'user.error.msg'}=
                   4637:         "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   4638:     } else {
                   4639:         $env{'user.error.msg'}=
                   4640:         "/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   4641:     }
                   4642:     return HTTP_NOT_ACCEPTABLE;
1.43      albertel 4643:     }
1.376     albertel 4644:     &reset_caches();
                   4645: 
1.43      albertel 4646:     return OK;
1.1       www      4647: }
                   4648: 
                   4649: 1;
                   4650: __END__
                   4651: 
                   4652: 

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