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

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

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