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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.413.4.5! raeburn     4: # $Id: lonparmset.pm,v 1.413.4.4 2010/01/25 22:11:57 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.413.4.4  raeburn  3186:     my $crstype = &Apache::loncommon::course_type();
                   3187:     my $lc_crstype = lc($crstype);
                   3188: 
1.193     albertel 3189:     my @menu =
1.413.4.4  raeburn  3190:         ( { divider=>"Settings for Your $crstype",
1.322     www      3191: 	  },
1.413.4.4  raeburn  3192:           { text => "Edit $lc_crstype configuration",
1.413.4.1  raeburn  3193: 	    url => '/adm/courseprefs?origin=params',
1.193     albertel 3194:             permission => $parm_permission,
1.324     www      3195:             help => 'Course_Environment',
1.193     albertel 3196:             },
1.255     banghart 3197:           { text => 'Set Portfolio Metadata',
1.259     banghart 3198: 	    action => 'setrestrictmeta',
1.240     banghart 3199:             permission => $parm_permission,
                   3200:             },
1.413.4.4  raeburn  3201: 	  { text => "Manage $crstype Slots",
1.268     albertel 3202: 	    url => '/adm/slotrequest?command=showslots',
                   3203: 	    permission => $vgr,
                   3204:             },
1.366     albertel 3205: 	  { text => 'Reset Student Access Times',
                   3206: 	    url => '/adm/helper/resettimes.helper',
                   3207: 	    permission => $mgr,
                   3208:             },
                   3209: 
1.322     www      3210:           { text => 'Set Parameter Setting Default Actions',
                   3211:             action => 'setdefaults',
                   3212:             permission => $parm_permission,
                   3213:             },          
                   3214: 	  { divider => 'New and Existing Parameter Settings for Your Resources',
1.268     albertel 3215: 	    },
1.216     www      3216:           { text => 'Set/Modify Resource Parameters - Helper Mode',
1.193     albertel 3217:             url => '/adm/helper/parameter.helper',
                   3218:             permission => $parm_permission,
1.324     www      3219:             help => 'Parameter_Helper',
1.193     albertel 3220:             },
1.322     www      3221:  	  { text => 'Set/Modify Resource Parameters - Overview Mode',
1.208     www      3222:             action => 'newoverview',
                   3223:             permission => $parm_permission,
1.324     www      3224:             help => 'Parameter_Overview',
1.193     albertel 3225:             },
1.216     www      3226:           { text => 'Set/Modify Resource Parameters - Table Mode',
1.193     albertel 3227:             action => 'settable',
                   3228:             permission => $parm_permission,
1.324     www      3229:             help => 'Table_Mode',
1.193     albertel 3230:             },
1.322     www      3231:            { divider => 'Existing Parameter Settings for Your Resources',
                   3232: 	  },
                   3233: 	  { text => 'Modify Resource Parameters - Overview Mode',
                   3234:             action => 'setoverview',
1.220     www      3235:             permission => $parm_permission,
1.324     www      3236:             help => 'Parameter_Overview',
1.322     www      3237:  	    },          
1.413.4.4  raeburn  3238: 	  { text => "Parameter Change Log and $crstype Blog Posting/User Notification",
1.284     www      3239:             action => 'parameterchangelog',
                   3240:             permission => $parm_permission,
1.220     www      3241:             },
1.193     albertel 3242:           );
                   3243:     my $menu_html = '';
                   3244:     foreach my $menu_item (@menu) {
1.268     albertel 3245: 	if ($menu_item->{'divider'}) {
1.322     www      3246: 	    $menu_html .= '<h3>'.&mt($menu_item->{'divider'}).'</h3>';
1.268     albertel 3247: 	    next;
                   3248: 	}
1.193     albertel 3249:         next if (! $menu_item->{'permission'});
                   3250:         $menu_html.='<p>';
1.316     albertel 3251:         $menu_html.='<span class="LC_parm_menu_item">';
1.193     albertel 3252:         if (exists($menu_item->{'url'})) {
                   3253:             $menu_html.=qq{<a href="$menu_item->{'url'}">};
                   3254:         } else {
                   3255:             $menu_html.=
                   3256:                 qq{<a href="/adm/parmset?action=$menu_item->{'action'}">};
                   3257:         }
1.316     albertel 3258:         $menu_html.= &mt($menu_item->{'text'}).'</a></span>';
1.193     albertel 3259:         if (exists($menu_item->{'help'})) {
                   3260:             $menu_html.=
                   3261:                 &Apache::loncommon::help_open_topic($menu_item->{'help'});
                   3262:         }
                   3263:         $menu_html.='</p>'.$/;
                   3264:     }
                   3265:     $r->print($menu_html);
                   3266:     return;
                   3267: }
