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

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

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