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

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

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