1.255     banghart 3268: ### Set portfolio metadata
1.252     banghart 3269: sub output_row {
1.347     banghart 3270:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 3271:     my $output;
1.263     banghart 3272:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   3273:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 3274:     if (!defined($options)) {
1.254     banghart 3275:         $options = 'active,stuadd';
1.261     banghart 3276:         $values = '';
1.252     banghart 3277:     }
1.337     banghart 3278:     if (!($options =~ /deleted/)) {
                   3279:         my @options= ( ['active', 'Show to student'],
1.413.4.1  raeburn  3280:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 3281:                     ['choices','Provide choices for students to select from']);
                   3282: #		   ['onlyone','Student may select only one choice']);
1.337     banghart 3283:         if ($added_flag) {
                   3284:             push @options,['deleted', 'Delete Metadata Field'];
                   3285:         }
1.351     banghart 3286:        $output = &Apache::loncommon::start_data_table_row();
                   3287:         $output .= '<td><span class="LC_metadata"><strong>'.$field_text.':</strong></span></td>';
                   3288:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 3289:         foreach my $opt (@options) {
                   3290: 	    my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
1.347     banghart 3291: 	    $output .= &Apache::loncommon::continue_data_table_row();
1.351     banghart 3292: 	    $output .= '<td>'.('&nbsp;' x 5).'<span class="LC_metadata"><label>
                   3293: 	               <input type="checkbox" name="'.
                   3294: 	               $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   3295: 	               &mt($opt->[1]).'</label></span> </td>';
1.347     banghart 3296: 	    $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 3297: 	}
1.351     banghart 3298:         $output .= &Apache::loncommon::continue_data_table_row();
                   3299:         $output .= '<td>'.('&nbsp;' x 10).'<span class="LC_metadata"><input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></span></td>';
                   3300:         $output .= &Apache::loncommon::end_data_table_row();
                   3301:         my $multiple_checked;
                   3302:         my $single_checked;
                   3303:         if ($options =~ m/onlyone/) {
                   3304:             $multiple_checked = "";
1.413.4.1  raeburn  3305:             $single_checked = ' checked="checked"';
1.351     banghart 3306:         } else {
1.413.4.1  raeburn  3307:             $multiple_checked = ' checked="checked"';
1.351     banghart 3308:             $single_checked = "";
                   3309:         }
                   3310: 	$output .= &Apache::loncommon::continue_data_table_row();
                   3311: 	$output .= '<td>'.('&nbsp;' x 10).'<span class="LC_metadata">
1.413.4.1  raeburn  3312: 	            <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked.' />'.
                   3313: 	            &mt('Student may select multiple choices from list').'</span></td>';
1.351     banghart 3314: 	$output .= &Apache::loncommon::end_data_table_row();
                   3315: 	$output .= &Apache::loncommon::continue_data_table_row();
                   3316: 	$output .= '<td>'.('&nbsp;' x 10).'<span class="LC_metadata">
1.413.4.1  raeburn  3317: 	            <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />'.
                   3318: 	            &mt('Student may select only one choice from list').'</span></td>';
1.351     banghart 3319: 	$output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 3320:     }
                   3321:     return ($output);
                   3322: }
1.340     banghart 3323: sub order_meta_fields {
                   3324:     my ($r)=@_;
                   3325:     my $idx = 1;
                   3326:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3327:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.341     banghart 3328:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.345     banghart 3329:     &Apache::lonhtmlcommon::add_breadcrumb
                   3330:             ({href=>"/adm/parmset?action=setrestrictmeta",
                   3331:               text=>"Restrict Metadata"},
                   3332:              {text=>"Order Metadata"});
                   3333:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.340     banghart 3334:     if ($env{'form.storeorder'}) {
                   3335:         my $newpos = $env{'form.newpos'} - 1;
                   3336:         my $currentpos = $env{'form.currentpos'} - 1;
                   3337:         my @neworder = ();
                   3338:         my @oldorder = split /,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'};
                   3339:         my $i;
1.341     banghart 3340:         if ($newpos > $currentpos) {
1.340     banghart 3341:         # moving stuff up
                   3342:             for ($i=0;$i<$currentpos;$i++) {
                   3343:         	$neworder[$i]=$oldorder[$i];
                   3344:             }
                   3345:             for ($i=$currentpos;$i<$newpos;$i++) {
                   3346:         	$neworder[$i]=$oldorder[$i+1];
                   3347:             }
                   3348:             $neworder[$newpos]=$oldorder[$currentpos];
                   3349:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
                   3350:         	$neworder[$i]=$oldorder[$i];
                   3351:             }
                   3352:         } else {
                   3353:         # moving stuff down
                   3354:     	    for ($i=0;$i<$newpos;$i++) {
                   3355:     	        $neworder[$i]=$oldorder[$i];
                   3356:     	    }
                   3357:     	    $neworder[$newpos]=$oldorder[$currentpos];
                   3358:     	    for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   3359:     	        $neworder[$i]=$oldorder[$i-1];
                   3360:     	    }
                   3361:     	    for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   3362:     	        $neworder[$i]=$oldorder[$i];
                   3363:     	    }
                   3364:         }
                   3365: 	my $ordered_fields = join ",", @neworder;
1.343     banghart 3366:         my $put_result = &Apache::lonnet::put('environment',
                   3367:                            {'metadata.addedorder'=>$ordered_fields},$dom,$crs); 	
1.393     raeburn  3368: 	&Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 3369:     }
1.357     raeburn  3370:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 3371:     my $ordered_fields;
1.340     banghart 3372:     my @fields_in_order = split /,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'};
                   3373:     if (!@fields_in_order) {
                   3374:         # no order found, pick sorted order then create metadata.addedorder key.
                   3375:         foreach my $key (sort keys %$fields) {
                   3376:             push @fields_in_order, $key;
1.341     banghart 3377:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 3378:         }
1.341     banghart 3379:         my $put_result = &Apache::lonnet::put('environment',
                   3380:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs); 
                   3381:     } 
1.340     banghart 3382:     $r->print('<table>');
                   3383:     my $num_fields = scalar(@fields_in_order);
                   3384:     foreach my $key (@fields_in_order) {
                   3385:         $r->print('<tr><td>');
                   3386:         $r->print('<form method="post" action="">');
                   3387:         $r->print('<select name="newpos" onChange="this.form.submit()">');
                   3388:         for (my $i = 1;$i le $num_fields;$i ++) {
                   3389:             if ($i eq $idx) {
                   3390:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   3391:             } else {
                   3392:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   3393:             }
                   3394:         }
                   3395:         $r->print('</select></td><td>');
                   3396:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   3397:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   3398:         $r->print('</form>');
                   3399:         $r->print($$fields{$key}.'</td></tr>');
                   3400:         $idx ++;
                   3401:     }
                   3402:     $r->print('</table>');
                   3403:     return 'ok';
                   3404: }
1.359     banghart 3405: sub continue {
                   3406:     my $output;
                   3407:     $output .= '<form action="" method="post">';
                   3408:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
                   3409:     $output .= '<input type="submit" value="Continue" />';
                   3410:     return ($output);
                   3411: }
1.334     banghart 3412: sub addmetafield {
                   3413:     my ($r)=@_;
                   3414:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   3415:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 3416:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3417:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.339     banghart 3418:     if (exists($env{'form.undelete'})) {
1.358     banghart 3419:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 3420:         foreach my $meta_field(@meta_fields) {
                   3421:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   3422:             $options =~ s/deleted//;
                   3423:             $options =~ s/,,/,/;
                   3424:             my $put_result = &Apache::lonnet::put('environment',
                   3425:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
                   3426:                                         
                   3427:             $r->print('Undeleted Metadata Field <strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}."</strong> with result ".$put_result.'<br />');
                   3428:         }
1.359     banghart 3429:         $r->print(&continue());
1.339     banghart 3430:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 3431:         my $meta_field = $env{'form.fieldname'};
                   3432:         my $display_field = $env{'form.fieldname'};
                   3433:         $meta_field =~ s/\W/_/g;
1.338     banghart 3434:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 3435:         my $put_result = &Apache::lonnet::put('environment',
                   3436:                             {'metadata.'.$meta_field.'.values'=>"",
                   3437:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   3438:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.359     banghart 3439:         $r->print('Added new Metadata Field <strong>'.$env{'form.fieldname'}."</strong> with result ".$put_result.'<br />');
                   3440:         $r->print(&continue());
1.335     banghart 3441:     } else {
1.357     raeburn  3442:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 3443:         if ($fields) {
                   3444:             $r->print('You may undelete previously deleted fields.<br />Check those you wish to undelete and click Undelete.<br />');
                   3445:             $r->print('<form method="post" action="">');
                   3446:             foreach my $key(keys(%$fields)) {
1.358     banghart 3447:                 $r->print('<input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'<br /');
1.339     banghart 3448:             }
                   3449:             $r->print('<input type="submit" name="undelete" value="Undelete" />');
                   3450:             $r->print('</form>');
                   3451:         }
                   3452:         $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 3453:         $r->print('<input type="text" name="fieldname" /><br />');
                   3454:         $r->print('<input type="submit" value="Add Metadata Field" />');
1.334     banghart 3455:     }
1.361     albertel 3456:     $r->print('</form>');
1.334     banghart 3457: }
1.259     banghart 3458: sub setrestrictmeta {
1.240     banghart 3459:     my ($r)=@_;
1.242     banghart 3460:     my $next_meta;
1.244     banghart 3461:     my $output;
1.245     banghart 3462:     my $item_num;
1.246     banghart 3463:     my $put_result;
1.280     albertel 3464:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 3465:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 3466:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3467:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.259     banghart 3468:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 3469:     my $save_field = '';
1.259     banghart 3470:     if ($env{'form.restrictmeta'}) {
1.254     banghart 3471:         foreach my $field (sort(keys(%env))) {
1.252     banghart 3472:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 3473:                 my $options;
1.252     banghart 3474:                 my $meta_field = $1;
                   3475:                 my $meta_key = $2;
1.253     banghart 3476:                 if ($save_field ne $meta_field) {
1.252     banghart 3477:                     $save_field = $meta_field;
1.253     banghart 3478:             	    if ($env{'form.'.$meta_field.'_stuadd'}) {
1.254     banghart 3479:             	        $options.='stuadd,';
                   3480:             	    } 
1.351     banghart 3481:             	    if ($env{'form.'.$meta_field.'_choices'}) {
                   3482:             	        $options.='choices,';
                   3483:             	    } 
                   3484:             	    if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
1.254     banghart 3485:             	        $options.='onlyone,';
                   3486:             	    } 
                   3487:             	    if ($env{'form.'.$meta_field.'_active'}) {
                   3488:             	        $options.='active,';
1.253     banghart 3489:             	    }
1.337     banghart 3490:             	    if ($env{'form.'.$meta_field.'_deleted'}) {
                   3491:             	        $options.='deleted,';
                   3492:             	    }
1.259     banghart 3493:                     my $name = $save_field;
1.253     banghart 3494:                      $put_result = &Apache::lonnet::put('environment',
1.262     banghart 3495:                                                   {'metadata.'.$meta_field.'.options'=>$options,
                   3496:                                                    'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
1.253     banghart 3497:                                                    },$dom,$crs);
1.252     banghart 3498:                 }
                   3499:             }
                   3500:         }
                   3501:     }
1.296     albertel 3502:     &Apache::lonnet::coursedescription($env{'request.course.id'},
                   3503: 				       {'freshen_cache' => 1});
1.335     banghart 3504:     # Get the default metadata fields
1.258     albertel 3505:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 3506:     # Now get possible added metadata fields
1.357     raeburn  3507:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.346     banghart 3508:     my $row_alt = 1;
1.347     banghart 3509:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 3510:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 3511:         if ($field ne 'courserestricted') {
1.346     banghart 3512:             $row_alt = $row_alt ? 0 : 1;
1.347     banghart 3513: 	    $output.= &output_row($r, $field, $metadata_fields{$field});
1.265     banghart 3514: 	}
1.255     banghart 3515:     }
1.351     banghart 3516:     my $buttons = (<<ENDButtons);
                   3517:         <input type="submit" name="restrictmeta" value="Save" />
                   3518:         </form><br />
                   3519:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
                   3520:         <input type="submit" name="restrictmeta" value="Add a Metadata Field" />
                   3521:         </form>
                   3522:         <br />
                   3523:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
                   3524:         <input type="submit" name="restrictmeta" value="Order Metadata Fields" />
                   3525: ENDButtons
1.337     banghart 3526:     my $added_flag = 1;
1.335     banghart 3527:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.346     banghart 3528:         $row_alt = $row_alt ? 0 : 1;
                   3529:         $output.= &output_row($r, $field, $$added_metadata_fields{$field},$added_flag, $row_alt);
1.335     banghart 3530:     }
1.347     banghart 3531:     $output .= &Apache::loncommon::end_data_table();
1.244     banghart 3532:     $r->print(<<ENDenv);       
1.259     banghart 3533:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 3534:         $output
1.351     banghart 3535:         $buttons
1.340     banghart 3536:         </form>
1.244     banghart 3537: ENDenv
1.280     albertel 3538:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 3539:     return 'ok';
                   3540: }
1.220     www      3541: ##################################################
1.335     banghart 3542: sub get_added_meta_fieldnames {
1.357     raeburn  3543:     my ($cid) = @_;
1.335     banghart 3544:     my %fields;
                   3545:     foreach my $key(%env) {
1.357     raeburn  3546:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 3547:             my $field_name = $1;
                   3548:             my ($display_field_name) = $env{$key};
                   3549:             $fields{$field_name} = $display_field_name;
                   3550:         }
                   3551:     }
                   3552:     return \%fields;
                   3553: }
1.339     banghart 3554: sub get_deleted_meta_fieldnames {
1.357     raeburn  3555:     my ($cid) = @_;
1.339     banghart 3556:     my %fields;
                   3557:     foreach my $key(%env) {
1.357     raeburn  3558:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 3559:             my $field_name = $1;
                   3560:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   3561:                 my ($display_field_name) = $env{$key};
                   3562:                 $fields{$field_name} = $display_field_name;
                   3563:             }
                   3564:         }
                   3565:     }
                   3566:     return \%fields;
                   3567: }
1.220     www      3568: sub defaultsetter {
1.280     albertel 3569:     my ($r) = @_;
                   3570: 
                   3571:     my $start_page = 
                   3572: 	&Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 3573:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.220     www      3574:     $r->print(<<ENDDEFHEAD);
1.280     albertel 3575: $start_page
1.220     www      3576: $breadcrumbs
                   3577: <form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">
                   3578: ENDDEFHEAD
1.280     albertel 3579: 
                   3580:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3581:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.221     www      3582:     my @ids=();
                   3583:     my %typep=();
                   3584:     my %keyp=();
                   3585:     my %allparms=();
                   3586:     my %allparts=();
                   3587:     my %allmaps=();
                   3588:     my %mapp=();
                   3589:     my %symbp=();
                   3590:     my %maptitles=();
                   3591:     my %uris=();
                   3592:     my %keyorder=&standardkeyorder();
                   3593:     my %defkeytype=();
                   3594: 
                   3595:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps, 
                   3596: 				\%mapp, \%symbp,\%maptitles,\%uris,
                   3597: 				\%keyorder,\%defkeytype);
1.224     www      3598:     if ($env{'form.storerules'}) {
                   3599: 	my %newrules=();
                   3600: 	my @delrules=();
1.226     www      3601: 	my %triggers=();
1.225     albertel 3602: 	foreach my $key (keys(%env)) {
                   3603:             if ($key=~/^form\.(\w+)\_action$/) {
1.224     www      3604: 		my $tempkey=$1;
1.226     www      3605: 		my $action=$env{$key};
                   3606:                 if ($action) {
                   3607: 		    $newrules{$tempkey.'_action'}=$action;
                   3608: 		    if ($action ne 'default') {
                   3609: 			my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   3610: 			$triggers{$whichparm}.=$tempkey.':';
                   3611: 		    }
                   3612: 		    $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
1.224     www      3613: 		    if (&isdateparm($defkeytype{$tempkey})) {
1.227     www      3614: 			$newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
1.224     www      3615: 			$newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   3616: 			$newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   3617: 			$newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   3618: 		    } else {
                   3619: 			$newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
1.227     www      3620: 			$newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
1.224     www      3621: 		    }
                   3622: 		} else {
1.225     albertel 3623: 		    push(@delrules,$tempkey.'_action');
1.226     www      3624: 		    push(@delrules,$tempkey.'_type');
1.225     albertel 3625: 		    push(@delrules,$tempkey.'_hours');
                   3626: 		    push(@delrules,$tempkey.'_min');
                   3627: 		    push(@delrules,$tempkey.'_sec');
                   3628: 		    push(@delrules,$tempkey.'_value');
1.224     www      3629: 		}
                   3630: 	    }
                   3631: 	}
1.226     www      3632: 	foreach my $key (keys %allparms) {
                   3633: 	    $newrules{$key.'_triggers'}=$triggers{$key};
                   3634: 	}
1.224     www      3635: 	&Apache::lonnet::put('parmdefactions',\%newrules,$dom,$crs);
                   3636: 	&Apache::lonnet::del('parmdefactions',\@delrules,$dom,$crs);
                   3637: 	&resetrulescache();
                   3638:     }
1.227     www      3639:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
                   3640: 				       'hours' => 'Hours',
1.221     www      3641: 				       'min' => 'Minutes',
                   3642: 				       'sec' => 'Seconds',
                   3643: 				       'yes' => 'Yes',
                   3644: 				       'no' => 'No');
1.222     www      3645:     my @standardoptions=('','default');
                   3646:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   3647:     my @dateoptions=('','default');
                   3648:     my @datedisplay=('',&mt('Default value when manually setting'));
                   3649:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
                   3650: 	unless ($tempkey) { next; }
                   3651: 	push @standardoptions,'when_setting_'.$tempkey;
                   3652: 	push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   3653: 	if (&isdateparm($defkeytype{$tempkey})) {
                   3654: 	    push @dateoptions,'later_than_'.$tempkey;
                   3655: 	    push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   3656: 	    push @dateoptions,'earlier_than_'.$tempkey;
                   3657: 	    push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   3658: 	} 
                   3659:     }
1.231     www      3660: $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   3661: 	  &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 3662:     $r->print("\n".&Apache::loncommon::start_data_table().
                   3663: 	      &Apache::loncommon::start_data_table_header_row().
                   3664: 	      "<th>".&mt('Rule for parameter').'</th><th>'.
                   3665: 	      &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   3666: 	      &Apache::loncommon::end_data_table_header_row());
1.221     www      3667:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.222     www      3668: 	unless ($tempkey) { next; }
1.318     albertel 3669: 	$r->print("\n".&Apache::loncommon::start_data_table_row().
                   3670: 		  "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
1.222     www      3671: 	my $action=&rulescache($tempkey.'_action');
                   3672: 	$r->print('<select name="'.$tempkey.'_action">');
                   3673: 	if (&isdateparm($defkeytype{$tempkey})) {
                   3674: 	    for (my $i=0;$i<=$#dateoptions;$i++) {
                   3675: 		if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   3676: 		$r->print("\n<option value='$dateoptions[$i]'".
                   3677: 			  ($dateoptions[$i] eq $action?' selected="selected"':'').
                   3678: 			  ">$datedisplay[$i]</option>");
                   3679: 	    }
                   3680: 	} else {
                   3681: 	    for (my $i=0;$i<=$#standardoptions;$i++) {
                   3682: 		if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   3683: 		$r->print("\n<option value='$standardoptions[$i]'".
                   3684: 			  ($standardoptions[$i] eq $action?' selected="selected"':'').
                   3685: 			  ">$standarddisplay[$i]</option>");
                   3686: 	    }
                   3687: 	}
                   3688: 	$r->print('</select>');
1.227     www      3689: 	unless (&isdateparm($defkeytype{$tempkey})) {
                   3690: 	    $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   3691: 		      '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
                   3692: 	}
1.222     www      3693: 	$r->print("\n</td><td>\n");
                   3694: 
1.221     www      3695:         if (&isdateparm($defkeytype{$tempkey})) {
1.227     www      3696: 	    my $days=&rulescache($tempkey.'_days');
1.222     www      3697: 	    my $hours=&rulescache($tempkey.'_hours');
                   3698: 	    my $min=&rulescache($tempkey.'_min');
                   3699: 	    my $sec=&rulescache($tempkey.'_sec');
1.221     www      3700: 	    $r->print(<<ENDINPUTDATE);
1.227     www      3701: <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
1.222     www      3702: <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   3703: <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   3704: <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.221     www      3705: ENDINPUTDATE
                   3706: 	} elsif ($defkeytype{$tempkey} eq 'string_yesno') {
1.222     www      3707:             my $yeschecked='';
                   3708:             my $nochecked='';
1.413.4.1  raeburn  3709:             if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   3710:             if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
1.222     www      3711: 
1.221     www      3712: 	    $r->print(<<ENDYESNO);
1.413.4.1  raeburn  3713: <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   3714: <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.221     www      3715: ENDYESNO
                   3716:         } else {
1.224     www      3717: 	    $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
1.221     www      3718: 	}
1.318     albertel 3719:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      3720:     }
1.318     albertel 3721:     $r->print(&Apache::loncommon::end_data_table().
1.413.4.2  raeburn  3722: 	      "\n".'<input type="submit" name="storerules" value="'.
                   3723: 	      &mt('Save').'" /></form>'."\n".
1.280     albertel 3724: 	      &Apache::loncommon::end_page());
1.220     www      3725:     return;
                   3726: }
1.193     albertel 3727: 
1.290     www      3728: sub components {
1.330     albertel 3729:     my ($key,$uname,$udom,$exeuser,$exedomain,$typeflag)=@_;
                   3730: 
                   3731:     if ($typeflag) {
1.290     www      3732: 	$key=~s/\.type$//;
                   3733:     }
1.330     albertel 3734: 
                   3735:     my ($middle,$part,$name)=
                   3736: 	($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.291     www      3737:     my $issection;
1.330     albertel 3738: 
1.290     www      3739:     my $section=&mt('All Students');
                   3740:     if ($middle=~/^\[(.*)\]/) {
1.291     www      3741: 	$issection=$1;
                   3742: 	$section=&mt('Group/Section').': '.$issection;
1.290     www      3743: 	$middle=~s/^\[(.*)\]//;
                   3744:     }
                   3745:     $middle=~s/\.+$//;
                   3746:     $middle=~s/^\.+//;
1.291     www      3747:     if ($uname) {
                   3748: 	$section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   3749: 	$issection='';
                   3750:     }
1.316     albertel 3751:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.304     www      3752:     my $realmdescription=&mt('all resources'); 
1.290     www      3753:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.316     albertel 3754: 	$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      3755:  	$realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($1);
                   3756:    } elsif ($middle) {
1.290     www      3757: 	my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
1.316     albertel 3758: 	$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      3759: 	$realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      3760:     }
1.291     www      3761:     my $what=$part.'.'.$name;
1.330     albertel 3762:     return ($realm,$section,$name,$part,
1.304     www      3763: 	    $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      3764: }
1.293     www      3765: 
1.328     albertel 3766: my %standard_parms;
                   3767: sub load_parameter_names {
                   3768:     open(my $config,"<$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
                   3769:     while (my $configline=<$config>) {
                   3770: 	if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   3771: 	chomp($configline);
                   3772: 	my ($short,$plain)=split(/:/,$configline);
                   3773: 	my (undef,$name,$type)=split(/\&/,$short,3);
                   3774: 	if ($type eq 'display') {
                   3775: 	    $standard_parms{$name} = $plain;
                   3776: 	}
                   3777:     }
                   3778:     close($config);
                   3779:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   3780:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
                   3781: }
                   3782: 
1.292     www      3783: sub standard_parameter_names {
                   3784:     my ($name)=@_;
1.328     albertel 3785:     if (!%standard_parms) {
                   3786: 	&load_parameter_names();
                   3787:     }
1.292     www      3788:     if ($standard_parms{$name}) {
                   3789: 	return $standard_parms{$name}; 
                   3790:     } else { 
                   3791: 	return $name; 
                   3792:     }
                   3793: }
1.290     www      3794: 
1.309     www      3795: #
                   3796: # Parameter Change Log
                   3797: #
                   3798: 
                   3799: 
1.285     albertel 3800: sub parm_change_log {
1.284     www      3801:     my ($r)=@_;
1.327     albertel 3802:     $r->print(&Apache::loncommon::start_page('Parameter Change Log'));
                   3803:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
                   3804: 
1.286     www      3805:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',
                   3806: 				      $env{'course.'.$env{'request.course.id'}.'.domain'},
                   3807: 				      $env{'course.'.$env{'request.course.id'}.'.num'});
1.311     albertel 3808: 
1.301     www      3809:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 3810: 
1.327     albertel 3811:     $r->print('<form action="/adm/parmset?action=parameterchangelog"
                   3812:                      method="post" name="parameterlog">');
1.311     albertel 3813:     
                   3814:     my %saveable_parameters = ('show' => 'scalar',);
                   3815:     &Apache::loncommon::store_course_settings('parameter_log',
                   3816:                                               \%saveable_parameters);
                   3817:     &Apache::loncommon::restore_course_settings('parameter_log',
                   3818:                                                 \%saveable_parameters);
1.348     www      3819:     $r->print(&Apache::loncommon::display_filter().
1.326     www      3820:               '<label>'.&Apache::lonhtmlcommon::checkbox('includetypes',$env{'form.includetypes'},'1').
                   3821: 	      ' '.&mt('Include parameter types').'</label>'.
1.327     albertel 3822: 	      '<input type="submit" value="'.&mt('Display').'" /></form>');
1.301     www      3823: 
1.291     www      3824:     my $courseopt=&Apache::lonnet::get_courseresdata($env{'course.'.$env{'request.course.id'}.'.num'},
                   3825: 						     $env{'course.'.$env{'request.course.id'}.'.domain'});
1.301     www      3826:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
                   3827: 	      '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
                   3828: 	      &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th><th>'.&mt('Announce').'</th>'.
                   3829: 	      &Apache::loncommon::end_data_table_header_row());
1.309     www      3830:     my $shown=0;
1.349     www      3831:     my $folder='';
                   3832:     if ($env{'form.displayfilter'} eq 'currentfolder') {
                   3833: 	my $last='';
                   3834: 	if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   3835: 		&GDBM_READER(),0640)) {
                   3836: 	    $last=$hash{'last_known'};
                   3837: 	    untie(%hash);
                   3838: 	}
                   3839: 	if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
                   3840:     }
1.356     albertel 3841:     foreach my $id (sort 
                   3842: 		    {
                   3843: 			if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   3844: 			    return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   3845: 			}
                   3846: 			my $aid = (split('00000',$a))[-1];
                   3847: 			my $bid = (split('00000',$b))[-1];
                   3848: 			return $bid<=>$aid;
                   3849: 		    } (keys(%parmlog))) {
1.294     www      3850:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.332     albertel 3851: 	my $count = 0;
1.288     albertel 3852: 	my $time =
1.294     www      3853: 	    &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
1.289     www      3854: 	my $plainname = 
1.294     www      3855: 	    &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   3856: 					  $parmlog{$id}{'exe_udom'});
1.288     albertel 3857: 	my $about_me_link = 
1.289     www      3858: 	    &Apache::loncommon::aboutmewrapper($plainname,
1.294     www      3859: 					       $parmlog{$id}{'exe_uname'},
                   3860: 					       $parmlog{$id}{'exe_udom'});
1.293     www      3861: 	my $send_msg_link='';
1.294     www      3862: 	if ((($parmlog{$id}{'exe_uname'} ne $env{'user.name'}) 
                   3863: 	     || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
1.293     www      3864: 	    $send_msg_link ='<br />'.
1.288     albertel 3865: 		&Apache::loncommon::messagewrapper(&mt('Send message'),
1.294     www      3866: 						   $parmlog{$id}{'exe_uname'},
                   3867: 						   $parmlog{$id}{'exe_udom'});
1.288     albertel 3868: 	}
1.301     www      3869: 	my $row_start=&Apache::loncommon::start_data_table_row();
1.290     www      3870: 	my $makenewrow=0;
                   3871: 	my %istype=();
1.332     albertel 3872: 	my $output;
1.293     www      3873: 	foreach my $changed (reverse(sort(@changes))) {
1.330     albertel 3874:             my $value=$parmlog{$id}{'logentry'}{$changed};
1.331     albertel 3875: 	    my $typeflag = ($changed =~/\.type$/ &&
                   3876: 			    !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 3877:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
                   3878: 		&components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},undef,undef,$typeflag);
1.349     www      3879: 	    if ($env{'form.displayfilter'} eq 'currentfolder') {
                   3880: 		if ($folder) {
                   3881: 		    if ($middle!~/^\Q$folder\E/) { next; }
                   3882: 		}
                   3883: 	    }
1.326     www      3884: 	    if ($typeflag) {
1.329     albertel 3885: 		$istype{$parmname}=$value; 
1.326     www      3886: 		if (!$env{'form.includetypes'}) { next; } 
                   3887: 	    }
1.332     albertel 3888: 	    $count++;
                   3889: 	    if ($makenewrow) {
                   3890: 		$output .= $row_start;
                   3891: 	    } else {
                   3892: 		$makenewrow=1;
                   3893: 	    }
1.413.4.3  raeburn  3894:             my $parmitem = &standard_parameter_names($parmname);
1.332     albertel 3895: 	    $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
1.413.4.3  raeburn  3896: 		      &mt($parmitem).'</td><td>'.
1.332     albertel 3897: 		      ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
1.291     www      3898: 	    my $stillactive=0;
1.332     albertel 3899: 	    if ($parmlog{$id}{'delflag'}) {
                   3900: 		$output .= &mt('Deleted');
1.288     albertel 3901: 	    } else {
1.290     www      3902: 		if ($typeflag) {
1.413.4.3  raeburn  3903:                     my $parmitem = &standard_parameter_names($value); 
                   3904:                     $parmitem = &mt($parmitem);
                   3905:                     $output .= &mt('Type: [_1]',$parmitem);
1.290     www      3906: 		} else {
1.291     www      3907: 		    my ($level,@all)=&parmval_by_symb($what,$middle,&Apache::lonnet::metadata($middle,$what),
                   3908: 						      $uname,$udom,$issection,$issection,$courseopt);
                   3909: 		    if (&isdateparm($istype{$parmname})) {
1.332     albertel 3910: 			$output .= &Apache::lonlocal::locallocaltime($value);
1.291     www      3911: 		    } else {
1.332     albertel 3912: 			$output .= $value;
1.291     www      3913: 		    }
                   3914: 		    if ($value ne $all[$level]) {
1.332     albertel 3915: 			$output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
1.291     www      3916: 		    } else {
                   3917: 			$stillactive=1;
                   3918: 		    }
1.290     www      3919: 		}
1.288     albertel 3920: 	    }
1.332     albertel 3921: 	    $output .= '</td><td>';
1.291     www      3922: 	    if ($stillactive) {
1.413.4.3  raeburn  3923:                 my $parmitem = &standard_parameter_names($parmname);
                   3924:                 $parmitem = &mt($parmitem);
                   3925:                 my $title=&mt('Changed [_1]',$parmitem);
                   3926:                 my $description=&mt('Changed [_1] for [_2] to [_3]',
                   3927:                                     $parmitem,$realmdescription,
1.304     www      3928: 				    (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
1.292     www      3929: 		if (($uname) && ($udom)) {
1.332     albertel 3930: 		    $output .= 
                   3931: 			&Apache::loncommon::messagewrapper('Notify User',
                   3932: 							   $uname,$udom,$title,
                   3933: 							   $description);
1.292     www      3934: 		} else {
1.332     albertel 3935: 		    $output .= 
                   3936: 			&Apache::lonrss::course_blog_link($id,$title,
                   3937: 							  $description);
1.292     www      3938: 		}
1.291     www      3939: 	    }
1.332     albertel 3940: 	    $output .= '</td>'.&Apache::loncommon::end_data_table_row();
1.288     albertel 3941: 	}
1.349     www      3942:         if ($env{'form.displayfilter'} eq 'containing') {
                   3943: 	    my $wholeentry=$about_me_link.':'.
                   3944: 		$parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   3945: 		$output;
                   3946: 	    if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }        
                   3947: 	}
                   3948:         if ($count) {
                   3949: 	    $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
1.332     albertel 3950:                        <td rowspan="'.$count.'">'.$about_me_link.
                   3951: 		  '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   3952: 			          ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   3953: 		  $send_msg_link.'</td>'.$output);
1.349     www      3954: 	    $shown++;
                   3955: 	}
1.311     albertel 3956: 	if (!($env{'form.show'} eq &mt('all') 
                   3957: 	      || $shown<=$env{'form.show'})) { last; }
1.286     www      3958:     }
1.301     www      3959:     $r->print(&Apache::loncommon::end_data_table());
1.284     www      3960:     $r->print(&Apache::loncommon::end_page());
                   3961: }
                   3962: 
1.413.4.1  raeburn  3963: sub update_slots {
                   3964:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   3965:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   3966:     if (!keys(%slot)) {
                   3967:         return 'error: slot does not exist';
                   3968:     }
                   3969:     my $max=$slot{'maxspace'};
                   3970:     if (!defined($max)) { $max=99999; }
                   3971: 
                   3972:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   3973:                                        "^$slot_name\0");
                   3974:     my ($tmp)=%consumed;
                   3975:     if ($tmp=~/^error: 2 / ) {
                   3976:         return 'error: unable to determine current slot status';
                   3977:     }
                   3978:     my $last=0;
                   3979:     foreach my $key (keys(%consumed)) {
                   3980:         my $num=(split('\0',$key))[1];
                   3981:         if ($num > $last) { $last=$num; }
                   3982:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   3983:             return 'ok';
                   3984:         }
                   3985:     }
                   3986: 
                   3987:     if (scalar(keys(%consumed)) >= $max) {
                   3988:         return 'error: no space left in slot';
                   3989:     }
                   3990:     my $wanted=$last+1;
                   3991: 
                   3992:     my %reservation=('name'      => $uname.':'.$udom,
                   3993:                      'timestamp' => time,
                   3994:                      'symb'      => $symb);
                   3995: 
                   3996:     my $success=&Apache::lonnet::newput('slot_reservations',
                   3997:                                         {"$slot_name\0$wanted" =>
                   3998:                                              \%reservation},
                   3999:                                         $cdom, $cnum);
                   4000:     if ($success eq 'ok') {
                   4001:         my %storehash = (
                   4002:                           symb    => $symb,
                   4003:                           slot    => $slot_name,
                   4004:                           action  => 'reserve',
                   4005:                           context => 'parameter',
                   4006:                         );
                   4007:         &Apache::lonnet::instructor_log('slotreservationslog',\%storehash,
                   4008:                                         '',$uname,$udom,$cnum,$cdom);
                   4009: 
                   4010:         &Apache::lonnet::instructor_log($cdom.'_'.$cnum.'_slotlog',\%storehash,
                   4011:                                         '',$uname,$udom,$uname,$udom);
                   4012:     }
                   4013:     return $success;
                   4014: }
                   4015: 
                   4016: sub delete_slots {
                   4017:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   4018:     my $delresult;
                   4019:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   4020:                                          $cnum, "^$slot_name\0");
                   4021:     if (&Apache::lonnet::error(%consumed)) {
                   4022:         return 'error: unable to determine current slot status';
                   4023:     }
                   4024:     my ($tmp)=%consumed;
                   4025:     if ($tmp=~/^error: 2 /) {
                   4026:         return 'error: unable to determine current slot status';
                   4027:     }
                   4028:     foreach my $key (keys(%consumed)) {
                   4029:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   4030:             my $num=(split('\0',$key))[1];
                   4031:             my $entry = $slot_name.'\0'.$num;
                   4032:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   4033:                                               $cdom,$cnum);
                   4034:             if ($delresult eq 'ok') {
                   4035:                 my %storehash = (
                   4036:                                   symb    => $symb,
                   4037:                                   slot    => $slot_name,
                   4038:                                   action  => 'release',
                   4039:                                   context => 'parameter',
                   4040:                                 );
                   4041:                 &Apache::lonnet::instructor_log('slotreservationslog',\%storehash,
                   4042:                                                 1,$uname,$udom,$cnum,$cdom);
                   4043:                 &Apache::lonnet::instructor_log($cdom.'_'.$cnum.'_slotlog',\%storehash,
                   4044:                                                 1,$uname,$udom,$uname,$udom);
                   4045:             }
                   4046:         }
                   4047:     }
                   4048:     return $delresult;
                   4049: }
                   4050: 
1.355     albertel 4051: sub check_for_course_info {
                   4052:     my $navmap = Apache::lonnavmaps::navmap->new();
                   4053:     return 1 if ($navmap);
                   4054:     return 0;
                   4055: }
                   4056: 
1.30      www      4057: sub handler {
1.43      albertel 4058:     my $r=shift;
1.30      www      4059: 
1.376     albertel 4060:     &reset_caches();
                   4061: 
1.43      albertel 4062:     if ($r->header_only) {
1.126     www      4063: 	&Apache::loncommon::content_type($r,'text/html');
1.43      albertel 4064: 	$r->send_http_header;
                   4065: 	return OK;
                   4066:     }
1.193     albertel 4067:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.205     www      4068: 					    ['action','state',
                   4069:                                              'pres_marker',
                   4070:                                              'pres_value',
1.206     www      4071:                                              'pres_type',
1.390     www      4072:                                              'udom','uname','symb','serial','timebase']);
1.131     www      4073: 
1.83      bowersj2 4074: 
1.193     albertel 4075:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 4076:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
                   4077: 					    text=>"Parameter Manager",
1.204     www      4078: 					    faq=>10,
1.324     www      4079: 					    bug=>'Instructor Interface',
                   4080:                                             help => 'Parameter_Manager'});
1.203     www      4081: 
1.30      www      4082: # ----------------------------------------------------- Needs to be in a course
1.194     albertel 4083:     my $parm_permission =
                   4084: 	(&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||
1.190     albertel 4085: 	 &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
1.193     albertel 4086: 				  $env{'request.course.sec'}));
1.355     albertel 4087:     my $exists = &check_for_course_info();
                   4088: 
                   4089:     if ($env{'request.course.id'} &&  $parm_permission && $exists) {
1.193     albertel 4090: 
                   4091:         # Start Page
1.126     www      4092:         &Apache::loncommon::content_type($r,'text/html');
1.106     www      4093:         $r->send_http_header;
1.30      www      4094: 
1.203     www      4095: 
1.193     albertel 4096:         #
                   4097:         # Main switch on form.action and form.state, as appropriate
                   4098:         #
                   4099:         # Check first if coming from someone else headed directly for
                   4100:         #  the table mode
                   4101:         if ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   4102: 	     && (!$env{'form.dis'})) || ($env{'form.symb'})) {
1.324     www      4103:             &Apache::lonhtmlcommon::add_breadcrumb({help=>'Problem_Parameters',
                   4104: 						    text=>"Problem Parameters"});
1.193     albertel 4105: 	    &assessparms($r);
                   4106: 
                   4107:         } elsif (! exists($env{'form.action'})) {
                   4108:             $r->print(&header());
1.298     albertel 4109:             $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Manager'));
1.193     albertel 4110:             &print_main_menu($r,$parm_permission);
                   4111:         } elsif ($env{'form.action'} eq 'setoverview' && $parm_permission) {
1.194     albertel 4112:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
                   4113: 						    text=>"Overview Mode"});
1.121     www      4114: 	    &overview($r);
1.334     banghart 4115: 	} elsif ($env{'form.action'} eq 'addmetadata' && $parm_permission) {
                   4116:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
                   4117: 						    text=>"Add Metadata Field"});
                   4118: 	    &addmetafield($r);
1.340     banghart 4119: 	} elsif ($env{'form.action'} eq 'ordermetadata' && $parm_permission) {
                   4120:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
                   4121: 						    text=>"Add Metadata Field"});
                   4122: 	    &order_meta_fields($r);
1.259     banghart 4123:         } elsif ($env{'form.action'} eq 'setrestrictmeta' && $parm_permission) {
                   4124:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
                   4125: 						    text=>"Restrict Metadata"});
                   4126: 	    &setrestrictmeta($r);
1.208     www      4127:         } elsif ($env{'form.action'} eq 'newoverview' && $parm_permission) {
                   4128:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
                   4129: 						    text=>"Overview Mode"});
                   4130: 	    &newoverview($r);
1.220     www      4131:         }  elsif ($env{'form.action'} eq 'setdefaults' && $parm_permission) {
                   4132:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
                   4133: 						    text=>"Set Defaults"});
                   4134: 	    &defaultsetter($r);
                   4135: 	} elsif ($env{'form.action'} eq 'settable' && $parm_permission) {
1.194     albertel 4136:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.204     www      4137: 						    text=>"Table Mode",
                   4138: 						    help => 'Course_Setting_Parameters'});
1.121     www      4139: 	    &assessparms($r);
1.284     www      4140:         } elsif ($env{'form.action'} eq 'parameterchangelog' && $parm_permission) {
                   4141:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.292     www      4142: 						    text=>"Parameter Change Log"});
1.285     albertel 4143: 	    &parm_change_log($r);
1.333     albertel 4144:         } elsif ($env{'form.action'} eq 'cleanparameters' && $parm_permission) {
                   4145:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
                   4146: 						    text=>"Clean Parameters"});
                   4147: 	    &clean_parameters($r);
1.390     www      4148:         } elsif ($env{'form.action'} eq 'dateshift1' && $parm_permission) {
                   4149:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.391     www      4150:                                                     text=>"Shifting Dates"});
1.390     www      4151:             &date_shift_one($r);
                   4152:         } elsif ($env{'form.action'} eq 'dateshift2' && $parm_permission) {
                   4153:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.391     www      4154:                                                     text=>"Shifting Dates"});
1.390     www      4155:             &date_shift_two($r);
1.403     raeburn  4156:         } 
1.43      albertel 4157:     } else {
1.1       www      4158: # ----------------------------- Not in a course, or not allowed to modify parms
1.355     albertel 4159: 	if ($exists) {
                   4160: 	    $env{'user.error.msg'}=
                   4161: 		"/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   4162: 	} else {
                   4163: 	    $env{'user.error.msg'}=
                   4164: 		"/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   4165: 	}
1.43      albertel 4166: 	return HTTP_NOT_ACCEPTABLE;
                   4167:     }
1.376     albertel 4168:     &reset_caches();
                   4169: 
1.43      albertel 4170:     return OK;
1.1       www      4171: }
                   4172: 
                   4173: 1;
                   4174: __END__
                   4175: 

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