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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.291   ! www         4: # $Id: lonparmset.pm,v 1.290 2006/04/15 21:12:56 www Exp $
1.40      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.59      matthew    28: ###################################################################
                     29: ###################################################################
                     30: 
                     31: =pod
                     32: 
                     33: =head1 NAME
                     34: 
                     35: lonparmset - Handler to set parameters for assessments and course
                     36: 
                     37: =head1 SYNOPSIS
                     38: 
                     39: lonparmset provides an interface to setting course parameters. 
                     40: 
                     41: =head1 DESCRIPTION
                     42: 
                     43: This module sets coursewide and assessment parameters.
                     44: 
                     45: =head1 INTERNAL SUBROUTINES
                     46: 
                     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.1       www        66: 
1.198     www        67: # --- Caches local to lonparmset
1.2       www        68: 
1.199     www        69: my $parmhashid;
                     70: my %parmhash;
1.201     www        71: my $symbsid;
                     72: my %symbs;
1.221     www        73: my $rulesid;
                     74: my %rules;
1.198     www        75: 
                     76: # --- end local caches
                     77: 
1.59      matthew    78: ##################################################
                     79: ##################################################
                     80: 
                     81: =pod
                     82: 
                     83: =item parmval
                     84: 
                     85: Figure out a cascading parameter.
                     86: 
1.71      albertel   87: Inputs:  $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162     albertel   88:          $id   - a bighash Id number
1.71      albertel   89:          $def  - the resource's default value   'stupid emacs
                     90: 
1.269     raeburn    91: 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   92: 
1.269     raeburn    93: 14 - General Course
                     94: 13 - Map or Folder level in course
                     95: 12- resource default
                     96: 11- map default
                     97: 10 - resource level in course
                     98: 9 - General for section
                     99: 8 - Map or Folder level for section
                    100: 7 - resource level in section
                    101: 6 - General for group
                    102: 5 - Map or Folder level for group
                    103: 4 - resource level in group
1.71      albertel  104: 3 - General for specific student
1.82      www       105: 2 - Map or Folder level for specific student
1.71      albertel  106: 1 - resource level for specific student
1.2       www       107: 
1.59      matthew   108: =cut
                    109: 
                    110: ##################################################
1.2       www       111: sub parmval {
1.275     raeburn   112:     my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
                    113:     return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,
                    114:                                                            $cgroup,$courseopt);
1.201     www       115: }
                    116: 
                    117: sub parmval_by_symb {
1.275     raeburn   118:     my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
1.198     www       119: # load caches
1.200     www       120: 
1.198     www       121:     &cacheparmhash();
1.200     www       122: 
                    123:     my $useropt=&Apache::lonnet::get_userresdata($uname,$udom);
                    124: 
1.8       www       125:     my $result='';
1.44      albertel  126:     my @outpar=();
1.2       www       127: # ----------------------------------------------------- Cascading lookup scheme
1.201     www       128:     my $map=(&Apache::lonnet::decode_symb($symb))[0];    
1.10      www       129: 
1.201     www       130:     my $symbparm=$symb.'.'.$what;
                    131:     my $mapparm=$map.'___(all).'.$what;
1.10      www       132: 
1.269     raeburn   133:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$what;
                    134:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
                    135:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    136: 
1.190     albertel  137:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
                    138:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
                    139:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                    140: 
                    141:     my $courselevel=$env{'request.course.id'}.'.'.$what;
                    142:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
                    143:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.2       www       144: 
1.11      www       145: 
1.182     albertel  146: # --------------------------------------------------------- first, check course
1.11      www       147: 
1.200     www       148:     if (defined($$courseopt{$courselevel})) {
1.269     raeburn   149: 	$outpar[14]=$$courseopt{$courselevel};
                    150: 	$result=14;
1.43      albertel  151:     }
1.11      www       152: 
1.200     www       153:     if (defined($$courseopt{$courselevelm})) {
1.269     raeburn   154: 	$outpar[13]=$$courseopt{$courselevelm};
                    155: 	$result=13;
1.43      albertel  156:     }
1.11      www       157: 
1.182     albertel  158: # ------------------------------------------------------- second, check default
                    159: 
1.269     raeburn   160:     if (defined($def)) { $outpar[12]=$def; $result=12; }
1.182     albertel  161: 
                    162: # ------------------------------------------------------ third, check map parms
                    163: 
                    164:     my $thisparm=$parmhash{$symbparm};
1.269     raeburn   165:     if (defined($thisparm)) { $outpar[11]=$thisparm; $result=11; }
1.182     albertel  166: 
1.200     www       167:     if (defined($$courseopt{$courselevelr})) {
1.269     raeburn   168: 	$outpar[10]=$$courseopt{$courselevelr};
                    169: 	$result=10;
1.43      albertel  170:     }
1.11      www       171: 
1.182     albertel  172: # ------------------------------------------------------ fourth, back to course
1.71      albertel  173:     if (defined($csec)) {
1.200     www       174:         if (defined($$courseopt{$seclevel})) {
1.269     raeburn   175: 	    $outpar[9]=$$courseopt{$seclevel};
                    176: 	    $result=9;
1.43      albertel  177: 	}
1.200     www       178:         if (defined($$courseopt{$seclevelm})) {
1.269     raeburn   179: 	    $outpar[8]=$$courseopt{$seclevelm};
                    180: 	    $result=8;
1.43      albertel  181: 	}
                    182: 
1.200     www       183:         if (defined($$courseopt{$seclevelr})) {
1.269     raeburn   184: 	    $outpar[7]=$$courseopt{$seclevelr};
                    185: 	    $result=7;
1.43      albertel  186: 	}
                    187:     }
1.275     raeburn   188: # ------------------------------------------------------ fifth, check course group
1.269     raeburn   189:     if (defined($cgroup)) {
                    190:         if (defined($$courseopt{$grplevel})) {
                    191:             $outpar[6]=$$courseopt{$grplevel};
                    192:             $result=6;
                    193:         }
                    194:         if (defined($$courseopt{$grplevelm})) {
                    195:             $outpar[5]=$$courseopt{$grplevelm};
                    196:             $result=5;
                    197:         }
                    198:         if (defined($$courseopt{$grplevelr})) {
                    199:             $outpar[4]=$$courseopt{$grplevelr};
                    200:             $result=4;
                    201:         }
                    202:     }
1.11      www       203: 
1.182     albertel  204: # ---------------------------------------------------------- fifth, check user
1.11      www       205: 
1.71      albertel  206:     if (defined($uname)) {
1.200     www       207: 	if (defined($$useropt{$courselevel})) {
                    208: 	    $outpar[3]=$$useropt{$courselevel};
1.43      albertel  209: 	    $result=3;
                    210: 	}
1.10      www       211: 
1.200     www       212: 	if (defined($$useropt{$courselevelm})) {
                    213: 	    $outpar[2]=$$useropt{$courselevelm};
1.43      albertel  214: 	    $result=2;
                    215: 	}
1.2       www       216: 
1.200     www       217: 	if (defined($$useropt{$courselevelr})) {
                    218: 	    $outpar[1]=$$useropt{$courselevelr};
1.43      albertel  219: 	    $result=1;
                    220: 	}
                    221:     }
1.44      albertel  222:     return ($result,@outpar);
1.2       www       223: }
                    224: 
1.198     www       225: sub resetparmhash {
                    226:     $parmhashid='';
                    227: }
                    228: 
                    229: sub cacheparmhash {
                    230:     if ($parmhashid eq  $env{'request.course.fn'}) { return; }
                    231:     my %parmhashfile;
                    232:     if (tie(%parmhashfile,'GDBM_File',
                    233: 	      $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
                    234: 	%parmhash=%parmhashfile;
                    235: 	untie %parmhashfile;
                    236: 	$parmhashid=$env{'request.course.fn'};
                    237:     }
                    238: }
                    239: 
1.203     www       240: sub resetsymbcache {
                    241:     $symbsid='';
                    242: }
                    243: 
1.201     www       244: sub symbcache {
                    245:     my $id=shift;
                    246:     if ($symbsid ne $env{'request.course.id'}) {
                    247: 	%symbs=();
                    248:     }
                    249:     unless ($symbs{$id}) {
                    250: 	my $navmap = Apache::lonnavmaps::navmap->new();
                    251: 	if ($id=~/\./) {
                    252: 	    my $resource=$navmap->getById($id);
                    253: 	    $symbs{$id}=$resource->symb();
                    254: 	} else {
                    255: 	    my $resource=$navmap->getByMapPc($id);
                    256: 	    $symbs{$id}=&Apache::lonnet::declutter($resource->src());
                    257: 	}
                    258: 	$symbsid=$env{'request.course.id'};
                    259:     }
                    260:     return $symbs{$id};
                    261: }
                    262: 
1.221     www       263: sub resetrulescache {
                    264:     $rulesid='';
                    265: }
                    266: 
                    267: sub rulescache {
                    268:     my $id=shift;
                    269:     if ($rulesid ne $env{'request.course.id'}) {
                    270: 	%rules=();
                    271:     }
1.224     www       272:     unless (defined($rules{$id})) {
1.221     www       273: 	my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    274: 	my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.224     www       275: 	%rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
1.221     www       276: 	$rulesid=$env{'request.course.id'};
                    277:     }
                    278:     return $rules{$id};
                    279: }
                    280: 
1.229     www       281: sub preset_defaults {
                    282:     my $type=shift;
                    283:     if (&rulescache($type.'_action') eq 'default') {
                    284: # yes, there is something
                    285: 	return (&rulescache($type.'_hours'),
                    286: 		&rulescache($type.'_min'),
                    287: 		&rulescache($type.'_sec'),
                    288: 		&rulescache($type.'_value'));
                    289:     } else {
                    290: # nothing there or something else
                    291: 	return ('','','','','');
                    292:     }
                    293: }
                    294: 
1.186     www       295: ##################################################
1.277     www       296: 
                    297: sub date_sanity_info {
                    298:    my $checkdate=shift;
                    299:    unless ($checkdate) { return ''; }
                    300:    my $result='';
                    301:    my $crsprefix='course.'.$env{'request.course.id'}.'.';
                    302:    if ($env{$crsprefix.'default_enrollment_end_date'}) {
                    303:       if ($checkdate>$env{$crsprefix.'default_enrollment_end_date'}) {
                    304:          $result.='<br />'.&mt('After course enrollment end!');
                    305:       }
                    306:    }
                    307:    if ($env{$crsprefix.'default_enrollment_start_date'}) {
                    308:       if ($checkdate<$env{$crsprefix.'default_enrollment_start_date'}) {
                    309:          $result.='<br />'.&mt('Before course enrollment start!');
                    310:       }
                    311:    }
                    312:    return $result;
                    313: }
                    314: ##################################################
1.186     www       315: ##################################################
                    316: #
1.197     www       317: # Store a parameter by ID
1.186     www       318: #
                    319: # Takes
                    320: # - resource id
                    321: # - name of parameter
                    322: # - level
                    323: # - new value
                    324: # - new type
1.187     www       325: # - username
                    326: # - userdomain
                    327: 
1.186     www       328: sub storeparm {
1.269     raeburn   329:     my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.275     raeburn   330:     &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);
1.197     www       331: }
                    332: 
                    333: #
                    334: # Store a parameter by symb
                    335: #
                    336: # Takes
                    337: # - symb
                    338: # - name of parameter
                    339: # - level
                    340: # - new value
                    341: # - new type
                    342: # - username
                    343: # - userdomain
                    344: 
1.226     www       345: my %recstack;
1.197     www       346: sub storeparm_by_symb {
1.275     raeburn   347:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
1.226     www       348:     unless ($recflag) {
                    349: # first time call
                    350: 	%recstack=();
                    351: 	$recflag=1;
                    352:     }
                    353: # store parameter
                    354:     &storeparm_by_symb_inner
1.269     raeburn   355: 	($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
1.266     www       356: # don't do anything if parameter was reset
                    357:     unless ($nval) { return; }
1.226     www       358:     my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/);
                    359: # remember that this was set
                    360:     $recstack{$parm}=1;
                    361: # what does this trigger?
                    362:     foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) {
                    363: # don't backfire
                    364:        unless ((!$triggered) || ($recstack{$triggered})) {
                    365: 	   my $action=&rulescache($triggered.'_action');
                    366: 	   my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                    367: # set triggered parameter on same level
                    368: 	   my $newspnam=$prefix.$triggered;
1.227     www       369: 	   my $newvalue='';
1.228     www       370: 	   my $active=1;
                    371: 	   if ($action=~/^when\_setting/) {
                    372: # are there restrictions?
                    373: 	       if (&rulescache($triggered.'_triggervalue')=~/\w/) {
                    374: 		   $active=0;
                    375: 		   foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
                    376: 		       if (lc($possiblevalue) eq lc($nval)) { $active=1; }
                    377: 		   }
                    378: 	       }
                    379: 	       $newvalue=&rulescache($triggered.'_value');
1.227     www       380: 	   } else {
                    381: 	       my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
1.228     www       382: 	       if ($action=~/^later\_than/) {
                    383: 		   $newvalue=$nval+$totalsecs;
                    384: 	       } else {
                    385: 		   $newvalue=$nval-$totalsecs;
                    386: 	       }
                    387: 	   }
                    388: 	   if ($active) {
                    389: 	       &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
1.275     raeburn   390: 				   $uname,$udom,$csec,$recflag,$cgroup);
1.227     www       391: 	   }
1.226     www       392:        }
                    393:     }
                    394:     return '';
                    395: }
                    396: 
1.284     www       397: {
                    398:     my $logid;
1.285     albertel  399:     sub log_parmset {
1.290     www       400: 	my ($storehash,$delflag,$uname,$udom)=@_;
                    401:         my $logentry=join(',',map {
                    402: 	    &Apache::lonnet::escape($_).'=>'.&Apache::lonnet::escape($$storehash{$_});
                    403: 	} keys %$storehash);
1.284     www       404: 	$logid++;
1.285     albertel  405: 	my $id=time().'00000'.$$.'00000'.$logid;
1.286     www       406: 	&Apache::lonnet::put('nohist_parameterlog',
1.285     albertel  407: 			     {
                    408: 				 $id.'_exe_uname' => $env{'user.name'},
                    409: 				 $id.'_exe_udom'  => $env{'user.domain'},
                    410: 				 $id.'_exe_time'  => time(),
                    411: 				 $id.'_exe_ip'    => $ENV{'REMOTE_ADDR'},
1.290     www       412: 				 $id.'_delflag'   => $delflag,
                    413:                                  $id.'_logentry'  => $logentry,
1.285     albertel  414: 				 $id.'_uname'     => $uname,
                    415: 				 $id.'_udom'      => $udom,
                    416: 			     },
1.284     www       417: 			     $env{'course.'.$env{'request.course.id'}.'.domain'},
                    418: 			     $env{'course.'.$env{'request.course.id'}.'.num'}
                    419: 			     );
                    420:     }
                    421: }
                    422: 
1.226     www       423: sub storeparm_by_symb_inner {
1.197     www       424: # ---------------------------------------------------------- Get symb, map, etc
1.269     raeburn   425:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.197     www       426: # ---------------------------------------------------------- Construct prefixes
1.186     www       427:     $spnam=~s/\_([^\_]+)$/\.$1/;
1.197     www       428:     my $map=(&Apache::lonnet::decode_symb($symb))[0];    
                    429:     my $symbparm=$symb.'.'.$spnam;
                    430:     my $mapparm=$map.'___(all).'.$spnam;
                    431: 
1.269     raeburn   432:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$spnam;
                    433:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
                    434:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    435: 
1.190     albertel  436:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
                    437:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
                    438:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
1.186     www       439:     
1.190     albertel  440:     my $courselevel=$env{'request.course.id'}.'.'.$spnam;
                    441:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
                    442:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.186     www       443:     
                    444:     my $storeunder='';
1.269     raeburn   445:     if (($snum==14) || ($snum==3)) { $storeunder=$courselevel; }
                    446:     if (($snum==13) || ($snum==2)) { $storeunder=$courselevelm; }
                    447:     if (($snum==10) || ($snum==1)) { $storeunder=$courselevelr; }
                    448:     if ($snum==9) { $storeunder=$seclevel; }
                    449:     if ($snum==8) { $storeunder=$seclevelm; }
                    450:     if ($snum==7) { $storeunder=$seclevelr; }
                    451:     if ($snum==6) { $storeunder=$grplevel; }
                    452:     if ($snum==5) { $storeunder=$grplevelm; }
                    453:     if ($snum==4) { $storeunder=$grplevelr; }
                    454: 
1.186     www       455:     
                    456:     my $delete;
                    457:     if ($nval eq '') { $delete=1;}
                    458:     my %storecontent = ($storeunder         => $nval,
                    459: 			$storeunder.'.type' => $ntype);
                    460:     my $reply='';
                    461:     if ($snum>3) {
                    462: # ---------------------------------------------------------------- Store Course
                    463: #
1.200     www       464: 	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    465: 	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.186     www       466: # Expire sheets
                    467: 	&Apache::lonnet::expirespread('','','studentcalc');
1.269     raeburn   468: 	if (($snum==10) || ($snum==7) || ($snum==4)) {
1.197     www       469: 	    &Apache::lonnet::expirespread('','','assesscalc',$symb);
1.269     raeburn   470: 	} elsif (($snum==11) || ($snum==8) || ($snum==5)) {
1.197     www       471: 	    &Apache::lonnet::expirespread('','','assesscalc',$map);
1.186     www       472: 	} else {
                    473: 	    &Apache::lonnet::expirespread('','','assesscalc');
                    474: 	}
                    475: # Store parameter
                    476: 	if ($delete) {
                    477: 	    $reply=&Apache::lonnet::del
1.200     www       478: 		('resourcedata',[keys(%storecontent)],$cdom,$cnum);
1.290     www       479:             &log_parmset(\%storecontent,1);
1.186     www       480: 	} else {
                    481: 	    $reply=&Apache::lonnet::cput
1.200     www       482: 		('resourcedata',\%storecontent,$cdom,$cnum);
1.290     www       483: 	    &log_parmset(\%storecontent);
1.186     www       484: 	}
1.200     www       485: 	&Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
1.186     www       486:     } else {
                    487: # ------------------------------------------------------------------ Store User
                    488: #
                    489: # Expire sheets
                    490: 	&Apache::lonnet::expirespread($uname,$udom,'studentcalc');
                    491: 	if ($snum==1) {
                    492: 	    &Apache::lonnet::expirespread
1.197     www       493: 		($uname,$udom,'assesscalc',$symb);
1.186     www       494: 	} elsif ($snum==2) {
                    495: 	    &Apache::lonnet::expirespread
1.197     www       496: 		($uname,$udom,'assesscalc',$map);
1.186     www       497: 	} else {
                    498: 	    &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
                    499: 	}
                    500: # Store parameter
                    501: 	if ($delete) {
                    502: 	    $reply=&Apache::lonnet::del
                    503: 		('resourcedata',[keys(%storecontent)],$udom,$uname);
1.290     www       504: 	    &log_parmset(\%storecontent,1,$uname,$udom);
1.186     www       505: 	} else {
                    506: 	    $reply=&Apache::lonnet::cput
                    507: 		('resourcedata',\%storecontent,$udom,$uname);
1.290     www       508: 	    &log_parmset(\%storecontent,0,$uname,$udom);
1.186     www       509: 	}
1.191     albertel  510: 	&Apache::lonnet::devalidateuserresdata($uname,$udom);
1.186     www       511:     }
                    512:     
                    513:     if ($reply=~/^error\:(.*)/) {
                    514: 	return "<font color=red>Write Error: $1</font>";
                    515:     }
                    516:     return '';
                    517: }
                    518: 
1.59      matthew   519: ##################################################
                    520: ##################################################
                    521: 
                    522: =pod
                    523: 
                    524: =item valout
                    525: 
                    526: Format a value for output.
                    527: 
                    528: Inputs:  $value, $type
                    529: 
                    530: Returns: $value, formatted for output.  If $type indicates it is a date,
                    531: localtime($value) is returned.
1.9       www       532: 
1.59      matthew   533: =cut
                    534: 
                    535: ##################################################
                    536: ##################################################
1.9       www       537: sub valout {
                    538:     my ($value,$type)=@_;
1.59      matthew   539:     my $result = '';
                    540:     # Values of zero are valid.
                    541:     if (! $value && $value ne '0') {
1.71      albertel  542: 	$result = '&nbsp;&nbsp;';
1.59      matthew   543:     } else {
1.66      www       544:         if ($type eq 'date_interval') {
                    545:             my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($value);
                    546:             $year=$year-70;
                    547:             $mday--;
                    548:             if ($year) {
                    549: 		$result.=$year.' yrs ';
                    550:             }
                    551:             if ($mon) {
                    552: 		$result.=$mon.' mths ';
                    553:             }
                    554:             if ($mday) {
                    555: 		$result.=$mday.' days ';
                    556:             }
                    557:             if ($hour) {
                    558: 		$result.=$hour.' hrs ';
                    559:             }
                    560:             if ($min) {
                    561: 		$result.=$min.' mins ';
                    562:             }
                    563:             if ($sec) {
                    564: 		$result.=$sec.' secs ';
                    565:             }
                    566:             $result=~s/\s+$//;
1.213     www       567:         } elsif (&isdateparm($type)) {
1.277     www       568:             $result = localtime($value).&date_sanity_info($value);
1.59      matthew   569:         } else {
                    570:             $result = $value;
                    571:         }
                    572:     }
                    573:     return $result;
1.9       www       574: }
                    575: 
1.59      matthew   576: ##################################################
                    577: ##################################################
                    578: 
                    579: =pod
1.5       www       580: 
1.59      matthew   581: =item plink
                    582: 
                    583: Produces a link anchor.
                    584: 
                    585: Inputs: $type,$dis,$value,$marker,$return,$call
                    586: 
                    587: Returns: scalar with html code for a link which will envoke the 
                    588: javascript function 'pjump'.
                    589: 
                    590: =cut
                    591: 
                    592: ##################################################
                    593: ##################################################
1.5       www       594: sub plink {
                    595:     my ($type,$dis,$value,$marker,$return,$call)=@_;
1.23      www       596:     my $winvalue=$value;
                    597:     unless ($winvalue) {
1.213     www       598: 	if (&isdateparm($type)) {
1.190     albertel  599:             $winvalue=$env{'form.recent_'.$type};
1.23      www       600:         } else {
1.190     albertel  601:             $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23      www       602:         }
                    603:     }
1.229     www       604:     my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
                    605:     my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
                    606:     unless (defined($winvalue)) { $winvalue=$val; }
1.270     www       607:     return '<table width="100%"><tr valign="top" align="right"><td><a name="'.$marker.'" /></td></tr><tr><td align="center">'.
1.43      albertel  608: 	'<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
1.229     www       609: 	    .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."'".');">'.
1.270     www       610: 		&valout($value,$type).'</a></td></tr></table>';
1.5       www       611: }
                    612: 
1.280     albertel  613: sub page_js {
                    614: 
1.81      www       615:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88      matthew   616:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.280     albertel  617: 
                    618:     return(<<ENDJS);
                    619: <script type="text/javascript">
1.44      albertel  620: 
                    621:     function pclose() {
                    622:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                    623:                  "height=350,width=350,scrollbars=no,menubar=no");
                    624:         parmwin.close();
                    625:     }
                    626: 
1.88      matthew   627:     $pjump_def
1.44      albertel  628: 
                    629:     function psub() {
                    630:         pclose();
                    631:         if (document.parmform.pres_marker.value!='') {
                    632:             document.parmform.action+='#'+document.parmform.pres_marker.value;
                    633:             var typedef=new Array();
                    634:             typedef=document.parmform.pres_type.value.split('_');
                    635:            if (document.parmform.pres_type.value!='') {
                    636:             if (typedef[0]=='date') {
                    637:                 eval('document.parmform.recent_'+
                    638:                      document.parmform.pres_type.value+
                    639: 		     '.value=document.parmform.pres_value.value;');
                    640:             } else {
                    641:                 eval('document.parmform.recent_'+typedef[0]+
                    642: 		     '.value=document.parmform.pres_value.value;');
                    643:             }
                    644: 	   }
                    645:             document.parmform.submit();
                    646:         } else {
                    647:             document.parmform.pres_value.value='';
                    648:             document.parmform.pres_marker.value='';
                    649:         }
                    650:     }
                    651: 
1.57      albertel  652:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                    653:         var options = "width=" + w + ",height=" + h + ",";
                    654:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                    655:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                    656:         var newWin = window.open(url, wdwName, options);
                    657:         newWin.focus();
                    658:     }
1.44      albertel  659: </script>
1.81      www       660: $selscript
1.280     albertel  661: ENDJS
                    662: 
                    663: }
                    664: sub startpage {
                    665:     my ($r) = @_;
1.281     albertel  666: 
1.282     albertel  667:     my %loaditems = ('onunload' => "pclose()",
1.283     albertel  668: 		     'onload'   => "group_or_section('cgroup')",);
1.280     albertel  669: 
1.281     albertel  670:     my $start_page = 
                    671: 	&Apache::loncommon::start_page('Set/Modify Course Parameters',
                    672: 				       &page_js(),
1.282     albertel  673: 				       {'add_entries' => \%loaditems,});
1.280     albertel  674:     my $breadcrumbs = 
                    675: 	&Apache::lonhtmlcommon::breadcrumbs(undef,
                    676: 					    'Table Mode Parameter Setting');
                    677:     $r->print(<<ENDHEAD);
1.281     albertel  678: $start_page
1.193     albertel  679: $breadcrumbs
                    680: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.280     albertel  681: <input type="hidden" value='' name="pres_value" />
                    682: <input type="hidden" value='' name="pres_type" />
                    683: <input type="hidden" value='' name="pres_marker" />
                    684: <input type="hidden" value='1' name="prevvisit" />
1.44      albertel  685: ENDHEAD
                    686: }
                    687: 
1.209     www       688: 
1.44      albertel  689: sub print_row {
1.201     www       690:     my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.275     raeburn   691: 	$defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups)=@_;
                    692:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    693:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    694:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.66      www       695: # get the values for the parameter in cascading order
                    696: # empty levels will remain empty
1.44      albertel  697:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.275     raeburn   698: 	  $rid,$$default{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.66      www       699: # get the type for the parameters
                    700: # problem: these may not be set for all levels
                    701:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
1.275     raeburn   702:                                           $$name{$which}.'.type',$rid,
                    703: 		 $$defaulttype{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.66      www       704: # cascade down manually
1.182     albertel  705:     my $cascadetype=$$defaulttype{$which};
1.269     raeburn   706:     for (my $i=14;$i>0;$i--) {
1.66      www       707: 	 if ($typeoutpar[$i]) { 
                    708:             $cascadetype=$typeoutpar[$i];
                    709: 	} else {
                    710:             $typeoutpar[$i]=$cascadetype;
                    711:         }
                    712:     }
1.57      albertel  713:     my $parm=$$display{$which};
                    714: 
1.203     www       715:     if ($parmlev eq 'full') {
1.57      albertel  716:         $r->print('<td bgcolor='.$defbgtwo.' align="center">'
                    717:                   .$$part{$which}.'</td>');
                    718:     } else {    
                    719:         $parm=~s|\[.*\]\s||g;
                    720:     }
1.231     www       721:     my $automatic=&rulescache(($which=~/\_([^\_]+)$/)[0].'_triggers');
                    722:     if ($automatic) {
                    723: 	$parm.='<font color="red"><br />'.&mt('Automatically sets').' '.join(', ',split(/\:/,$automatic)).'</font>';
                    724:     }
1.159     albertel  725:     $r->print('<td bgcolor='.$defbgone.'>'.$parm.'</td>');
1.57      albertel  726:    
1.44      albertel  727:     my $thismarker=$which;
                    728:     $thismarker=~s/^parameter\_//;
                    729:     my $mprefix=$rid.'&'.$thismarker.'&';
1.275     raeburn   730:     my $effective_parm = &valout($outpar[$result],$typeoutpar[$result]);
                    731:     my ($othergrp,$grp_parm,$controlgrp);
1.44      albertel  732: 
1.57      albertel  733:     if ($parmlev eq 'general') {
                    734: 
                    735:         if ($uname) {
1.66      www       736:             &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.269     raeburn   737:         } elsif ($cgroup) {
                    738:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  739:         } elsif ($csec) {
1.269     raeburn   740:             &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); 
1.57      albertel  741:         } else {
1.269     raeburn   742:             &print_td($r,14,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); 
1.57      albertel  743:         }
                    744:     } elsif ($parmlev eq 'map') {
                    745: 
                    746:         if ($uname) {
1.66      www       747:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.269     raeburn   748:         } elsif ($cgroup) {
                    749:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  750:         } elsif ($csec) {
1.269     raeburn   751:             &print_td($r,8,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  752:         } else {
1.269     raeburn   753:             &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  754:         }
                    755:     } else {
1.275     raeburn   756:         if ($uname) {
                    757:             if (@{$usersgroups} > 1) {
                    758:                 my ($coursereply,$grp_parm,$controlgrp);
                    759:                 ($coursereply,$othergrp,$grp_parm,$controlgrp) =
                    760:                     &print_usergroups($r,$$part{$which}.'.'.$$name{$which},
                    761:                        $rid,$cgroup,$defbgone,$usersgroups,$result,$courseopt);
                    762:                 if ($coursereply && $result > 3) {
                    763:                     if (defined($controlgrp)) {
                    764:                         if ($cgroup ne $controlgrp) {
                    765:                             $effective_parm = $grp_parm;
                    766:                             $result = 0;
                    767:                         }
                    768:                     }
                    769:                 }
                    770:             }
                    771:         }
1.57      albertel  772: 
1.269     raeburn   773:         &print_td($r,14,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  774: 
1.269     raeburn   775: 	&print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    776: 	&print_td($r,12,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    777: 	&print_td($r,11,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.203     www       778: 	&print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    779: 	
                    780: 	if ($csec) {
1.269     raeburn   781: 	    &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    782: 	    &print_td($r,8,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    783: 	    &print_td($r,7,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.203     www       784: 	}
1.269     raeburn   785: 
                    786:         if ($cgroup) {
                    787:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    788:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    789:             &print_td($r,4,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    790:         }
1.275     raeburn   791:      
1.203     www       792: 	if ($uname) {
1.275     raeburn   793:             if ($othergrp) {
                    794:                 $r->print($othergrp);
                    795:             }
1.203     www       796: 	    &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    797: 	    &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    798: 	    &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    799: 	}
1.57      albertel  800: 
                    801:     } # end of $parmlev if/else
1.275     raeburn   802:     $r->print('<td bgcolor="#CCCCFF" align="center">'.$effective_parm.'</td>');
1.136     albertel  803: 
1.203     www       804:     if ($parmlev eq 'full') {
1.136     albertel  805:         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201     www       806:                                         '.'.$$name{$which},$$symbp{$rid});
1.136     albertel  807:         my $sessionvaltype=$typeoutpar[$result];
                    808:         if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; }
1.275     raeburn   809:         $r->print('<td bgcolor="#999999" align="center"><font color="#FFFFFF">'.
1.66      www       810:                   &valout($sessionval,$sessionvaltype).'&nbsp;'.
1.57      albertel  811:                   '</font></td>');
1.136     albertel  812:     }
1.44      albertel  813:     $r->print('</tr>');
1.57      albertel  814:     $r->print("\n");
1.44      albertel  815: }
1.59      matthew   816: 
1.44      albertel  817: sub print_td {
1.66      www       818:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display)=@_;
1.57      albertel  819:     $r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg).
1.114     www       820:               ' align="center">');
1.269     raeburn   821:     if ($which<11 || $which > 12) {
1.114     www       822: 	$r->print(&plink($$typeoutpar[$which],
                    823: 			 $$display{$value},$$outpar[$which],
                    824: 			 $mprefix."$which",'parmform.pres','psub'));
                    825:     } else {
                    826: 	$r->print(&valout($$outpar[$which],$$typeoutpar[$which]));
                    827:     }
                    828:     $r->print('</td>'."\n");
1.57      albertel  829: }
                    830: 
1.275     raeburn   831: sub print_usergroups {
                    832:     my ($r,$what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
                    833:     my $courseid = $env{'request.course.id'};
                    834:     my $output;
                    835:     my $symb = &symbcache($rid);
                    836:     my $symbparm=$symb.'.'.$what;
                    837:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
                    838:     my $mapparm=$map.'___(all).'.$what;
                    839:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype) =
                    840:           &parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,$what,
                    841:                                                                    $courseopt);
                    842:     my $bgcolor = $defbg;
                    843:     my $grp_parm;
                    844:     if (($coursereply) && ($cgroup ne $resultgroup)) { 
                    845:         if ($result > 3) {
                    846:             $bgcolor = '"#AAFFAA"';
                    847:             $grp_parm = &valout($coursereply,$resulttype);
                    848:         }
                    849:         $grp_parm = &valout($coursereply,$resulttype);
                    850:         $output = '<td bgcolor='.$bgcolor.' align="center">';
                    851:         if ($resultgroup && $resultlevel) {
                    852:             $output .= '<small><b>'.$resultgroup.'</b> ('.$resultlevel.'): </small>'.$grp_parm;
                    853:         } else {
                    854:             $output .= '&nbsp;';
                    855:         }
                    856:         $output .= '</td>';
                    857:     } else {
                    858:         $output .= '<td bgcolor='.$bgcolor.'>&nbsp;</td>';
                    859:     }
                    860:     return ($coursereply,$output,$grp_parm,$resultgroup);
                    861: }
                    862: 
                    863: sub parm_control_group {
                    864:     my ($courseid,$usersgroups,$symbparm,$mapparm,$what,$courseopt) = @_;
                    865:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                    866:     my $grpfound = 0;
                    867:     my @levels = ($symbparm,$mapparm,$what);
                    868:     my @levelnames = ('resource','map/folder','general');
                    869:     foreach my $group (@{$usersgroups}) {
                    870:         if ($grpfound) { last; }
                    871:         for (my $i=0; $i<@levels; $i++) {
                    872:             my $item = $courseid.'.['.$group.'].'.$levels[$i];
                    873:             if (defined($$courseopt{$item})) {
                    874:                 $coursereply = $$courseopt{$item};
                    875:                 $resultitem = $item;
                    876:                 $resultgroup = $group;
                    877:                 $resultlevel = $levelnames[$i];
                    878:                 $resulttype = $$courseopt{$item.'.type'};
                    879:                 $grpfound = 1;
                    880:                 last;
                    881:             }
                    882:         }
                    883:     }
                    884:     return($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                    885: }
1.201     www       886: 
1.63      bowersj2  887: =pod
                    888: 
                    889: =item B<extractResourceInformation>: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes.
                    890: 
                    891: Input: See list below:
                    892: 
                    893: =over 4
                    894: 
                    895: =item B<ids>: An array that will contain all of the ids in the course.
                    896: 
                    897: =item B<typep>: hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
                    898: 
1.171     www       899: =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  900: 
                    901: =item B<allparms>: hash, name of parameter->display value (what is the display value?)
                    902: 
                    903: =item B<allparts>: hash, part identification->text representation of part, where the text representation is "[Part $part]"
                    904: 
                    905: =item B<allkeys>: hash, full key to part->display value (what's display value?)
                    906: 
                    907: =item B<allmaps>: hash, ???
                    908: 
                    909: =item B<fcat>: ???
                    910: 
                    911: =item B<defp>: hash, ???
                    912: 
                    913: =item B<mapp>: ??
                    914: 
                    915: =item B<symbp>: hash, id->full sym?
                    916: 
                    917: =back
                    918: 
                    919: =cut
                    920: 
                    921: sub extractResourceInformation {
                    922:     my $ids = shift;
                    923:     my $typep = shift;
                    924:     my $keyp = shift;
                    925:     my $allparms = shift;
                    926:     my $allparts = shift;
                    927:     my $allmaps = shift;
                    928:     my $mapp = shift;
                    929:     my $symbp = shift;
1.82      www       930:     my $maptitles=shift;
1.196     www       931:     my $uris=shift;
1.210     www       932:     my $keyorder=shift;
1.211     www       933:     my $defkeytype=shift;
1.196     www       934: 
1.210     www       935:     my $keyordercnt=100;
1.63      bowersj2  936: 
1.196     www       937:     my $navmap = Apache::lonnavmaps::navmap->new();
                    938:     my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
                    939:     foreach my $resource (@allres) {
                    940: 	my $id=$resource->id();
                    941:         my ($mapid,$resid)=split(/\./,$id);
                    942: 	if ($mapid eq '0') { next; }
                    943: 	$$ids[$#$ids+1]=$id;
                    944: 	my $srcf=$resource->src();
                    945: 	$srcf=~/\.(\w+)$/;
                    946: 	$$typep{$id}=$1;
                    947: 	$$keyp{$id}='';
                    948:         $$uris{$id}=$srcf;
                    949: 	foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
                    950: 	    if ($_=~/^parameter\_(.*)/) {
                    951: 		my $key=$_;
1.209     www       952: # Hidden parameters
                    953: 		if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm') {
                    954: 		    next;
1.63      bowersj2  955: 		}
1.196     www       956: 		my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
                    957: 		my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
                    958: 		my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
1.209     www       959: #
                    960: # allparms is a hash of parameter names
                    961: #
1.196     www       962: 		my $parmdis = $display;
1.209     www       963: 		$parmdis =~ s/\[Part.*$//g;
                    964:                 $$allparms{$name}=$parmdis;
1.211     www       965: 		$$defkeytype{$name}=&Apache::lonnet::metadata($srcf,$key.'.type');
1.209     www       966: #
                    967: # allparts is a hash of all parts
                    968: #
                    969: 		$$allparts{$part} = "Part: $part";
                    970: #
                    971: # Remember all keys going with this resource
                    972: #
1.196     www       973: 		if ($$keyp{$id}) {
                    974: 		    $$keyp{$id}.=','.$key;
1.175     albertel  975: 		} else {
1.196     www       976: 		    $$keyp{$id}=$key;
1.175     albertel  977: 		}
1.210     www       978: #
                    979: # Put in order
                    980: # 
                    981:                 unless ($$keyorder{$key}) {
                    982:                     $$keyorder{$key}=$keyordercnt;
                    983:                     $keyordercnt++;
                    984: 		}
                    985: 
1.63      bowersj2  986: 	    }
                    987: 	}
1.196     www       988: 	$$mapp{$id}=
                    989: 	    &Apache::lonnet::declutter($resource->enclosing_map_src());
                    990: 	$$mapp{$mapid}=$$mapp{$id};
                    991: 	$$allmaps{$mapid}=$$mapp{$id};
                    992: 	if ($mapid eq '1') {
                    993: 	    $$maptitles{$mapid}='Main Course Documents';
                    994: 	} else {
                    995: 	    $$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id}));
                    996: 	}
                    997: 	$$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
                    998: 	$$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
                    999: 	$$symbp{$mapid}=$$mapp{$id}.'___(all)';
1.63      bowersj2 1000:     }
                   1001: }
                   1002: 
1.208     www      1003: 
                   1004: ##################################################
                   1005: ##################################################
                   1006: 
1.213     www      1007: sub isdateparm {
                   1008:     my $type=shift;
                   1009:     return (($type=~/^date/) && (!($type eq 'date_interval')));
                   1010: }
                   1011: 
1.208     www      1012: sub parmmenu {
1.211     www      1013:     my ($r,$allparms,$pscat,$keyorder)=@_;
1.208     www      1014:     my $tempkey;
                   1015:     $r->print(<<ENDSCRIPT);
                   1016: <script type="text/javascript">
                   1017:     function checkall(value, checkName) {
                   1018: 	for (i=0; i<document.forms.parmform.elements.length; i++) {
                   1019:             ele = document.forms.parmform.elements[i];
                   1020:             if (ele.name == checkName) {
                   1021:                 document.forms.parmform.elements[i].checked=value;
                   1022:             }
                   1023:         }
                   1024:     }
1.210     www      1025: 
                   1026:     function checkthis(thisvalue, checkName) {
                   1027: 	for (i=0; i<document.forms.parmform.elements.length; i++) {
                   1028:             ele = document.forms.parmform.elements[i];
                   1029:             if (ele.name == checkName) {
                   1030: 		if (ele.value == thisvalue) {
                   1031: 		    document.forms.parmform.elements[i].checked=true;
                   1032: 		}
                   1033:             }
                   1034:         }
                   1035:     }
                   1036: 
                   1037:     function checkdates() {
                   1038: 	checkthis('duedate','pscat');
                   1039:  	checkthis('opendate','pscat');
                   1040: 	checkthis('answerdate','pscat');
1.218     www      1041:     }
                   1042: 
                   1043:     function checkdisset() {
                   1044: 	checkthis('discussend','pscat');
                   1045:  	checkthis('discusshide','pscat');
                   1046:     }
                   1047: 
                   1048:     function checkcontdates() {
                   1049: 	checkthis('contentopen','pscat');
                   1050:  	checkthis('contentclose','pscat');
                   1051:     }
                   1052:  
1.210     www      1053: 
                   1054:     function checkvisi() {
                   1055: 	checkthis('hiddenresource','pscat');
                   1056:  	checkthis('encrypturl','pscat');
                   1057: 	checkthis('problemstatus','pscat');
                   1058: 	checkthis('contentopen','pscat');
                   1059: 	checkthis('opendate','pscat');
                   1060:     }
                   1061: 
                   1062:     function checkparts() {
                   1063: 	checkthis('hiddenparts','pscat');
                   1064: 	checkthis('display','pscat');
                   1065: 	checkthis('ordered','pscat');
                   1066:     }
                   1067: 
                   1068:     function checkstandard() {
                   1069:         checkall(false,'pscat');
                   1070: 	checkdates();
                   1071: 	checkthis('weight','pscat');
                   1072: 	checkthis('maxtries','pscat');
                   1073:     }
                   1074: 
1.208     www      1075: </script>
                   1076: ENDSCRIPT
1.209     www      1077:     $r->print();
1.208     www      1078:     $r->print("\n<table><tr>");
                   1079:     my $cnt=0;
1.211     www      1080:     foreach $tempkey (&keysindisplayorder($allparms,$keyorder)) {
1.235     albertel 1081: 	$r->print("\n<td><font size='-1'><label><input type='checkbox' name='pscat' ");
1.208     www      1082: 	$r->print('value="'.$tempkey.'"');
                   1083: 	if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
                   1084: 	    $r->print(' checked');
                   1085: 	}
1.235     albertel 1086: 	$r->print('>'.$$allparms{$tempkey}.'</label></font></td>');
1.209     www      1087:  	$cnt++;
                   1088:         if ($cnt==3) {
                   1089: 	    $r->print("</tr>\n<tr>");
                   1090: 	    $cnt=0;
                   1091: 	}
1.208     www      1092:     }
                   1093:     $r->print('
                   1094: </tr><tr><td>
1.233     albertel 1095: <a href="javascript:checkall(true, \'pscat\')">Select&nbsp;All</a><br />
                   1096: <a href="javascript:checkstandard()">Select&nbsp;Common&nbsp;Only</a>
1.210     www      1097: </td><td>
1.233     albertel 1098: <a href="javascript:checkdates()">Add&nbsp;Problem&nbsp;Dates</a>
                   1099: <a href="javascript:checkcontdates()">Add&nbsp;Content&nbsp;Dates</a><br />
                   1100: <a href="javascript:checkdisset()">Add&nbsp;Discussion&nbsp;Settings</a>
                   1101: <a href="javascript:checkvisi()">Add&nbsp;Visibilities</a><br />
                   1102: <a href="javascript:checkparts()">Add&nbsp;Part&nbsp;Parameters</a>
1.210     www      1103: </td><td>
1.233     albertel 1104: <a href="javascript:checkall(false, \'pscat\')">Unselect&nbsp;All</a>
1.208     www      1105: </td>
                   1106: ');
                   1107:     $r->print('</tr></table>');
                   1108: }
                   1109: 
1.209     www      1110: sub partmenu {
                   1111:     my ($r,$allparts,$psprt)=@_;
1.211     www      1112:     $r->print('<select multiple name="psprt" size="8">');
1.208     www      1113:     $r->print('<option value="all"');
                   1114:     $r->print(' selected') unless (@{$psprt});
                   1115:     $r->print('>'.&mt('All Parts').'</option>');
                   1116:     my %temphash=();
                   1117:     foreach (@{$psprt}) { $temphash{$_}=1; }
1.234     albertel 1118:     foreach my $tempkey (sort {
                   1119: 	if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); }
                   1120:     } keys(%{$allparts})) {
1.208     www      1121: 	unless ($tempkey =~ /\./) {
                   1122: 	    $r->print('<option value="'.$tempkey.'"');
                   1123: 	    if ($$psprt[0] eq "all" ||  $temphash{$tempkey}) {
                   1124: 		$r->print(' selected');
                   1125: 	    }
                   1126: 	    $r->print('>'.$$allparts{$tempkey}.'</option>');
                   1127: 	}
                   1128:     }
1.209     www      1129:     $r->print('</select>');
                   1130: }
                   1131: 
                   1132: sub usermenu {
1.275     raeburn  1133:     my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups)=@_;
1.209     www      1134:     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                   1135:         &Apache::loncommon::selectstudent_link('parmform','uname','udom');
                   1136:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
                   1137:     my %lt=&Apache::lonlocal::texthash(
1.269     raeburn  1138: 		    'se'    => "Section",
                   1139:                     'gr'    => "Group",
1.209     www      1140: 		    'fu'    => "For User",
                   1141: 		    'oi'    => "or ID",
                   1142: 		    'ad'    => "at Domain"
                   1143: 				       );
                   1144:     my %sectionhash=();
                   1145:     my $sections='';
1.269     raeburn  1146:     my $numsec = &Apache::loncommon::get_sections(
1.209     www      1147:                  $env{'course.'.$env{'request.course.id'}.'.domain'},
                   1148:                  $env{'course.'.$env{'request.course.id'}.'.num'},
1.269     raeburn  1149: 					 \%sectionhash);
                   1150:     my $groups;
                   1151:     my %grouphash;
                   1152:     my $numgrp = &Apache::loncommon::coursegroups(
                   1153:                  \%grouphash,
                   1154:                  $env{'course.'.$env{'request.course.id'}.'.domain'},
                   1155:                  $env{'course.'.$env{'request.course.id'}.'.num'});
                   1156:     if ($numsec > 0) {
                   1157:         $sections=$lt{'se'}.': <select name="csec"';
                   1158:         if ($numsec && $numgrp && $parmlev ne 'full') {
                   1159:             $sections .= qq| onchange="group_or_section('csec')" |;
                   1160:         }
                   1161:         $sections .= '>';
1.275     raeburn  1162: 	foreach my $section ('',sort keys %sectionhash) {
                   1163: 	    $sections.='<option value="'.$section.'" '.
                   1164: 		($section eq $csec?'selected="selected"':'').'>'.$section.
                   1165:                                                               '</option>';
1.209     www      1166:         }
                   1167:         $sections.='</select>';
1.269     raeburn  1168:     }
                   1169:     if ($numsec && $numgrp && $parmlev ne 'full') {
                   1170:         $sections .= '&nbsp;or&nbsp;';
                   1171:         $sections .= qq|
                   1172: <script type="text/javascript">
                   1173: function group_or_section(caller) {
                   1174:    if (caller == "cgroup") {
                   1175:        if (document.parmform.cgroup.selectedIndex != 0) {
                   1176:            document.parmform.csec.selectedIndex = 0;
                   1177:        }
                   1178:    } else {
                   1179:        if (document.parmform.csec.selectedIndex != 0) {
                   1180:            document.parmform.cgroup.selectedIndex = 0;
                   1181:        }
                   1182:    }
                   1183: }
                   1184: </script>
                   1185: |;
                   1186:     } else {
                   1187:         $sections .= qq|
                   1188: <script type="text/javascript">
                   1189: function group_or_section(caller) {
                   1190:     return;
                   1191: }
                   1192: </script>
                   1193: |;
                   1194:     } 
                   1195:     if ($numgrp > 0) {
                   1196:         $groups=$lt{'gr'}.': <select name="cgroup"';
                   1197:         if ($numsec && $numgrp && $env{'form.action'} eq 'settable') {
                   1198:             $groups .= qq| onchange="group_or_section('cgroup')" |;
                   1199:         }
                   1200:         $groups .= '>';
1.275     raeburn  1201:         foreach my $grp ('',sort keys %grouphash) {
                   1202:             $groups.='<option value="'.$grp.'" ';
                   1203:             if ($grp eq $cgroup) {
                   1204:                 unless ((defined($uname)) && ($grp eq '')) {
                   1205:                     $groups .=  'selected="selected" ';
                   1206:                 }
                   1207:             } elsif (!defined($cgroup)) {
                   1208:                 if (@{$usersgroups} == 1) {
                   1209:                     if ($grp eq $$usersgroups[0]) {
                   1210:                         $groups .=  'selected="selected" ';
                   1211:                     }
                   1212:                 }
                   1213:             }
                   1214:             $groups .= '>'.$grp.'</option>';
1.269     raeburn  1215:         }
                   1216:         $groups.='</select>';
                   1217:     }
                   1218:     $r->print(<<ENDMENU);
1.209     www      1219: <b>
                   1220: $sections
1.269     raeburn  1221: $groups
1.209     www      1222: <br />
                   1223: $lt{'fu'} 
                   1224: <input type="text" value="$uname" size="12" name="uname" />
                   1225: $lt{'oi'}
                   1226: <input type="text" value="$id" size="12" name="id" /> 
                   1227: $lt{'ad'}
                   1228: $chooseopt
                   1229: </b>
                   1230: ENDMENU
                   1231: }
                   1232: 
                   1233: sub displaymenu {
1.211     www      1234:     my ($r,$allparms,$allparts,$pscat,$psprt,$keyorder)=@_;
1.209     www      1235:     $r->print('<table border="1"><tr><th>'.&mt('Select Parameters to View').'</th><th>'.
                   1236: 	     &mt('Select Parts to View').'</th></tr><tr><td>');  
1.211     www      1237:     &parmmenu($r,$allparms,$pscat,$keyorder);
1.209     www      1238:     $r->print('</td><td>');
                   1239:     &partmenu($r,$allparts,$psprt);
                   1240:     $r->print('</td></tr></table>');
                   1241: }
                   1242: 
                   1243: sub mapmenu {
                   1244:     my ($r,$allmaps,$pschp,$maptitles)=@_;
1.231     www      1245:     $r->print('<b>'.&mt('Select Enclosing Map or Folder').'</b> ');
1.209     www      1246:     $r->print('<select name="pschp">');
                   1247:     $r->print('<option value="all">'.&mt('All Maps or Folders').'</option>');
                   1248:     foreach (sort {$$allmaps{$a} cmp $$allmaps{$b}} keys %{$allmaps}) {
1.208     www      1249: 	$r->print('<option value="'.$_.'"');
1.209     www      1250: 	if (($pschp eq $_)) { $r->print(' selected'); }
                   1251: 	$r->print('>'.$$maptitles{$_}.($$allmaps{$_}!~/^uploaded/?' ['.$$allmaps{$_}.']':'').'</option>');
                   1252:     }
                   1253:     $r->print("</select>");
                   1254: }
                   1255: 
                   1256: sub levelmenu {
                   1257:     my ($r,$alllevs,$parmlev)=@_;
1.231     www      1258:     $r->print('<b>'.&mt('Select Parameter Level').
                   1259: 	      &Apache::loncommon::help_open_topic('Course_Parameter_Levels').'</b> ');
1.209     www      1260:     $r->print('<select name="parmlev">');
                   1261:     foreach (reverse sort keys %{$alllevs}) {
                   1262: 	$r->print('<option value="'.$$alllevs{$_}.'"');
                   1263: 	if ($parmlev eq $$alllevs{$_}) {
                   1264: 	    $r->print(' selected'); 
                   1265: 	}
                   1266: 	$r->print('>'.$_.'</option>');
1.208     www      1267:     }
1.209     www      1268:     $r->print("</select>");
1.208     www      1269: }
                   1270: 
1.211     www      1271: 
                   1272: sub sectionmenu {
                   1273:     my ($r,$selectedsections)=@_;
1.212     www      1274:     my %sectionhash=();
1.269     raeburn  1275:     my $sections='';
                   1276:     my $numsec = &Apache::loncommon::get_sections(
1.212     www      1277:                  $env{'course.'.$env{'request.course.id'}.'.domain'},
                   1278:                  $env{'course.'.$env{'request.course.id'}.'.num'},
1.269     raeburn  1279: 					 \%sectionhash);
                   1280:     if ($numsec) {
1.212     www      1281: 	$r->print('<select name="Section" multiple="true" size="8" >');
                   1282: 	foreach my $s ('all',sort keys %sectionhash) {
                   1283: 	    $r->print('    <option value="'.$s.'"');
                   1284: 	    foreach (@{$selectedsections}) {
                   1285: 		if ($s eq $_) {
                   1286: 		    $r->print(' selected');
                   1287: 		    last;
                   1288: 		}
                   1289: 	    }
                   1290: 	    $r->print('>'.$s."</option>\n");
                   1291: 	}
1.269     raeburn  1292:         $r->print("</select>\n");
                   1293:    }
                   1294: }
                   1295: 
                   1296: sub groupmenu {
                   1297:     my ($r,$selectedgroups)=@_;
                   1298:     my %grouphash;
                   1299:     my $numgrp = &Apache::loncommon::coursegroups(
                   1300:                  \%grouphash,
                   1301:                  $env{'course.'.$env{'request.course.id'}.'.domain'},
                   1302:                  $env{'course.'.$env{'request.course.id'}.'.num'});
                   1303:     if ($numgrp) {
                   1304:         $r->print('<select name="Group" multiple="true" size="8" >');
                   1305:         foreach my $group (sort(keys(%grouphash))) {
                   1306:             $r->print('    <option value="'.$group.'"');
                   1307:             foreach (@{$selectedgroups}) {
                   1308:                 if ($group eq $_) {
                   1309:                     $r->print(' selected');
                   1310:                     last;
                   1311:                 }
                   1312:             }
                   1313:             $r->print('>'.$group."</option>\n");
                   1314:         }
                   1315:         $r->print("</select>\n");
1.211     www      1316:     }
                   1317: }
                   1318: 
1.269     raeburn  1319: 
1.210     www      1320: sub keysplit {
                   1321:     my $keyp=shift;
                   1322:     return (split(/\,/,$keyp));
                   1323: }
                   1324: 
                   1325: sub keysinorder {
                   1326:     my ($name,$keyorder)=@_;
                   1327:     return sort {
                   1328: 	$$keyorder{$a} <=> $$keyorder{$b};
                   1329:     } (keys %{$name});
                   1330: }
                   1331: 
1.236     albertel 1332: sub keysinorder_bytype {
                   1333:     my ($name,$keyorder)=@_;
                   1334:     return sort {
                   1335: 	my $ta=(split('_',$a))[-1];
                   1336: 	my $tb=(split('_',$b))[-1];
                   1337: 	if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
                   1338: 	    return ($a cmp $b);
                   1339: 	}
                   1340: 	$$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
                   1341:     } (keys %{$name});
                   1342: }
                   1343: 
1.211     www      1344: sub keysindisplayorder {
                   1345:     my ($name,$keyorder)=@_;
                   1346:     return sort {
                   1347: 	$$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
                   1348:     } (keys %{$name});
                   1349: }
                   1350: 
1.214     www      1351: sub sortmenu {
                   1352:     my ($r,$sortorder)=@_;
1.236     albertel 1353:     $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214     www      1354:     if ($sortorder eq 'realmstudent') {
                   1355:        $r->print(' checked="on"');
                   1356:     }
                   1357:     $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236     albertel 1358:     $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214     www      1359:     if ($sortorder eq 'studentrealm') {
                   1360:        $r->print(' checked="on"');
                   1361:     }
1.236     albertel 1362:     $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
                   1363: 	      '</label>');
1.214     www      1364: }
                   1365: 
1.211     www      1366: sub standardkeyorder {
                   1367:     return ('parameter_0_opendate' => 1,
                   1368: 	    'parameter_0_duedate' => 2,
                   1369: 	    'parameter_0_answerdate' => 3,
                   1370: 	    'parameter_0_interval' => 4,
                   1371: 	    'parameter_0_weight' => 5,
                   1372: 	    'parameter_0_maxtries' => 6,
                   1373: 	    'parameter_0_hinttries' => 7,
                   1374: 	    'parameter_0_contentopen' => 8,
                   1375: 	    'parameter_0_contentclose' => 9,
                   1376: 	    'parameter_0_type' => 10,
                   1377: 	    'parameter_0_problemstatus' => 11,
                   1378: 	    'parameter_0_hiddenresource' => 12,
                   1379: 	    'parameter_0_hiddenparts' => 13,
                   1380: 	    'parameter_0_display' => 14,
                   1381: 	    'parameter_0_ordered' => 15,
                   1382: 	    'parameter_0_tol' => 16,
                   1383: 	    'parameter_0_sig' => 17,
1.218     www      1384: 	    'parameter_0_turnoffunit' => 18,
                   1385:             'parameter_0_discussend' => 19,
                   1386:             'parameter_0_discusshide' => 20);
1.211     www      1387: }
                   1388: 
1.59      matthew  1389: ##################################################
                   1390: ##################################################
                   1391: 
                   1392: =pod
                   1393: 
                   1394: =item assessparms
                   1395: 
                   1396: Show assessment data and parameters.  This is a large routine that should
                   1397: be simplified and shortened... someday.
                   1398: 
                   1399: Inputs: $r
                   1400: 
                   1401: Returns: nothing
                   1402: 
1.63      bowersj2 1403: Variables used (guessed by Jeremy):
                   1404: 
                   1405: =over 4
                   1406: 
                   1407: =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.
                   1408: 
                   1409: =item B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
                   1410: 
                   1411: =item B<allmaps>:
                   1412: 
                   1413: =back
                   1414: 
1.59      matthew  1415: =cut
                   1416: 
                   1417: ##################################################
                   1418: ##################################################
1.30      www      1419: sub assessparms {
1.1       www      1420: 
1.43      albertel 1421:     my $r=shift;
1.201     www      1422: 
                   1423:     my @ids=();
                   1424:     my %symbp=();
                   1425:     my %mapp=();
                   1426:     my %typep=();
                   1427:     my %keyp=();
                   1428:     my %uris=();
                   1429:     my %maptitles=();
                   1430: 
1.2       www      1431: # -------------------------------------------------------- Variable declaration
1.209     www      1432: 
1.129     www      1433:     my %allmaps=();
                   1434:     my %alllevs=();
1.57      albertel 1435: 
1.187     www      1436:     my $uname;
                   1437:     my $udom;
                   1438:     my $uhome;
                   1439:     my $csec;
1.269     raeburn  1440:     my $cgroup;
1.275     raeburn  1441:     my $grouplist;
                   1442:     my @usersgroups = ();
1.187     www      1443:  
1.190     albertel 1444:     my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187     www      1445: 
1.57      albertel 1446:     $alllevs{'Resource Level'}='full';
1.215     www      1447:     $alllevs{'Map/Folder Level'}='map';
1.57      albertel 1448:     $alllevs{'Course Level'}='general';
                   1449: 
                   1450:     my %allparms;
                   1451:     my %allparts;
1.210     www      1452: #
                   1453: # Order in which these parameters will be displayed
                   1454: #
1.211     www      1455:     my %keyorder=&standardkeyorder();
                   1456: 
1.43      albertel 1457:     @ids=();
                   1458:     %symbp=();
                   1459:     %typep=();
                   1460: 
                   1461:     my $message='';
                   1462: 
1.190     albertel 1463:     $csec=$env{'form.csec'};
1.269     raeburn  1464:     $cgroup=$env{'form.cgroup'};
1.188     www      1465: 
1.190     albertel 1466:     if      ($udom=$env{'form.udom'}) {
                   1467:     } elsif ($udom=$env{'request.role.domain'}) {
                   1468:     } elsif ($udom=$env{'user.domain'}) {
1.172     albertel 1469:     } else {
                   1470: 	$udom=$r->dir_config('lonDefDomain');
                   1471:     }
1.43      albertel 1472: 
1.134     albertel 1473:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190     albertel 1474:     my $pschp=$env{'form.pschp'};
1.134     albertel 1475:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.76      www      1476:     if (!@psprt) { $psprt[0]='0'; }
1.57      albertel 1477: 
1.43      albertel 1478:     my $pssymb='';
1.57      albertel 1479:     my $parmlev='';
                   1480:  
1.190     albertel 1481:     unless ($env{'form.parmlev'}) {
1.57      albertel 1482:         $parmlev = 'map';
                   1483:     } else {
1.190     albertel 1484:         $parmlev = $env{'form.parmlev'};
1.57      albertel 1485:     }
1.26      www      1486: 
1.29      www      1487: # ----------------------------------------------- Was this started from grades?
                   1488: 
1.190     albertel 1489:     if (($env{'form.command'} eq 'set') && ($env{'form.url'})
                   1490: 	&& (!$env{'form.dis'})) {
                   1491: 	my $url=$env{'form.url'};
1.194     albertel 1492: 	$url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.43      albertel 1493: 	$pssymb=&Apache::lonnet::symbread($url);
1.92      albertel 1494: 	if (!@pscat) { @pscat=('all'); }
1.43      albertel 1495: 	$pschp='';
1.57      albertel 1496:         $parmlev = 'full';
1.190     albertel 1497:     } elsif ($env{'form.symb'}) {
                   1498: 	$pssymb=$env{'form.symb'};
1.92      albertel 1499: 	if (!@pscat) { @pscat=('all'); }
1.43      albertel 1500: 	$pschp='';
1.57      albertel 1501:         $parmlev = 'full';
1.43      albertel 1502:     } else {
1.190     albertel 1503: 	$env{'form.url'}='';
1.43      albertel 1504:     }
                   1505: 
1.190     albertel 1506:     my $id=$env{'form.id'};
1.43      albertel 1507:     if (($id) && ($udom)) {
                   1508: 	$uname=(&Apache::lonnet::idget($udom,$id))[1];
                   1509: 	if ($uname) {
                   1510: 	    $id='';
                   1511: 	} else {
                   1512: 	    $message=
1.133     www      1513: 		"<font color=red>".&mt("Unknown ID")." '$id' ".
                   1514: 		&mt('at domain')." '$udom'</font>";
1.43      albertel 1515: 	}
                   1516:     } else {
1.190     albertel 1517: 	$uname=$env{'form.uname'};
1.43      albertel 1518:     }
                   1519:     unless ($udom) { $uname=''; }
                   1520:     $uhome='';
                   1521:     if ($uname) {
                   1522: 	$uhome=&Apache::lonnet::homeserver($uname,$udom);
                   1523:         if ($uhome eq 'no_host') {
                   1524: 	    $message=
1.133     www      1525: 		"<font color=red>".&mt("Unknown user")." '$uname' ".
                   1526: 		&mt("at domain")." '$udom'</font>";
1.43      albertel 1527: 	    $uname='';
1.12      www      1528:         } else {
1.103     albertel 1529: 	    $csec=&Apache::lonnet::getsection($udom,$uname,
1.190     albertel 1530: 					      $env{'request.course.id'});
1.269     raeburn  1531:             
1.43      albertel 1532: 	    if ($csec eq '-1') {
                   1533: 		$message="<font color=red>".
1.133     www      1534: 		    &mt("User")." '$uname' ".&mt("at domain")." '$udom' ".
                   1535: 		    &mt("not in this course")."</font>";
1.43      albertel 1536: 		$uname='';
1.190     albertel 1537: 		$csec=$env{'form.csec'};
1.269     raeburn  1538:                 $cgroup=$env{'form.cgroup'};
1.43      albertel 1539: 	    } else {
                   1540: 		my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   1541: 		      ('firstname','middlename','lastname','generation','id'));
1.133     www      1542: 		$message="\n<p>\n".&mt("Full Name").": ".
1.43      albertel 1543: 		    $name{'firstname'}.' '.$name{'middlename'}.' '
                   1544: 			.$name{'lastname'}.' '.$name{'generation'}.
1.133     www      1545: 			    "<br>\n".&mt('ID').": ".$name{'id'}.'<p>';
1.43      albertel 1546: 	    }
1.275     raeburn  1547:             $grouplist = &Apache::lonnet::get_users_groups(
                   1548:                                        $udom,$uname,$env{'request.course.id'});
1.269     raeburn  1549:             if ($grouplist) {
1.275     raeburn  1550:                 @usersgroups = &Apache::lonnet::sort_course_groups($grouplist,
                   1551:                                                     $env{'request.course.id'});
                   1552:                 unless (grep/^\Q$cgroup\E$/,@usersgroups) {
                   1553:                     $cgroup = $usersgroups[0];
                   1554:                 } 
                   1555:             } else {
                   1556:                 $cgroup = '';
1.269     raeburn  1557:             }
1.12      www      1558:         }
1.43      albertel 1559:     }
1.2       www      1560: 
1.43      albertel 1561:     unless ($csec) { $csec=''; }
1.269     raeburn  1562:     unless ($cgroup) { $cgroup=''; }
1.12      www      1563: 
1.14      www      1564: # --------------------------------------------------------- Get all assessments
1.210     www      1565:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps, 
                   1566: 				\%mapp, \%symbp,\%maptitles,\%uris,
                   1567: 				\%keyorder);
1.63      bowersj2 1568: 
1.57      albertel 1569:     $mapp{'0.0'} = '';
                   1570:     $symbp{'0.0'} = '';
1.99      albertel 1571: 
1.14      www      1572: # ---------------------------------------------------------- Anything to store?
1.190     albertel 1573:     if ($env{'form.pres_marker'}) {
1.205     www      1574:         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
                   1575:         my @values=split(/\&\&\&/,$env{'form.pres_value'});
                   1576:         my @types=split(/\&\&\&/,$env{'form.pres_type'});
                   1577: 	for (my $i=0;$i<=$#markers;$i++) {
                   1578: 	    $message.=&storeparm(split(/\&/,$markers[$i]),
                   1579: 				 $values[$i],
                   1580: 				 $types[$i],
1.269     raeburn  1581: 				 $uname,$udom,$csec,$cgroup);
1.205     www      1582: 	}
1.68      www      1583: # ---------------------------------------------------------------- Done storing
1.130     www      1584: 	$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      1585:     }
1.57      albertel 1586: #----------------------------------------------- if all selected, fill in array
1.209     www      1587:     if ($pscat[0] eq "all") {@pscat = (keys %allparms);}
                   1588:     if (!@pscat) { @pscat=('duedate','opendate','answerdate','weight','maxtries') }; 
1.57      albertel 1589:     if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
1.2       www      1590: # ------------------------------------------------------------------ Start page
1.63      bowersj2 1591: 
1.209     www      1592:     &startpage($r);
1.57      albertel 1593: 
1.44      albertel 1594:     foreach ('tolerance','date_default','date_start','date_end',
                   1595: 	     'date_interval','int','float','string') {
                   1596: 	$r->print('<input type="hidden" value="'.
1.190     albertel 1597: 		  $env{'form.recent_'.$_}.'" name="recent_'.$_.'">');
1.44      albertel 1598:     }
1.57      albertel 1599:                         
1.44      albertel 1600:     if (!$pssymb) {
1.209     www      1601:         $r->print('<table border="1"><tr><td>');
                   1602:         &levelmenu($r,\%alllevs,$parmlev);
1.128     albertel 1603: 	if ($parmlev ne 'general') {
1.209     www      1604:             $r->print('<td>');
                   1605: 	    &mapmenu($r,\%allmaps,$pschp,\%maptitles);
                   1606: 	    $r->print('</td>');
1.128     albertel 1607: 	}
1.209     www      1608:         $r->print('</td></tr></table>');
1.211     www      1609: 	&displaymenu($r,\%allparms,\%allparts,\@pscat,\@psprt,\%keyorder);
1.44      albertel 1610:     } else {
1.125     www      1611:         my ($map,$id,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.209     www      1612:         $r->print(&mt('Specific Resource').": ".$resource.
1.238     www      1613:                   '<input type="hidden" value="'.$pssymb.'" name="symb">'.
                   1614: 		  '<br /><label><b>'.&mt('Show all parts').': <input type="checkbox" name="psprt" value="all"'.
                   1615: 		  ($env{'form.psprt'}?' checked="checked"':'').' /></b></label><br />');
1.57      albertel 1616:     }
1.275     raeburn  1617:     &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups);    
1.57      albertel 1618: 
1.210     www      1619:     $r->print('<p>'.$message.'</p>');
                   1620: 
1.209     www      1621:     $r->print('<br /><input type="submit" name="dis" value="'.&mt("Update Parameter Display").'" />');
1.57      albertel 1622: 
                   1623:     my @temp_pscat;
                   1624:     map {
                   1625:         my $cat = $_;
                   1626:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   1627:     } @pscat;
                   1628: 
                   1629:     @pscat = @temp_pscat;
                   1630: 
1.209     www      1631:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      1632: # ----------------------------------------------------------------- Start Table
1.57      albertel 1633:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 1634:         my $csuname=$env{'user.name'};
                   1635:         my $csudom=$env{'user.domain'};
1.57      albertel 1636: 
1.203     www      1637:         if ($parmlev eq 'full') {
1.57      albertel 1638:            my $coursespan=$csec?8:5;
1.275     raeburn  1639:            my $userspan=3;
1.269     raeburn  1640:            if ($cgroup ne '') {
                   1641:               $coursespan += 3;
                   1642:            } 
                   1643:       
1.57      albertel 1644:            $r->print('<p><table border=2>');
                   1645:            $r->print('<tr><td colspan=5></td>');
1.130     www      1646:            $r->print('<th colspan='.($coursespan).'>'.&mt('Any User').'</th>');
1.57      albertel 1647:            if ($uname) {
1.275     raeburn  1648:                if (@usersgroups > 1) {
                   1649:                    $userspan ++;
                   1650:                }
                   1651:                $r->print('<th colspan="'.$userspan.'" rowspan="2">');
1.130     www      1652:                $r->print(&mt("User")." $uname ".&mt('at Domain')." $udom</th>");
1.57      albertel 1653:            }
1.133     www      1654: 	   my %lt=&Apache::lonlocal::texthash(
                   1655: 				  'pie'    => "Parameter in Effect",
                   1656: 				  'csv'    => "Current Session Value",
                   1657:                                   'at'     => 'at',
                   1658:                                   'rl'     => "Resource Level",
                   1659: 				  'ic'     => 'in Course',
                   1660: 				  'aut'    => "Assessment URL and Title",
1.143     albertel 1661: 				  'type'   => 'Type',
1.133     www      1662: 				  'emof'   => "Enclosing Map or Folder",
1.143     albertel 1663: 				  'part'   => 'Part',
1.133     www      1664:                                   'pn'     => 'Parameter Name',
                   1665: 				  'def'    => 'default',
                   1666: 				  'femof'  => 'from Enclosing Map or Folder',
                   1667: 				  'gen'    => 'general',
                   1668: 				  'foremf' => 'for Enclosing Map or Folder',
                   1669: 				  'fr'     => 'for Resource'
                   1670: 					      );
1.57      albertel 1671:            $r->print(<<ENDTABLETWO);
1.133     www      1672: <th rowspan=3>$lt{'pie'}</th>
                   1673: <th rowspan=3>$lt{'csv'}<br>($csuname $lt{'at'} $csudom)</th>
1.182     albertel 1674: </tr><tr><td colspan=5></td><th colspan=2>$lt{'ic'}</th><th colspan=2>$lt{'rl'}</th>
                   1675: <th colspan=1>$lt{'ic'}</th>
                   1676: 
1.10      www      1677: ENDTABLETWO
1.57      albertel 1678:            if ($csec) {
1.133     www      1679:                 $r->print("<th colspan=3>".
1.269     raeburn  1680: 			  &mt("in Section")." $csec</th>");
                   1681:            }
                   1682:            if ($cgroup) {
                   1683:                 $r->print("<th colspan=3>".
                   1684:                           &mt("in Group")." $cgroup</th>");
1.57      albertel 1685:            }
                   1686:            $r->print(<<ENDTABLEHEADFOUR);
1.133     www      1687: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   1688: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.192     albertel 1689: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
                   1690: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      1691: ENDTABLEHEADFOUR
1.57      albertel 1692: 
                   1693:            if ($csec) {
1.130     www      1694:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57      albertel 1695:            }
                   1696: 
1.269     raeburn  1697:            if ($cgroup) {
                   1698:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
                   1699:            }
                   1700: 
1.57      albertel 1701:            if ($uname) {
1.275     raeburn  1702:                if (@usersgroups > 1) {
                   1703:                    $r->print('<th>'.&mt('Control by other group?').'</th>');
                   1704:                }
1.130     www      1705:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57      albertel 1706:            }
                   1707: 
                   1708:            $r->print('</tr>');
                   1709: 
                   1710:            my $defbgone='';
                   1711:            my $defbgtwo='';
1.269     raeburn  1712:            my $defbgthree = '';
1.57      albertel 1713: 
                   1714:            foreach (@ids) {
                   1715: 
                   1716:                 my $rid=$_;
                   1717:                 my ($inmapid)=($rid=~/\.(\d+)$/);
                   1718: 
1.152     albertel 1719:                 if ((!$pssymb && 
                   1720: 		     (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   1721: 		    ||
                   1722: 		    ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      1723: # ------------------------------------------------------ Entry for one resource
1.184     albertel 1724:                     if ($defbgone eq '"#E0E099"') {
                   1725:                         $defbgone='"#E0E0DD"';
1.57      albertel 1726:                     } else {
1.184     albertel 1727:                         $defbgone='"#E0E099"';
1.57      albertel 1728:                     }
1.184     albertel 1729:                     if ($defbgtwo eq '"#FFFF99"') {
                   1730:                         $defbgtwo='"#FFFFDD"';
1.57      albertel 1731:                     } else {
1.184     albertel 1732:                         $defbgtwo='"#FFFF99"';
1.57      albertel 1733:                     }
1.269     raeburn  1734:                     if ($defbgthree eq '"#FFBB99"') {
                   1735:                         $defbgthree='"#FFBBDD"';
                   1736:                     } else {
                   1737:                         $defbgthree='"#FFBB99"';
                   1738:                     }
                   1739: 
1.57      albertel 1740:                     my $thistitle='';
                   1741:                     my %name=   ();
                   1742:                     undef %name;
                   1743:                     my %part=   ();
                   1744:                     my %display=();
                   1745:                     my %type=   ();
                   1746:                     my %default=();
1.196     www      1747:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 1748: 
1.210     www      1749:                     foreach (&keysplit($keyp{$rid})) {
1.57      albertel 1750:                         my $tempkeyp = $_;
                   1751:                         if (grep $_ eq $tempkeyp, @catmarker) {
                   1752:                           $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
                   1753:                           $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
                   1754:                           $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
                   1755:                           unless ($display{$_}) { $display{$_}=''; }
                   1756:                           $display{$_}.=' ('.$name{$_}.')';
                   1757:                           $default{$_}=&Apache::lonnet::metadata($uri,$_);
                   1758:                           $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
                   1759:                           $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
                   1760:                         }
                   1761:                     }
                   1762:                     my $totalparms=scalar keys %name;
                   1763:                     if ($totalparms>0) {
                   1764:                         my $firstrow=1;
1.274     albertel 1765: 			my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.57      albertel 1766:                         $r->print('<tr><td bgcolor='.$defbgone.
                   1767:                              ' rowspan='.$totalparms.
                   1768:                              '><tt><font size=-1>'.
                   1769:                              join(' / ',split(/\//,$uri)).
                   1770:                              '</font></tt><p><b>'.
1.154     albertel 1771:                              "<a href=\"javascript:openWindow('".
1.274     albertel 1772: 				  &Apache::lonnet::clutter($uri).'?symb='.
                   1773: 				  &Apache::lonnet::escape($symbp{$rid}).
1.57      albertel 1774:                              "', 'metadatafile', '450', '500', 'no', 'yes')\";".
1.127     albertel 1775:                              " TARGET=_self>$title");
1.57      albertel 1776: 
                   1777:                         if ($thistitle) {
                   1778:                             $r->print(' ('.$thistitle.')');
                   1779:                         }
                   1780:                         $r->print('</a></b></td>');
                   1781:                         $r->print('<td bgcolor='.$defbgtwo.
                   1782:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   1783:                                       '</td>');
                   1784: 
                   1785:                         $r->print('<td bgcolor='.$defbgone.
                   1786:                                       ' rowspan='.$totalparms.
1.238     www      1787:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.57      albertel 1788: 
1.236     albertel 1789:                         foreach (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 1790:                             unless ($firstrow) {
                   1791:                                 $r->print('<tr>');
                   1792:                             } else {
                   1793:                                 undef $firstrow;
                   1794:                             }
1.201     www      1795:                             &print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 1796:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  1797:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.275     raeburn  1798:                                                             $cgroup,\@usersgroups);
1.57      albertel 1799:                         }
                   1800:                     }
                   1801:                 }
                   1802:             } # end foreach ids
1.43      albertel 1803: # -------------------------------------------------- End entry for one resource
1.57      albertel 1804:             $r->print('</table>');
1.203     www      1805:         } # end of  full
1.57      albertel 1806: #--------------------------------------------------- Entry for parm level map
                   1807:         if ($parmlev eq 'map') {
                   1808:             my $defbgone = '"E0E099"';
                   1809:             my $defbgtwo = '"FFFF99"';
1.269     raeburn  1810:             my $defbgthree = '"FFBB99"';
1.57      albertel 1811: 
                   1812:             my %maplist;
                   1813: 
                   1814:             if ($pschp eq 'all') {
                   1815:                 %maplist = %allmaps; 
                   1816:             } else {
                   1817:                 %maplist = ($pschp => $mapp{$pschp});
                   1818:             }
                   1819: 
                   1820: #-------------------------------------------- for each map, gather information
                   1821:             my $mapid;
1.60      albertel 1822: 	    foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
                   1823:                 my $maptitle = $maplist{$mapid};
1.57      albertel 1824: 
                   1825: #-----------------------  loop through ids and get all parameter types for map
                   1826: #-----------------------------------------          and associated information
                   1827:                 my %name = ();
                   1828:                 my %part = ();
                   1829:                 my %display = ();
                   1830:                 my %type = ();
                   1831:                 my %default = ();
                   1832:                 my $map = 0;
                   1833: 
                   1834: #		$r->print("Catmarker: @catmarker<br />\n");
                   1835:                
                   1836:                 foreach (@ids) {
                   1837:                   ($map)=(/([\d]*?)\./);
                   1838:                   my $rid = $_;
                   1839:         
                   1840: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   1841: 
                   1842:                   if ($map eq $mapid) {
1.196     www      1843:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 1844: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   1845: 
                   1846: #--------------------------------------------------------------------
                   1847: # @catmarker contains list of all possible parameters including part #s
                   1848: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   1849: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   1850: # When storing information, store as part 0
                   1851: # When requesting information, request from full part
                   1852: #-------------------------------------------------------------------
1.210     www      1853:                     foreach (&keysplit($keyp{$rid})) {
1.57      albertel 1854:                       my $tempkeyp = $_;
                   1855:                       my $fullkeyp = $tempkeyp;
1.73      albertel 1856:                       $tempkeyp =~ s/_\w+_/_0_/;
1.57      albertel 1857:                       
                   1858:                       if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   1859:                         $part{$tempkeyp}="0";
                   1860:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   1861:                         $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   1862:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   1863:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73      albertel 1864:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57      albertel 1865:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   1866:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   1867:                       }
                   1868:                     } # end loop through keys
                   1869:                   }
                   1870:                 } # end loop through ids
                   1871:                                  
                   1872: #---------------------------------------------------- print header information
1.133     www      1873:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      1874:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.57      albertel 1875:                 $r->print(<<ENDMAPONE);
                   1876: <center><h4>
1.135     albertel 1877: Set Defaults for All Resources in $foldermap<br />
                   1878: <font color="red"><i>$showtitle</i></font><br />
1.57      albertel 1879: Specifically for
                   1880: ENDMAPONE
                   1881:                 if ($uname) {
1.267     albertel 1882: 		    my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 1883:                     $r->print(&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
1.130     www      1884:                         &mt('in')." \n");
1.57      albertel 1885:                 } else {
1.135     albertel 1886:                     $r->print("<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n");
1.57      albertel 1887:                 }
1.269     raeburn  1888:                 if ($cgroup) {
                   1889:                     $r->print(&mt("Group")." <font color=\"red\"><i>$cgroup".
                   1890:                               "</i></font> ".&mt('of')." \n");
                   1891:                     $csec = '';
                   1892:                 } elsif ($csec) {
                   1893:                     $r->print(&mt("Section")." <font color=\"red\"><i>$csec".
                   1894:                               "</i></font> ".&mt('of')." \n");
                   1895:                 }
1.135     albertel 1896:                 $r->print("<font color=\"red\"><i>$coursename</i></font><br />");
                   1897:                 $r->print("</h4>\n");
1.57      albertel 1898: #---------------------------------------------------------------- print table
                   1899:                 $r->print('<p><table border="2">');
1.130     www      1900:                 $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
                   1901:                 $r->print('<th>'.&mt('Default Value').'</th>');
                   1902:                 $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57      albertel 1903: 
1.210     www      1904: 	        foreach (&keysinorder(\%name,\%keyorder)) {
1.168     matthew  1905:                     $r->print('<tr>');
1.201     www      1906:                     &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  1907:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   1908:                            $parmlev,$uname,$udom,$csec,$cgroup);
1.57      albertel 1909:                 }
                   1910:                 $r->print("</table></center>");
                   1911:             } # end each map
                   1912:         } # end of $parmlev eq map
                   1913: #--------------------------------- Entry for parm level general (Course level)
                   1914:         if ($parmlev eq 'general') {
                   1915:             my $defbgone = '"E0E099"';
                   1916:             my $defbgtwo = '"FFFF99"';
1.269     raeburn  1917:             my $defbgthree = '"FFBB99"';
1.57      albertel 1918: 
                   1919: #-------------------------------------------- for each map, gather information
                   1920:             my $mapid="0.0";
                   1921: #-----------------------  loop through ids and get all parameter types for map
                   1922: #-----------------------------------------          and associated information
                   1923:             my %name = ();
                   1924:             my %part = ();
                   1925:             my %display = ();
                   1926:             my %type = ();
                   1927:             my %default = ();
                   1928:                
                   1929:             foreach (@ids) {
                   1930:                 my $rid = $_;
                   1931:         
1.196     www      1932:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 1933: 
                   1934: #--------------------------------------------------------------------
                   1935: # @catmarker contains list of all possible parameters including part #s
                   1936: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   1937: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   1938: # When storing information, store as part 0
                   1939: # When requesting information, request from full part
                   1940: #-------------------------------------------------------------------
1.210     www      1941:                 foreach (&keysplit($keyp{$rid})) {
1.57      albertel 1942:                   my $tempkeyp = $_;
                   1943:                   my $fullkeyp = $tempkeyp;
1.73      albertel 1944:                   $tempkeyp =~ s/_\w+_/_0_/;
1.57      albertel 1945:                   if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   1946:                     $part{$tempkeyp}="0";
                   1947:                     $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   1948:                     $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   1949:                     unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   1950:                     $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73      albertel 1951:                     $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57      albertel 1952:                     $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   1953:                     $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   1954:                   }
                   1955:                 } # end loop through keys
                   1956:             } # end loop through ids
                   1957:                                  
                   1958: #---------------------------------------------------- print header information
1.133     www      1959: 	    my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 1960:             $r->print(<<ENDMAPONE);
1.133     www      1961: <center><h4>$setdef
1.135     albertel 1962: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 1963: ENDMAPONE
                   1964:             if ($uname) {
1.267     albertel 1965: 		my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 1966:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 1967:             } else {
1.135     albertel 1968:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 1969:             }
                   1970:             
1.135     albertel 1971:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.269     raeburn  1972:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.135     albertel 1973:             $r->print("</h4>\n");
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:             }
                   1986:             $r->print("</table></center>");
                   1987:         } # end of $parmlev eq general
1.43      albertel 1988:     }
1.280     albertel 1989:     $r->print('</form>'.&Apache::loncommon::end_page());
1.57      albertel 1990: } # end sub assessparms
1.30      www      1991: 
1.59      matthew  1992: 
                   1993: ##################################################
                   1994: ##################################################
                   1995: 
                   1996: =pod
                   1997: 
                   1998: =item crsenv
                   1999: 
1.105     matthew  2000: Show and set course data and parameters.  This is a large routine that should
1.59      matthew  2001: be simplified and shortened... someday.
                   2002: 
                   2003: Inputs: $r
                   2004: 
                   2005: Returns: nothing
                   2006: 
                   2007: =cut
                   2008: 
                   2009: ##################################################
                   2010: ##################################################
1.30      www      2011: sub crsenv {
                   2012:     my $r=shift;
                   2013:     my $setoutput='';
1.280     albertel 2014: 
1.194     albertel 2015:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,
                   2016: 						    'Edit Course Environment');
1.190     albertel 2017:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2018:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.105     matthew  2019: 
                   2020:     #
                   2021:     # Go through list of changes
1.190     albertel 2022:     foreach (keys %env) {
1.105     matthew  2023:         next if ($_!~/^form\.(.+)\_setparmval$/);
                   2024:         my $name  = $1;
1.190     albertel 2025:         my $value = $env{'form.'.$name.'_value'};
1.105     matthew  2026:         if ($name eq 'newp') {
1.190     albertel 2027:             $name = $env{'form.newp_name'};
1.105     matthew  2028:         }
                   2029:         if ($name eq 'url') {
                   2030:             $value=~s/^\/res\///;
                   2031:             my $bkuptime=time;
                   2032:             my @tmp = &Apache::lonnet::get
                   2033:                 ('environment',['url'],$dom,$crs);
1.130     www      2034:             $setoutput.=&mt('Backing up previous URL').': '.
1.105     matthew  2035:                 &Apache::lonnet::put
                   2036:                 ('environment',
                   2037:                  {'top level map backup '.$bkuptime => $tmp[1] },
                   2038:                  $dom,$crs).
                   2039:                      '<br>';
                   2040:         }
                   2041:         #
                   2042:         # Deal with modified default spreadsheets
                   2043:         if ($name =~ /^spreadsheet_default_(classcalc|
                   2044:                                             studentcalc|
                   2045:                                             assesscalc)$/x) {
                   2046:             my $sheettype = $1; 
                   2047:             if ($sheettype eq 'classcalc') {
                   2048:                 # no need to do anything since viewing the sheet will
                   2049:                 # cause it to be updated. 
                   2050:             } elsif ($sheettype eq 'studentcalc') {
                   2051:                 # expire all the student spreadsheets
                   2052:                 &Apache::lonnet::expirespread('','','studentcalc');
                   2053:             } else {
                   2054:                 # expire all the assessment spreadsheets 
                   2055:                 #    this includes non-default spreadsheets, but better to
                   2056:                 #    be safe than sorry.
                   2057:                 &Apache::lonnet::expirespread('','','assesscalc');
                   2058:                 # expire all the student spreadsheets
                   2059:                 &Apache::lonnet::expirespread('','','studentcalc');
1.30      www      2060:             }
1.105     matthew  2061:         }
                   2062:         #
1.107     matthew  2063:         # Deal with the enrollment dates
                   2064:         if ($name =~ /^default_enrollment_(start|end)_date$/) {
                   2065:             $value=&Apache::lonhtmlcommon::get_date_from_form($name.'_value');
                   2066:         }
1.178     raeburn  2067:         # Get existing cloners
                   2068:         my @oldcloner = ();
                   2069:         if ($name eq 'cloners') {
                   2070:             my %clonenames=&Apache::lonnet::dump('environment',$dom,$crs,'cloners');
                   2071:             if ($clonenames{'cloners'} =~ /,/) {
                   2072:                 @oldcloner = split/,/,$clonenames{'cloners'};
                   2073:             } else {
                   2074:                 $oldcloner[0] = $clonenames{'cloners'};
                   2075:             }
                   2076:         }
1.107     matthew  2077:         #
1.105     matthew  2078:         # Let the user know we made the changes
1.153     albertel 2079:         if ($name && defined($value)) {
1.239     raeburn  2080:             my $failed_cloners;
1.178     raeburn  2081:             if ($name eq 'cloners') {
1.239     raeburn  2082:                 $value =~ s/\s//g;
1.178     raeburn  2083:                 $value =~ s/^,//;
                   2084:                 $value =~ s/,$//;
1.239     raeburn  2085:                 # check requested clones are valid users.
                   2086:                 $failed_cloners = &check_cloners(\$value,\@oldcloner);
1.178     raeburn  2087:             }
1.105     matthew  2088:             my $put_result = &Apache::lonnet::put('environment',
                   2089:                                                   {$name=>$value},$dom,$crs);
                   2090:             if ($put_result eq 'ok') {
1.130     www      2091:                 $setoutput.=&mt('Set').' <b>'.$name.'</b> '.&mt('to').' <b>'.$value.'</b>.<br />';
1.178     raeburn  2092:                 if ($name eq 'cloners') {
                   2093:                     &change_clone($value,\@oldcloner);
                   2094:                 }
1.179     raeburn  2095:                 # Flush the course logs so course description is immediately updated
                   2096:                 if ($name eq 'description' && defined($value)) {
                   2097:                     &Apache::lonnet::flushcourselogs();
                   2098:                 }
1.105     matthew  2099:             } else {
1.130     www      2100:                 $setoutput.=&mt('Unable to set').' <b>'.$name.'</b> '.&mt('to').
                   2101: 		    ' <b>'.$value.'</b> '.&mt('due to').' '.$put_result.'.<br />';
1.30      www      2102:             }
1.239     raeburn  2103:             if (($name eq 'cloners') && ($failed_cloners)) {
                   2104:                 $setoutput.= &mt('Unable to include').' - <b>'.$failed_cloners.'</b>, '.
                   2105:                  &mt('reason').' - '.&mt('LON-CAPA user(s) do(es) not exist').
                   2106:                  '.<br />'.&mt('Please ').
                   2107:                  ' <a href="/adm/createuser">'.
                   2108:                  &mt('add the user(s)').'</a>, '.
                   2109:                  &mt('and then return to the ').
                   2110:                  '<a href="/admparmset?action=crsenv">'.
                   2111:                  &mt('Course Parameters page').'</a> '.
                   2112:                  &mt('to add the new user(s) to the list of possible cloners').
                   2113:                  '.<br />';
                   2114:             }
1.30      www      2115:         }
1.38      harris41 2116:     }
1.108     www      2117: # ------------------------- Re-init course environment entries for this session
                   2118: 
1.190     albertel 2119:     &Apache::lonnet::coursedescription($env{'request.course.id'});
1.105     matthew  2120: 
1.30      www      2121: # -------------------------------------------------------- Get parameters again
1.45      matthew  2122: 
                   2123:     my %values=&Apache::lonnet::dump('environment',$dom,$crs);
1.140     sakharuk 2124:     my $SelectStyleFile=&mt('Select Style File');
1.141     sakharuk 2125:     my $SelectSpreadsheetFile=&mt('Select Spreadsheet File');
1.30      www      2126:     my $output='';
1.45      matthew  2127:     if (! exists($values{'con_lost'})) {
1.30      www      2128:         my %descriptions=
1.140     sakharuk 2129: 	    ('url'            => '<b>'.&mt('Top Level Map').'</b> '.
1.46      matthew  2130:                                  '<a href="javascript:openbrowser'.
1.47      matthew  2131:                                  "('envform','url','sequence')\">".
1.140     sakharuk 2132:                                  &mt('Select Map').'</a><br /><font color=red> '.
                   2133:                                  &mt('Modification may make assessment data inaccessible').
                   2134:                                  '</font>',
                   2135:              'description'    => '<b>'.&mt('Course Description').'</b>',
1.158     sakharuk 2136:              'courseid'       => '<b>'.&mt('Course ID or number').
1.140     sakharuk 2137:                                  '</b><br />'.
                   2138:                                  '('.&mt('internal').', '.&mt('optional').')',
1.177     raeburn  2139:              'cloners'        => '<b>'.&mt('Users allowed to clone course').'</b><br /><tt>(user:domain,user:domain)</tt><br />'.&mt('Users with active Course Coordinator role in the course automatically have the right to clone it, and can be omitted from list.'),
1.150     www      2140:              'grading'        => '<b>'.&mt('Grading').'</b><br />'.
                   2141:                                  '<tt>"standard", "external", or "spreadsheet"</tt> '.&Apache::loncommon::help_open_topic('GradingOptions'),
1.140     sakharuk 2142:              'default_xml_style' => '<b>'.&mt('Default XML Style File').'</b> '.
1.52      www      2143:                     '<a href="javascript:openbrowser'.
                   2144:                     "('envform','default_xml_style'".
1.140     sakharuk 2145:                     ",'sty')\">$SelectStyleFile</a><br>",
1.141     sakharuk 2146:              'question.email' => '<b>'.&mt('Feedback Addresses for Resource Content Question').
                   2147:                                  '</b><br />(<tt>user:domain,'.
1.74      www      2148:                                  'user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 2149:              'comment.email'  => '<b>'.&mt('Feedback Addresses for Course Content Comments').'</b><br />'.
1.74      www      2150:                                  '(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 2151:              'policy.email'   => '<b>'.&mt('Feedback Addresses for Course Policy').'</b>'.
1.75      albertel 2152:                                  '<br />(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 2153:              'hideemptyrows'  => '<b>'.&mt('Hide Empty Rows in Spreadsheets').'</b><br />'.
1.158     sakharuk 2154:                                  '('.&mt('"[_1]" for default hiding','<tt>yes</tt>').')',
1.141     sakharuk 2155:              'pageseparators'  => '<b>'.&mt('Visibly Separate Items on Pages').'</b><br />'.
1.158     sakharuk 2156:                                  '('.&mt('"[_1]" for visible separation','<tt>yes</tt>').', '.
1.141     sakharuk 2157:                                  &mt('changes will not show until next login').')',
1.169     matthew  2158:              'student_classlist_view' => '<b>'.&mt('Allow students to view classlist.').'</b>'.&mt('("all":students can view all sections,"section":students can only view their own section.blank or "disabled" prevents student view.'),
1.118     matthew  2159: 
1.141     sakharuk 2160:              'plc.roles.denied'=> '<b>'.&mt('Disallow live chatroom use for Roles').
                   2161:                                   '</b><br />"<tt>st</tt>": '.
1.158     sakharuk 2162:                                   &mt('student').', "<tt>ta</tt>": '.
1.118     matthew  2163:                                   'TA, "<tt>in</tt>": '.
1.158     sakharuk 2164:                                   &mt('instructor').';<br /><tt>'.&mt('role,role,...').'</tt>) '.
1.118     matthew  2165: 	       Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
                   2166:              'plc.users.denied' => 
1.141     sakharuk 2167:                           '<b>'.&mt('Disallow live chatroom use for Users').'</b><br />'.
1.118     matthew  2168:                                  '(<tt>user:domain,user:domain,...</tt>)',
                   2169: 
1.141     sakharuk 2170:              'pch.roles.denied'=> '<b>'.&mt('Disallow Resource Discussion for Roles').
                   2171:                                   '</b><br />"<tt>st</tt>": '.
1.61      albertel 2172:                                   'student, "<tt>ta</tt>": '.
                   2173:                                   'TA, "<tt>in</tt>": '.
1.75      albertel 2174:                                   'instructor;<br /><tt>role,role,...</tt>) '.
1.61      albertel 2175: 	       Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
1.53      www      2176:              'pch.users.denied' => 
1.141     sakharuk 2177:                           '<b>'.&mt('Disallow Resource Discussion for Users').'</b><br />'.
1.53      www      2178:                                  '(<tt>user:domain,user:domain,...</tt>)',
1.49      matthew  2179:              'spreadsheet_default_classcalc' 
1.141     sakharuk 2180:                  => '<b>'.&mt('Default Course Spreadsheet').'</b> '.
1.50      matthew  2181:                     '<a href="javascript:openbrowser'.
                   2182:                     "('envform','spreadsheet_default_classcalc'".
1.141     sakharuk 2183:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49      matthew  2184:              'spreadsheet_default_studentcalc' 
1.141     sakharuk 2185:                  => '<b>'.&mt('Default Student Spreadsheet').'</b> '.
1.50      matthew  2186:                     '<a href="javascript:openbrowser'.
                   2187:                     "('envform','spreadsheet_default_calc'".
1.141     sakharuk 2188:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49      matthew  2189:              'spreadsheet_default_assesscalc' 
1.141     sakharuk 2190:                  => '<b>'.&mt('Default Assessment Spreadsheet').'</b> '.
1.50      matthew  2191:                     '<a href="javascript:openbrowser'.
                   2192:                     "('envform','spreadsheet_default_assesscalc'".
1.141     sakharuk 2193:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.75      albertel 2194: 	     'allow_limited_html_in_feedback'
1.141     sakharuk 2195: 	         => '<b>'.&mt('Allow limited HTML in discussion posts').'</b><br />'.
1.158     sakharuk 2196: 	            '('.&mt('Set value to "[_1]" to allow',"<tt>yes</tt>").')',
1.170     raeburn  2197:              'allow_discussion_post_editing'
1.276     raeburn  2198:                  => '<b>'.&mt('Allow users with specified roles to edit/delete their own discussion posts').'</b><br />"<tt>st</tt>": '.
                   2199:                                   &mt('student').', "<tt>ta</tt>": '.
                   2200:                                   'TA, "<tt>in</tt>": '.
                   2201:                                   &mt('instructor').';&nbsp;(<tt>'.&mt('role:section,role:section,..., e.g., st:001,st:002,in,cc would permit students in sections 001 and 002 and instructors in any section, and course coordinators to edit their own posts.').'</tt>)<br />'.
                   2202:                     '('.&mt('or set value to "[_1]" to allow all roles',"<tt>yes</tt>").')',
1.89      albertel 2203: 	     'rndseed'
1.140     sakharuk 2204: 	         => '<b>'.&mt('Randomization algorithm used').'</b> <br />'.
                   2205:                     '<font color="red">'.&mt('Modifying this will make problems').' '.
                   2206:                     &mt('have different numbers and answers').'</font>',
1.151     albertel 2207: 	     'receiptalg'
                   2208: 	         => '<b>'.&mt('Receipt algorithm used').'</b> <br />'.
                   2209:                     &mt('This controls how receipt numbers are generated.'),
1.164     sakharuk 2210:              'suppress_tries'
1.272     albertel 2211:                  => '<b>'.&mt('Suppress number of tries in printing').'</b><br />'.
1.273     www      2212:                     ' ('.&mt('"[_1]" to suppress, anything else to not suppress','<tt>yes</tt>').')',
1.113     sakharuk 2213:              'problem_stream_switch'
1.141     sakharuk 2214:                  => '<b>'.&mt('Allow problems to be split over pages').'</b><br />'.
1.158     sakharuk 2215:                     ' ('.&mt('"[_1]" if allowed, anything else if not','<tt>yes</tt>').')',
1.161     sakharuk 2216:              'default_paper_size' 
                   2217:                  => '<b>'.&mt('Default paper type').'</b><br />'.
                   2218:                     ' ('.&mt('supported types').': Letter [8 1/2x11 in], Legal [8 1/2x14 in],'. 
                   2219:                     ' Tabloid [11x17 in], Executive [7 1/2x10 in], A2 [420x594 mm],'. 
                   2220:                     ' A3 [297x420 mm], A4 [210x297 mm], A5 [148x210 mm], A6 [105x148 mm])',
1.111     sakharuk 2221:              'anonymous_quiz'
1.150     www      2222:                  => '<b>'.&mt('Anonymous quiz/exam').'</b><br />'.
1.141     sakharuk 2223:                     ' (<tt><b>'.&mt('yes').'</b> '.&mt('to avoid print students names').' </tt>)',
1.217     albertel 2224:              'default_enrollment_start_date' => '<b>'.&mt('Default beginning date for student access.').'</b>',
                   2225:              'default_enrollment_end_date'   => '<b>'.&mt('Default ending date for student access.').'</b>',
1.150     www      2226:              'nothideprivileged'   => '<b>'.&mt('Privileged users that should not be hidden on staff listings').'</b>'.
                   2227:                                  '<br />(<tt>user:domain,user:domain,...</tt>)',
1.140     sakharuk 2228:              'languages' => '<b>'.&mt('Languages used').'</b>',
1.115     www      2229:              'disable_receipt_display'
1.141     sakharuk 2230:                  => '<b>'.&mt('Disable display of problem receipts').'</b><br />'.
1.158     sakharuk 2231:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.163     albertel 2232: 	     'disablesigfigs'
                   2233: 	         => '<b>'.&mt('Disable checking of Significant Figures').'</b><br />'.
                   2234:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.251     albertel 2235: 	     'disableexampointprint'
                   2236: 	         => '<b>'.&mt('Disable automatically printing point values onto exams.').'</b><br />'.
                   2237:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.278     www      2238:              'externalsyllabus'
1.279     www      2239:                  => '<b>'.&mt('URL of Syllabus (not using internal handler)').'</b>',
1.149     albertel 2240: 	     'tthoptions'
                   2241: 	         => '<b>'.&mt('Default set of options to pass to tth/m when converting tex').'</b>'
1.107     matthew  2242:              ); 
1.177     raeburn  2243:         my @Display_Order = ('url','description','courseid','cloners','grading',
1.278     www      2244:                              'externalsyllabus',
1.107     matthew  2245:                              'default_xml_style','pageseparators',
                   2246:                              'question.email','comment.email','policy.email',
1.169     matthew  2247:                              'student_classlist_view',
1.118     matthew  2248:                              'plc.roles.denied','plc.users.denied',
1.107     matthew  2249:                              'pch.roles.denied','pch.users.denied',
                   2250:                              'allow_limited_html_in_feedback',
1.170     raeburn  2251:                              'allow_discussion_post_editing',
1.108     www      2252:                              'languages',
1.150     www      2253: 			     'nothideprivileged',
1.107     matthew  2254:                              'rndseed',
1.151     albertel 2255:                              'receiptalg',
1.107     matthew  2256:                              'problem_stream_switch',
1.164     sakharuk 2257: 			     'suppress_tries',
1.161     sakharuk 2258:                              'default_paper_size',
1.115     www      2259:                              'disable_receipt_display',
1.107     matthew  2260:                              'spreadsheet_default_classcalc',
                   2261:                              'spreadsheet_default_studentcalc',
                   2262:                              'spreadsheet_default_assesscalc', 
                   2263:                              'hideemptyrows',
                   2264:                              'default_enrollment_start_date',
                   2265:                              'default_enrollment_end_date',
1.163     albertel 2266: 			     'tthoptions',
1.251     albertel 2267: 			     'disablesigfigs',
                   2268: 			     'disableexampointprint'
1.107     matthew  2269:                              );
                   2270: 	foreach my $parameter (sort(keys(%values))) {
1.244     banghart 2271:             unless (($parameter =~ m/^internal\./)||($parameter =~ m/^metadata\./)) {
1.142     raeburn  2272:                 if (! $descriptions{$parameter}) {
                   2273:                     $descriptions{$parameter}=$parameter;
                   2274:                     push(@Display_Order,$parameter);
                   2275:                 }
                   2276:             }
1.43      albertel 2277: 	}
1.107     matthew  2278:         foreach my $parameter (@Display_Order) {
                   2279:             my $description = $descriptions{$parameter};
1.51      matthew  2280:             # onchange is javascript to automatically check the 'Set' button.
1.69      www      2281:             my $onchange = 'onFocus="javascript:window.document.forms'.
1.107     matthew  2282:                 "['envform'].elements['".$parameter."_setparmval']".
1.51      matthew  2283:                 '.checked=true;"';
1.107     matthew  2284:             $output .= '<tr><td>'.$description.'</td>';
                   2285:             if ($parameter =~ /^default_enrollment_(start|end)_date$/) {
                   2286:                 $output .= '<td>'.
                   2287:                     &Apache::lonhtmlcommon::date_setter('envform',
                   2288:                                                         $parameter.'_value',
                   2289:                                                         $values{$parameter},
                   2290:                                                         $onchange).
                   2291:                                                         '</td>';
                   2292:             } else {
                   2293:                 $output .= '<td>'.
                   2294:                     &Apache::lonhtmlcommon::textbox($parameter.'_value',
                   2295:                                                     $values{$parameter},
                   2296:                                                     40,$onchange).'</td>';
                   2297:             }
                   2298:             $output .= '<td>'.
                   2299:                 &Apache::lonhtmlcommon::checkbox($parameter.'_setparmval').
                   2300:                 '</td>';
                   2301:             $output .= "</tr>\n";
1.51      matthew  2302: 	}
1.69      www      2303:         my $onchange = 'onFocus="javascript:window.document.forms'.
1.51      matthew  2304:             '[\'envform\'].elements[\'newp_setparmval\']'.
                   2305:             '.checked=true;"';
1.130     www      2306: 	$output.='<tr><td><i>'.&mt('Create New Environment Variable').'</i><br />'.
1.51      matthew  2307: 	    '<input type="text" size=40 name="newp_name" '.
                   2308:                 $onchange.' /></td><td>'.
                   2309:             '<input type="text" size=40 name="newp_value" '.
                   2310:                 $onchange.' /></td><td>'.
                   2311: 	    '<input type="checkbox" name="newp_setparmval" /></td></tr>';
1.43      albertel 2312:     }
1.157     sakharuk 2313:     my %lt=&Apache::lonlocal::texthash(
                   2314: 		    'par'   => 'Parameter',
                   2315: 		    'val'   => 'Value',
                   2316: 		    'set'   => 'Set',
                   2317: 		    'sce'   => 'Set Course Environment'
                   2318: 				       );
                   2319: 
1.140     sakharuk 2320:     my $Parameter=&mt('Parameter');
                   2321:     my $Value=&mt('Value');
1.141     sakharuk 2322:     my $Set=&mt('Set');
1.280     albertel 2323:     my $browse_js=
                   2324: 	'<script type="text/javascript" language="Javascript">'.
                   2325: 	&Apache::loncommon::browser_and_searcher_javascript('parmset').
                   2326: 	'</script>';
                   2327:     
                   2328:     my $start_page = 
                   2329: 	&Apache::loncommon::start_page('Set Course Environment Parameters',
                   2330: 				       $browse_js);
                   2331:     my $end_page = 
                   2332: 	&Apache::loncommon::end_page();
                   2333:     $r->print(<<ENDENV);
                   2334: $start_page
1.193     albertel 2335: $breadcrumbs
                   2336: <form method="post" action="/adm/parmset?action=crsenv" name="envform">
1.30      www      2337: $setoutput
                   2338: <p>
                   2339: <table border=2>
1.157     sakharuk 2340: <tr><th>$lt{'par'}</th><th>$lt{'val'}</th><th>$lt{'set'}?</th></tr>
1.30      www      2341: $output
                   2342: </table>
1.157     sakharuk 2343: <input type="submit" name="crsenv" value="$lt{'sce'}">
1.30      www      2344: </form>
1.280     albertel 2345: $end_page
                   2346: ENDENV
1.30      www      2347: }
1.120     www      2348: ##################################################
1.207     www      2349: # Overview mode
                   2350: ##################################################
1.124     www      2351: my $tableopen;
                   2352: 
                   2353: sub tablestart {
                   2354:     if ($tableopen) {
                   2355: 	return '';
                   2356:     } else {
                   2357: 	$tableopen=1;
1.130     www      2358: 	return '<table border="2"><tr><th>'.&mt('Parameter').'</th><th>'.
                   2359: 	    &mt('Delete').'</th><th>'.&mt('Set to ...').'</th></tr>';
1.124     www      2360:     }
                   2361: }
                   2362: 
                   2363: sub tableend {
                   2364:     if ($tableopen) {
                   2365: 	$tableopen=0;
                   2366: 	return '</table>';
                   2367:     } else {
                   2368: 	return'';
                   2369:     }
                   2370: }
                   2371: 
1.207     www      2372: sub readdata {
                   2373:     my ($crs,$dom)=@_;
                   2374: # Read coursedata
                   2375:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   2376: # Read userdata
                   2377: 
                   2378:     my $classlist=&Apache::loncoursedata::get_classlist();
                   2379:     foreach (keys %$classlist) {
                   2380:         # the following undefs are for 'domain', and 'username' respectively.
                   2381:         if ($_=~/^(\w+)\:(\w+)$/) {
                   2382: 	    my ($tuname,$tudom)=($1,$2);
                   2383: 	    my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                   2384:             foreach my $userkey (keys %{$useropt}) {
                   2385: 		if ($userkey=~/^$env{'request.course.id'}/) {
                   2386:                     my $newkey=$userkey;
                   2387: 		    $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   2388: 		    $$resourcedata{$newkey}=$$useropt{$userkey};
                   2389: 		}
                   2390: 	    }
                   2391: 	}
                   2392:     }
                   2393:     return $resourcedata;
                   2394: }
                   2395: 
                   2396: 
1.124     www      2397: # Setting
1.208     www      2398: 
                   2399: sub storedata {
                   2400:     my ($r,$crs,$dom)=@_;
1.207     www      2401: # Set userlevel immediately
                   2402: # Do an intermediate store of course level
                   2403:     my $olddata=&readdata($crs,$dom);
1.124     www      2404:     my %newdata=();
                   2405:     undef %newdata;
                   2406:     my @deldata=();
                   2407:     undef @deldata;
1.190     albertel 2408:     foreach (keys %env) {
1.124     www      2409: 	if ($_=~/^form\.([a-z]+)\_(.+)$/) {
                   2410: 	    my $cmd=$1;
                   2411: 	    my $thiskey=$2;
1.207     www      2412: 	    my ($tuname,$tudom)=&extractuser($thiskey);
                   2413: 	    my $tkey=$thiskey;
                   2414:             if ($tuname) {
                   2415: 		$tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   2416: 	    }
1.124     www      2417: 	    if ($cmd eq 'set') {
1.190     albertel 2418: 		my $data=$env{$_};
1.212     www      2419:                 my $typeof=$env{'form.typeof_'.$thiskey};
                   2420:  		if ($$olddata{$thiskey} ne $data) { 
1.207     www      2421: 		    if ($tuname) {
1.212     www      2422: 			if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
                   2423: 								 $tkey.'.type' => $typeof},
                   2424: 						 $tudom,$tuname) eq 'ok') {
1.290     www      2425: 			    &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom);
1.207     www      2426: 			    $r->print('<br />'.&mt('Stored modified parameter for').' '.
                   2427: 				      &Apache::loncommon::plainname($tuname,$tudom));
                   2428: 			} else {
                   2429: 			    $r->print('<h2><font color="red">'.
                   2430: 				      &mt('Error storing parameters').'</font></h2>');
                   2431: 			}
                   2432: 			&Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2433: 		    } else {
                   2434: 			$newdata{$thiskey}=$data;
1.212     www      2435:  			$newdata{$thiskey.'.type'}=$typeof; 
                   2436:                    } 
1.207     www      2437: 		}
1.124     www      2438: 	    } elsif ($cmd eq 'del') {
1.207     www      2439: 		if ($tuname) {
                   2440: 		    if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') {
1.290     www      2441: 			    &log_parmset({$tkey=>''},1,$tuname,$tudom);
1.207     www      2442: 			$r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   2443: 		    } else {
                   2444: 			$r->print('<h2><font color="red">'.
                   2445: 				  &mt('Error deleting parameters').'</font></h2>');
                   2446: 		    }
                   2447: 		    &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2448: 		} else {
                   2449: 		    push (@deldata,$thiskey);
                   2450: 		}
1.124     www      2451: 	    } elsif ($cmd eq 'datepointer') {
1.190     albertel 2452: 		my $data=&Apache::lonhtmlcommon::get_date_from_form($env{$_});
1.212     www      2453:                 my $typeof=$env{'form.typeof_'.$thiskey};
1.207     www      2454: 		if (defined($data) and $$olddata{$thiskey} ne $data) { 
                   2455: 		    if ($tuname) {
1.212     www      2456: 			if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
                   2457: 								 $tkey.'.type' => $typeof},
                   2458: 						 $tudom,$tuname) eq 'ok') {
1.290     www      2459: 			    &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom);
1.207     www      2460: 			    $r->print('<br />'.&mt('Stored modified date for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   2461: 			} else {
                   2462: 			    $r->print('<h2><font color="red">'.
                   2463: 				      &mt('Error storing parameters').'</font></h2>');
                   2464: 			}
                   2465: 			&Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2466: 		    } else {
1.212     www      2467: 			$newdata{$thiskey}=$data;
                   2468: 			$newdata{$thiskey.'.type'}=$typeof; 
1.207     www      2469: 		    }
                   2470: 		}
1.124     www      2471: 	    }
                   2472: 	}
                   2473:     }
1.207     www      2474: # Store all course level
1.144     www      2475:     my $delentries=$#deldata+1;
                   2476:     my @newdatakeys=keys %newdata;
                   2477:     my $putentries=$#newdatakeys+1;
                   2478:     if ($delentries) {
                   2479: 	if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {
1.290     www      2480: 	    my %loghash=map { $_ => '' } @deldata;
                   2481: 	    &log_parmset(\%loghash,1);
1.144     www      2482: 	    $r->print('<h2>'.&mt('Deleted [_1] parameter(s)</h2>',$delentries));
                   2483: 	} else {
                   2484: 	    $r->print('<h2><font color="red">'.
                   2485: 		      &mt('Error deleting parameters').'</font></h2>');
                   2486: 	}
1.205     www      2487: 	&Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      2488:     }
                   2489:     if ($putentries) {
                   2490: 	if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
1.290     www      2491: 			    &log_parmset(\%newdata,0);
1.212     www      2492: 	    $r->print('<h3>'.&mt('Stored [_1] parameter(s)',$putentries/2).'</h3>');
1.144     www      2493: 	} else {
                   2494: 	    $r->print('<h2><font color="red">'.
                   2495: 		      &mt('Error storing parameters').'</font></h2>');
                   2496: 	}
1.205     www      2497: 	&Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      2498:     }
1.208     www      2499: }
1.207     www      2500: 
1.208     www      2501: sub extractuser {
                   2502:     my $key=shift;
                   2503:     return ($key=~/^$env{'request.course.id'}.\[useropt\:(\w+)\:(\w+)\]\./);
                   2504: }
1.206     www      2505: 
1.208     www      2506: sub listdata {
1.214     www      2507:     my ($r,$resourcedata,$listdata,$sortorder)=@_;
1.207     www      2508: # Start list output
1.206     www      2509: 
1.122     www      2510:     my $oldsection='';
                   2511:     my $oldrealm='';
                   2512:     my $oldpart='';
1.123     www      2513:     my $pointer=0;
1.124     www      2514:     $tableopen=0;
1.145     www      2515:     my $foundkeys=0;
1.248     albertel 2516:     my %keyorder=&standardkeyorder();
1.214     www      2517:     foreach my $thiskey (sort {
                   2518: 	if ($sortorder eq 'realmstudent') {
1.247     albertel 2519: 	    my ($astudent,$arealm)=($a=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)\.[^\.]+$/);
                   2520: 	    my ($bstudent,$brealm)=($b=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)\.[^\.]+$/);
                   2521: 	    if (!defined($astudent)) {
                   2522: 		($arealm)=($a=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.237     albertel 2523: 	    }
1.247     albertel 2524: 	    if (!defined($bstudent)) {
                   2525: 		($brealm)=($b=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
                   2526: 	    }
1.248     albertel 2527: 	    $arealm=~s/\.type//;
                   2528: 	    my ($ares, $aparm) = ($arealm=~/^(.*)\.(.*)$/);
                   2529: 	    $aparm=$keyorder{'parameter_0_'.$aparm};
                   2530: 	    $brealm=~s/\.type//;
                   2531: 	    my ($bres, $bparm) = ($brealm=~/^(.*)\.(.*)$/);
                   2532: 	    $bparm=$keyorder{'parameter_0_'.$bparm};	   
                   2533: 	    if ($ares eq $bres) {
                   2534: 		if (defined($aparm) && defined($bparm)) {
                   2535: 		    ($aparm <=> $bparm);
                   2536: 		} elsif (defined($aparm)) {
                   2537: 		    -1;
                   2538: 		} elsif (defined($bparm)) {
                   2539: 		    1;
                   2540: 		} else {
                   2541: 		    ($arealm cmp $brealm) || ($astudent cmp $bstudent);
                   2542: 		}
                   2543: 	    } else {
                   2544: 		($arealm cmp $brealm) || ($astudent cmp $bstudent);
                   2545: 	    }
1.214     www      2546: 	} else {
                   2547: 	    $a cmp $b;
                   2548: 	}
                   2549:     } keys %{$listdata}) {
1.247     albertel 2550: 	 
1.211     www      2551: 	if ($$listdata{$thiskey.'.type'}) {
                   2552:             my $thistype=$$listdata{$thiskey.'.type'};
                   2553:             if ($$resourcedata{$thiskey.'.type'}) {
                   2554: 		$thistype=$$resourcedata{$thiskey.'.type'};
                   2555: 	    }
1.207     www      2556: 	    my ($middle,$part,$name)=
                   2557: 		($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.130     www      2558: 	    my $section=&mt('All Students');
1.207     www      2559: 	    if ($middle=~/^\[(.*)\]/) {
1.206     www      2560: 		my $issection=$1;
                   2561: 		if ($issection=~/^useropt\:(\w+)\:(\w+)/) {
                   2562: 		    $section=&mt('User').": ".&Apache::loncommon::plainname($1,$2);
                   2563: 		} else {
                   2564: 		    $section=&mt('Group/Section').': '.$issection;
                   2565: 		}
1.207     www      2566: 		$middle=~s/^\[(.*)\]//;
1.122     www      2567: 	    }
1.207     www      2568: 	    $middle=~s/\.+$//;
                   2569: 	    $middle=~s/^\.+//;
1.130     www      2570: 	    my $realm='<font color="red">'.&mt('All Resources').'</font>';
1.122     www      2571: 	    if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.174     albertel 2572: 		$realm='<font color="green">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><font color="#aaaaaa" size="-2">('.$1.')</font></font>';
1.122     www      2573: 	    } elsif ($middle) {
1.174     albertel 2574: 		my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   2575: 		$realm='<font color="orange">'.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).' <br /><font color="#aaaaaa" size="-2">('.$url.' in '.$map.' id: '.$id.')</font></font>';
1.122     www      2576: 	    }
1.214     www      2577: 	    if ($sortorder eq 'realmstudent') {
                   2578: 		if ($realm ne $oldrealm) {
                   2579: 		    $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   2580: 		    $oldrealm=$realm;
                   2581: 		    $oldsection='';
                   2582: 		}
                   2583: 		if ($section ne $oldsection) {
                   2584: 		    $r->print(&tableend()."\n<h2>$section</h2>");
                   2585: 		    $oldsection=$section;
                   2586: 		    $oldpart='';
                   2587: 		}
                   2588: 	    } else {
                   2589: 		if ($section ne $oldsection) {
                   2590: 		    $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   2591: 		    $oldsection=$section;
                   2592: 		    $oldrealm='';
                   2593: 		}
                   2594: 		if ($realm ne $oldrealm) {
                   2595: 		    $r->print(&tableend()."\n<h2>$realm</h2>");
                   2596: 		    $oldrealm=$realm;
                   2597: 		    $oldpart='';
                   2598: 		}
1.122     www      2599: 	    }
                   2600: 	    if ($part ne $oldpart) {
1.124     www      2601: 		$r->print(&tableend().
1.214     www      2602: 			  "\n<font color='blue'>".&mt('Part').": $part</font>");
1.122     www      2603: 		$oldpart=$part;
                   2604: 	    }
1.123     www      2605: #
1.230     www      2606: # Preset defaults?
                   2607: #
                   2608:             my ($hour,$min,$sec,$val)=('','','','');
                   2609: 	    unless ($$resourcedata{$thiskey}) {
                   2610: 		my ($parmname)=($thiskey=~/\.(\w+)$/);
                   2611: 		($hour,$min,$sec,$val)=&preset_defaults($parmname);
                   2612: 	    }
                   2613: 
                   2614: #
1.123     www      2615: # Ready to print
                   2616: #
1.124     www      2617: 	    $r->print(&tablestart().'<tr><td><b>'.$name.
                   2618: 		      ':</b></td><td><input type="checkbox" name="del_'.
                   2619: 		      $thiskey.'" /></td><td>');
1.145     www      2620: 	    $foundkeys++;
1.213     www      2621: 	    if (&isdateparm($thistype)) {
1.123     www      2622: 		my $jskey='key_'.$pointer;
                   2623: 		$pointer++;
                   2624: 		$r->print(
1.232     albertel 2625: 			  &Apache::lonhtmlcommon::date_setter('parmform',
1.123     www      2626: 							      $jskey,
1.219     www      2627: 						      $$resourcedata{$thiskey},
1.230     www      2628: 							      '',1,'','',$hour,$min,$sec).
1.277     www      2629: '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
                   2630: &date_sanity_info($$resourcedata{$thiskey})
1.123     www      2631: 			  );
1.219     www      2632: 	    } elsif ($thistype eq 'string_yesno') {
1.230     www      2633: 		my $showval;
                   2634: 		if (defined($$resourcedata{$thiskey})) {
                   2635: 		    $showval=$$resourcedata{$thiskey};
                   2636: 		} else {
                   2637: 		    $showval=$val;
                   2638: 		}
1.219     www      2639: 		$r->print('<label><input type="radio" name="set_'.$thiskey.
                   2640: 			  '" value="yes"');
1.230     www      2641: 		if ($showval eq 'yes') {
1.219     www      2642: 		    $r->print(' checked="checked"');
                   2643: 		}
                   2644:                 $r->print(' />'.&mt('Yes').'</label> ');
                   2645: 		$r->print('<label><input type="radio" name="set_'.$thiskey.
                   2646: 			  '" value="no"');
1.230     www      2647: 		if ($showval eq 'no') {
1.219     www      2648: 		    $r->print(' checked="checked"');
                   2649: 		}
                   2650:                 $r->print(' />'.&mt('No').'</label>');
1.123     www      2651: 	    } else {
1.230     www      2652: 		my $showval;
                   2653: 		if (defined($$resourcedata{$thiskey})) {
                   2654: 		    $showval=$$resourcedata{$thiskey};
                   2655: 		} else {
                   2656: 		    $showval=$val;
                   2657: 		}
1.211     www      2658: 		$r->print('<input type="text" name="set_'.$thiskey.'" value="'.
1.230     www      2659: 			  $showval.'">');
1.123     www      2660: 	    }
1.211     www      2661: 	    $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   2662: 		      $thistype.'">');
1.124     www      2663: 	    $r->print('</td></tr>');
1.122     www      2664: 	}
1.121     www      2665:     }
1.208     www      2666:     return $foundkeys;
                   2667: }
                   2668: 
                   2669: sub newoverview {
1.280     albertel 2670:     my ($r) = @_;
                   2671: 
1.208     www      2672:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2673:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.280     albertel 2674:     my $start_page = &Apache::loncommon::start_page('Set Parameters');
1.208     www      2675:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Overview');
                   2676:     $r->print(<<ENDOVER);
1.280     albertel 2677: $start_page
1.208     www      2678: $breadcrumbs
1.232     albertel 2679: <form method="post" action="/adm/parmset?action=newoverview" name="parmform">
1.208     www      2680: ENDOVER
1.211     www      2681:     my @ids=();
                   2682:     my %typep=();
                   2683:     my %keyp=();
                   2684:     my %allparms=();
                   2685:     my %allparts=();
                   2686:     my %allmaps=();
                   2687:     my %mapp=();
                   2688:     my %symbp=();
                   2689:     my %maptitles=();
                   2690:     my %uris=();
                   2691:     my %keyorder=&standardkeyorder();
                   2692:     my %defkeytype=();
                   2693: 
                   2694:     my %alllevs=();
                   2695:     $alllevs{'Resource Level'}='full';
1.215     www      2696:     $alllevs{'Map/Folder Level'}='map';
1.211     www      2697:     $alllevs{'Course Level'}='general';
                   2698: 
                   2699:     my $csec=$env{'form.csec'};
1.269     raeburn  2700:     my $cgroup=$env{'form.cgroup'};
1.211     www      2701: 
                   2702:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   2703:     my $pschp=$env{'form.pschp'};
                   2704:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
                   2705:     if (!@psprt) { $psprt[0]='0'; }
                   2706: 
                   2707:     my @selected_sections = 
                   2708: 	&Apache::loncommon::get_env_multiple('form.Section');
                   2709:     @selected_sections = ('all') if (! @selected_sections);
                   2710:     foreach (@selected_sections) {
                   2711:         if ($_ eq 'all') {
                   2712:             @selected_sections = ('all');
                   2713:         }
                   2714:     }
1.269     raeburn  2715:     my @selected_groups =
                   2716:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      2717: 
                   2718:     my $pssymb='';
                   2719:     my $parmlev='';
                   2720:  
                   2721:     unless ($env{'form.parmlev'}) {
                   2722:         $parmlev = 'map';
                   2723:     } else {
                   2724:         $parmlev = $env{'form.parmlev'};
                   2725:     }
                   2726: 
                   2727:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps, 
                   2728: 				\%mapp, \%symbp,\%maptitles,\%uris,
                   2729: 				\%keyorder,\%defkeytype);
                   2730: 
                   2731: # Menu to select levels, etc
                   2732: 
                   2733:     $r->print('<table border="1"><tr><td>');
                   2734:     &levelmenu($r,\%alllevs,$parmlev);
                   2735:     if ($parmlev ne 'general') {
                   2736: 	$r->print('<td>');
                   2737: 	&mapmenu($r,\%allmaps,$pschp,\%maptitles);
                   2738: 	$r->print('</td>');
                   2739:     }
                   2740:     $r->print('</td></tr></table>');
                   2741: 
                   2742:     $r->print('<table border="1"><tr><td>');  
                   2743:     &parmmenu($r,\%allparms,\@pscat,\%keyorder);
1.269     raeburn  2744:     $r->print('</td><td><table border="0" cellspacing="0" cellpadding="0">'.
                   2745:               '<tr><td>'.&mt('Parts').'</td><td></td><td>'.&mt('Section(s)').
                   2746:               '</td><td></td><td>'.&mt('Group(s)').'</td></tr><tr><td>');
1.211     www      2747:     &partmenu($r,\%allparts,\@psprt);
1.269     raeburn  2748:     $r->print('</td><td>&nbsp;</td><td>');
1.211     www      2749:     &sectionmenu($r,\@selected_sections);
1.269     raeburn  2750:     $r->print('</td><td>&nbsp;</td><td>');
                   2751:     &groupmenu($r,\@selected_groups);
                   2752:     $r->print('</td></tr></table>');
1.214     www      2753:     $r->print('</td></tr></table>');
                   2754:  
                   2755:     my $sortorder=$env{'form.sortorder'};
                   2756:     unless ($sortorder) { $sortorder='realmstudent'; }
                   2757:     &sortmenu($r,$sortorder);
                   2758: 
                   2759:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.211     www      2760: 
                   2761: # Build the list data hash from the specified parms
                   2762: 
                   2763:     my $listdata;
                   2764:     %{$listdata}=();
                   2765: 
                   2766:     foreach my $cat (@pscat) {
1.269     raeburn  2767:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   2768:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      2769:     }
                   2770: 
1.212     www      2771:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      2772: 
1.212     www      2773: 	if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      2774: 
                   2775: # Read modified data
                   2776: 
                   2777: 	my $resourcedata=&readdata($crs,$dom);
                   2778: 
                   2779: # List data
                   2780: 
1.214     www      2781: 	&listdata($r,$resourcedata,$listdata,$sortorder);
1.211     www      2782:     }
                   2783:     $r->print(&tableend().
1.212     www      2784: 	     ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Store').'" /></p>':'').
1.280     albertel 2785: 	      '</form>'.&Apache::loncommon::end_page());
1.208     www      2786: }
                   2787: 
1.269     raeburn  2788: sub secgroup_lister {
                   2789:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   2790:     foreach my $item (@{$selections}) {
                   2791:         foreach my $part (@{$psprt}) {
                   2792:             my $rootparmkey=$env{'request.course.id'};
                   2793:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   2794:                 $rootparmkey.='.['.$item.']';
                   2795:             }
                   2796:             if ($parmlev eq 'general') {
                   2797: # course-level parameter
                   2798:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   2799:                 $$listdata{$newparmkey}=1;
                   2800:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   2801:             } elsif ($parmlev eq 'map') {
                   2802: # map-level parameter
                   2803:                 foreach my $mapid (keys %{$allmaps}) {
                   2804:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   2805:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   2806:                     $$listdata{$newparmkey}=1;
                   2807:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   2808:                 }
                   2809:             } else {
                   2810: # resource-level parameter
                   2811:                 foreach my $rid (@{$ids}) {
                   2812:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   2813:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   2814:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   2815:                     $$listdata{$newparmkey}=1;
                   2816:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   2817:                 }
                   2818:             }
                   2819:         }
                   2820:     }
                   2821: }
                   2822: 
1.208     www      2823: sub overview {
1.280     albertel 2824:     my ($r) = @_;
1.208     www      2825:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2826:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.280     albertel 2827: 
                   2828:     my $start_page=&Apache::loncommon::start_page('Modify Parameters');
1.208     www      2829:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Overview');
                   2830:     $r->print(<<ENDOVER);
1.280     albertel 2831: $start_page
1.208     www      2832: $breadcrumbs
1.232     albertel 2833: <form method="post" action="/adm/parmset?action=setoverview" name="parmform">
1.208     www      2834: ENDOVER
                   2835: # Store modified
                   2836: 
                   2837:     &storedata($r,$crs,$dom);
                   2838: 
                   2839: # Read modified data
                   2840: 
                   2841:     my $resourcedata=&readdata($crs,$dom);
                   2842: 
1.214     www      2843: 
                   2844:     my $sortorder=$env{'form.sortorder'};
                   2845:     unless ($sortorder) { $sortorder='realmstudent'; }
                   2846:     &sortmenu($r,$sortorder);
                   2847: 
1.208     www      2848: # List data
                   2849: 
1.214     www      2850:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder);
1.208     www      2851: 
1.145     www      2852:     $r->print(&tableend().'<p>'.
1.280     albertel 2853: 	($foundkeys?'<input type="submit" value="'.&mt('Modify Parameters').'" />':&mt('There are no parameters.')).'</p></form>'.
                   2854: 	      &Apache::loncommon::end_page());
1.120     www      2855: }
1.121     www      2856: 
1.59      matthew  2857: ##################################################
                   2858: ##################################################
1.178     raeburn  2859:                                                                                             
                   2860: =pod
1.239     raeburn  2861: 
                   2862: =item check_cloners
                   2863: 
                   2864: Checks if new users included in list of allowed cloners
                   2865: are valid users.  Replaces supplied list with 
                   2866: cleaned list containing only users with valid usernames
                   2867: and domains.
                   2868: 
                   2869: Inputs: $clonelist, $oldcloner 
                   2870: where $clonelist is ref to array of requested cloners,
                   2871: and $oldcloner is ref to array of currently allowed
                   2872: cloners.
                   2873: 
                   2874: Returns: string - comma separated list of requested
                   2875: cloners (username:domain) who do not exist in system.
                   2876: 
                   2877: =item change_clone
                   2878: 
1.178     raeburn  2879: Modifies the list of courses a user can clone (stored
1.239     raeburn  2880: in the user's environment.db file), called when a
1.178     raeburn  2881: change is made to the list of users allowed to clone
                   2882: a course.
1.239     raeburn  2883: 
1.178     raeburn  2884: Inputs: $action,$cloner
                   2885: where $action is add or drop, and $cloner is identity of 
                   2886: user for whom cloning ability is to be changed in course. 
                   2887: 
                   2888: =cut
                   2889:                                                                                             
                   2890: ##################################################
                   2891: ##################################################
                   2892: 
1.239     raeburn  2893: sub extract_cloners {
                   2894:     my ($clonelist,$allowclone) = @_;
                   2895:     if ($clonelist =~ /,/) {
                   2896:         @{$allowclone} = split/,/,$clonelist;
                   2897:     } else {
                   2898:         $$allowclone[0] = $clonelist;
                   2899:     }
                   2900: }
                   2901: 
                   2902: 
                   2903: sub check_cloners {
                   2904:     my ($clonelist,$oldcloner) = @_;
                   2905:     my ($clean_clonelist,$disallowed);
                   2906:     my @allowclone = ();
                   2907:     &extract_cloners($$clonelist,\@allowclone);
                   2908:     foreach my $currclone (@allowclone) {
                   2909:         if (!grep/^$currclone$/,@$oldcloner) {
                   2910:             my ($uname,$udom) = split/:/,$currclone;
                   2911:             if ($uname && $udom) {
                   2912:                 if (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   2913:                     $disallowed .= $currclone.',';   
                   2914:                 } else {
                   2915:                     $clean_clonelist .= $currclone.',';
                   2916:                 }
                   2917:             }
                   2918:         } else {
                   2919:             $clean_clonelist .= $currclone.',';
                   2920:         }
                   2921:     }
                   2922:     if ($disallowed) {
                   2923:         $disallowed =~ s/,$//;
                   2924:     }
                   2925:     if ($clean_clonelist) {
                   2926:         $clean_clonelist =~ s/,$//;
                   2927:     }
                   2928:     $$clonelist = $clean_clonelist;
                   2929:     return $disallowed;
                   2930: }  
1.178     raeburn  2931: 
                   2932: sub change_clone {
                   2933:     my ($clonelist,$oldcloner) = @_;
                   2934:     my ($uname,$udom);
1.190     albertel 2935:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2936:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.178     raeburn  2937:     my $clone_crs = $cnum.':'.$cdom;
                   2938:     
                   2939:     if ($cnum && $cdom) {
1.239     raeburn  2940:         my @allowclone;
                   2941:         &extract_cloners($clonelist,\@allowclone);
1.178     raeburn  2942:         foreach my $currclone (@allowclone) {
                   2943:             if (!grep/^$currclone$/,@$oldcloner) {
                   2944:                 ($uname,$udom) = split/:/,$currclone;
                   2945:                 if ($uname && $udom) {
                   2946:                     unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   2947:                         my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   2948:                         if ($currclonecrs{'cloneable'} !~ /\Q$clone_crs\E/) {
                   2949:                             if ($currclonecrs{'cloneable'} eq '') {
                   2950:                                 $currclonecrs{'cloneable'} = $clone_crs;
                   2951:                             } else {
                   2952:                                 $currclonecrs{'cloneable'} .= ','.$clone_crs;
                   2953:                             }
                   2954:                             &Apache::lonnet::put('environment',\%currclonecrs,$udom,$uname);
                   2955:                         }
                   2956:                     }
                   2957:                 }
                   2958:             }
                   2959:         }
                   2960:         foreach my $oldclone (@$oldcloner) {
                   2961:             if (!grep/^$oldclone$/,@allowclone) {
                   2962:                 ($uname,$udom) = split/:/,$oldclone;
                   2963:                 if ($uname && $udom) {
                   2964:                     unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   2965:                         my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   2966:                         my %newclonecrs = ();
                   2967:                         if ($currclonecrs{'cloneable'} =~ /\Q$clone_crs\E/) {
                   2968:                             if ($currclonecrs{'cloneable'} =~ /,/) {
                   2969:                                 my @currclonecrs = split/,/,$currclonecrs{'cloneable'};
                   2970:                                 foreach (@currclonecrs) {
                   2971:                                     unless ($_ eq $clone_crs) {
                   2972:                                         $newclonecrs{'cloneable'} .= $_.',';
                   2973:                                     }
                   2974:                                 }
                   2975:                                 $newclonecrs{'cloneable'} =~ s/,$//;
                   2976:                             } else {
                   2977:                                 $newclonecrs{'cloneable'} = '';
                   2978:                             }
                   2979:                             &Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname);
                   2980:                         }
                   2981:                     }
                   2982:                 }
                   2983:             }
                   2984:         }
                   2985:     }
                   2986: }
                   2987: 
1.193     albertel 2988: 
                   2989: ##################################################
                   2990: ##################################################
                   2991: 
                   2992: =pod
                   2993: 
                   2994: =item * header
                   2995: 
                   2996: Output html header for page
                   2997: 
                   2998: =cut
                   2999: 
                   3000: ##################################################
                   3001: ##################################################
                   3002: sub header {
1.280     albertel 3003:     return &Apache::loncommon::start_page('Parameter Manager');
1.193     albertel 3004: }
                   3005: ##################################################
                   3006: ##################################################
                   3007: sub print_main_menu {
                   3008:     my ($r,$parm_permission)=@_;
                   3009:     #
                   3010:     $r->print(<<ENDMAINFORMHEAD);
                   3011: <form method="post" enctype="multipart/form-data"
                   3012:       action="/adm/parmset" name="studentform">
                   3013: ENDMAINFORMHEAD
                   3014: #
1.195     albertel 3015:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3016:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 3017:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
                   3018: 
1.193     albertel 3019:     my @menu =
                   3020:         (
                   3021:           { text => 'Set Course Environment Parameters',
1.204     www      3022: 	    action => 'crsenv',
1.193     albertel 3023:             permission => $parm_permission,
                   3024:             },
1.255     banghart 3025:           { text => 'Set Portfolio Metadata',
1.259     banghart 3026: 	    action => 'setrestrictmeta',
1.240     banghart 3027:             permission => $parm_permission,
                   3028:             },
1.271     www      3029: 	  { text => 'Manage Course Slots',
1.268     albertel 3030: 	    url => '/adm/slotrequest?command=showslots',
                   3031: 	    permission => $vgr,
                   3032:             },
                   3033: 	  { divider => 1,
                   3034: 	    },
1.216     www      3035:           { text => 'Set/Modify Resource Parameters - Helper Mode',
1.193     albertel 3036:             url => '/adm/helper/parameter.helper',
                   3037:             permission => $parm_permission,
                   3038:             },
1.216     www      3039:           { text => 'Modify Resource Parameters - Overview Mode',
1.193     albertel 3040:             action => 'setoverview',
                   3041:             permission => $parm_permission,
1.208     www      3042:             },          
1.216     www      3043: 	  { text => 'Set Resource Parameters - Overview Mode',
1.208     www      3044:             action => 'newoverview',
                   3045:             permission => $parm_permission,
1.193     albertel 3046:             },
1.216     www      3047:           { text => 'Set/Modify Resource Parameters - Table Mode',
1.193     albertel 3048:             action => 'settable',
                   3049:             permission => $parm_permission,
1.204     www      3050:             help => 'Cascading_Parameters',
1.193     albertel 3051:             },
1.220     www      3052:           { text => 'Set Parameter Setting Default Actions',
                   3053:             action => 'setdefaults',
                   3054:             permission => $parm_permission,
1.284     www      3055:             },          
                   3056: 	  { text => 'Parameter Change Log and Course Blog Posting',
                   3057:             action => 'parameterchangelog',
                   3058:             permission => $parm_permission,
1.220     www      3059:             },
1.193     albertel 3060:           );
                   3061:     my $menu_html = '';
                   3062:     foreach my $menu_item (@menu) {
1.268     albertel 3063: 	if ($menu_item->{'divider'}) {
                   3064: 	    $menu_html .= '<hr />';
                   3065: 	    next;
                   3066: 	}
1.193     albertel 3067:         next if (! $menu_item->{'permission'});
                   3068:         $menu_html.='<p>';
                   3069:         $menu_html.='<font size="+1">';
                   3070:         if (exists($menu_item->{'url'})) {
                   3071:             $menu_html.=qq{<a href="$menu_item->{'url'}">};
                   3072:         } else {
                   3073:             $menu_html.=
                   3074:                 qq{<a href="/adm/parmset?action=$menu_item->{'action'}">};
                   3075:         }
                   3076:         $menu_html.= &mt($menu_item->{'text'}).'</a></font>';
                   3077:         if (exists($menu_item->{'help'})) {
                   3078:             $menu_html.=
                   3079:                 &Apache::loncommon::help_open_topic($menu_item->{'help'});
                   3080:         }
                   3081:         $menu_html.='</p>'.$/;
                   3082:     }
                   3083:     $r->print($menu_html);
                   3084:     return;
                   3085: }
1.255     banghart 3086: ### Set portfolio metadata
1.252     banghart 3087: sub output_row {
1.255     banghart 3088:     my ($r, $field_name, $field_text) = @_;
1.252     banghart 3089:     my $output;
1.263     banghart 3090:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   3091:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.254     banghart 3092:     unless (defined($options)) {
                   3093:         $options = 'active,stuadd';
1.261     banghart 3094:         $values = '';
1.252     banghart 3095:     }
1.260     banghart 3096:     $output.='<strong>'.$field_text.':</strong>';
1.264     albertel 3097:     $output.='<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /><br />';
                   3098: 
                   3099:     my @options= ( ['active', 'Show to student'],
                   3100: 		   ['onlyone','Student may select only one choice'],
                   3101: 		   ['stuadd', 'Student may type choices']);
                   3102:     foreach my $opt (@options) {
                   3103: 	my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   3104: 	$output.=('&nbsp;'x5).'<label><input type="checkbox" name="'.
                   3105: 	    $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   3106: 	    &mt($opt->[1]).'</label> <br />';
1.252     banghart 3107:     }
                   3108:     return ($output);
                   3109: }
1.259     banghart 3110: 
                   3111: sub setrestrictmeta {
1.240     banghart 3112:     my ($r)=@_;
1.242     banghart 3113:     my $next_meta;
1.244     banghart 3114:     my $output;
1.245     banghart 3115:     my $item_num;
1.246     banghart 3116:     my $put_result;
1.280     albertel 3117:     
                   3118:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.240     banghart 3119:     $r->print(&Apache::lonhtmlcommon::breadcrumbs(undef,
1.260     banghart 3120: 						    'Restrict Metadata'));
1.240     banghart 3121:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3122:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.259     banghart 3123:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 3124:     my $save_field = '';
1.259     banghart 3125:     if ($env{'form.restrictmeta'}) {
1.254     banghart 3126:         foreach my $field (sort(keys(%env))) {
1.252     banghart 3127:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 3128:                 my $options;
1.252     banghart 3129:                 my $meta_field = $1;
                   3130:                 my $meta_key = $2;
1.253     banghart 3131:                 if ($save_field ne $meta_field) {
1.252     banghart 3132:                     $save_field = $meta_field;
1.253     banghart 3133:             	    if ($env{'form.'.$meta_field.'_stuadd'}) {
1.254     banghart 3134:             	        $options.='stuadd,';
                   3135:             	    } 
1.253     banghart 3136:             	    if ($env{'form.'.$meta_field.'_onlyone'}) {
1.254     banghart 3137:             	        $options.='onlyone,';
                   3138:             	    } 
                   3139:             	    if ($env{'form.'.$meta_field.'_active'}) {
                   3140:             	        $options.='active,';
1.253     banghart 3141:             	    }
1.259     banghart 3142:                     my $name = $save_field;
1.253     banghart 3143:                      $put_result = &Apache::lonnet::put('environment',
1.262     banghart 3144:                                                   {'metadata.'.$meta_field.'.options'=>$options,
                   3145:                                                    'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
1.253     banghart 3146:                                                    },$dom,$crs);
1.252     banghart 3147:                 }
                   3148:             }
                   3149:         }
                   3150:     }
                   3151:     &Apache::lonnet::coursedescription($env{'request.course.id'});
1.258     albertel 3152:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
                   3153:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 3154:         &Apache::lonnet::logthis ($field);
                   3155:         if ($field ne 'courserestricted') {
                   3156: 	    $output.= &output_row($r, $field, $metadata_fields{$field});
                   3157: 	}
1.255     banghart 3158:     }
1.244     banghart 3159:     $r->print(<<ENDenv);       
1.259     banghart 3160:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 3161:         <p>
                   3162:         $output
1.259     banghart 3163:         <input type="submit" name="restrictmeta" value="Update Metadata Restrictions">
1.244     banghart 3164:         </form>
                   3165: ENDenv
1.280     albertel 3166:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 3167:     return 'ok';
                   3168: }
1.220     www      3169: ##################################################
1.193     albertel 3170: 
1.220     www      3171: sub defaultsetter {
1.280     albertel 3172:     my ($r) = @_;
                   3173: 
                   3174:     my $start_page = 
                   3175: 	&Apache::loncommon::start_page('Parameter Setting Default Actions');
1.220     www      3176:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Defaults');
                   3177:     $r->print(<<ENDDEFHEAD);
1.280     albertel 3178: $start_page
1.220     www      3179: $breadcrumbs
                   3180: <form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">
                   3181: ENDDEFHEAD
1.280     albertel 3182: 
                   3183:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3184:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.221     www      3185:     my @ids=();
                   3186:     my %typep=();
                   3187:     my %keyp=();
                   3188:     my %allparms=();
                   3189:     my %allparts=();
                   3190:     my %allmaps=();
                   3191:     my %mapp=();
                   3192:     my %symbp=();
                   3193:     my %maptitles=();
                   3194:     my %uris=();
                   3195:     my %keyorder=&standardkeyorder();
                   3196:     my %defkeytype=();
                   3197: 
                   3198:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps, 
                   3199: 				\%mapp, \%symbp,\%maptitles,\%uris,
                   3200: 				\%keyorder,\%defkeytype);
1.224     www      3201:     if ($env{'form.storerules'}) {
                   3202: 	my %newrules=();
                   3203: 	my @delrules=();
1.226     www      3204: 	my %triggers=();
1.225     albertel 3205: 	foreach my $key (keys(%env)) {
                   3206:             if ($key=~/^form\.(\w+)\_action$/) {
1.224     www      3207: 		my $tempkey=$1;
1.226     www      3208: 		my $action=$env{$key};
                   3209:                 if ($action) {
                   3210: 		    $newrules{$tempkey.'_action'}=$action;
                   3211: 		    if ($action ne 'default') {
                   3212: 			my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   3213: 			$triggers{$whichparm}.=$tempkey.':';
                   3214: 		    }
                   3215: 		    $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
1.224     www      3216: 		    if (&isdateparm($defkeytype{$tempkey})) {
1.227     www      3217: 			$newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
1.224     www      3218: 			$newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   3219: 			$newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   3220: 			$newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   3221: 		    } else {
                   3222: 			$newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
1.227     www      3223: 			$newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
1.224     www      3224: 		    }
                   3225: 		} else {
1.225     albertel 3226: 		    push(@delrules,$tempkey.'_action');
1.226     www      3227: 		    push(@delrules,$tempkey.'_type');
1.225     albertel 3228: 		    push(@delrules,$tempkey.'_hours');
                   3229: 		    push(@delrules,$tempkey.'_min');
                   3230: 		    push(@delrules,$tempkey.'_sec');
                   3231: 		    push(@delrules,$tempkey.'_value');
1.224     www      3232: 		}
                   3233: 	    }
                   3234: 	}
1.226     www      3235: 	foreach my $key (keys %allparms) {
                   3236: 	    $newrules{$key.'_triggers'}=$triggers{$key};
                   3237: 	}
1.224     www      3238: 	&Apache::lonnet::put('parmdefactions',\%newrules,$dom,$crs);
                   3239: 	&Apache::lonnet::del('parmdefactions',\@delrules,$dom,$crs);
                   3240: 	&resetrulescache();
                   3241:     }
1.227     www      3242:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
                   3243: 				       'hours' => 'Hours',
1.221     www      3244: 				       'min' => 'Minutes',
                   3245: 				       'sec' => 'Seconds',
                   3246: 				       'yes' => 'Yes',
                   3247: 				       'no' => 'No');
1.222     www      3248:     my @standardoptions=('','default');
                   3249:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   3250:     my @dateoptions=('','default');
                   3251:     my @datedisplay=('',&mt('Default value when manually setting'));
                   3252:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
                   3253: 	unless ($tempkey) { next; }
                   3254: 	push @standardoptions,'when_setting_'.$tempkey;
                   3255: 	push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   3256: 	if (&isdateparm($defkeytype{$tempkey})) {
                   3257: 	    push @dateoptions,'later_than_'.$tempkey;
                   3258: 	    push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   3259: 	    push @dateoptions,'earlier_than_'.$tempkey;
                   3260: 	    push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   3261: 	} 
                   3262:     }
1.231     www      3263: $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   3264: 	  &mt('Automatic setting rules apply to table mode interfaces only.'));
1.221     www      3265:     $r->print("\n<table border='1'><tr><th>".&mt('Rule for parameter').'</th><th>'.
1.222     www      3266: 	      &mt('Action').'</th><th>'.&mt('Value').'</th></tr>');
1.221     www      3267:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.222     www      3268: 	unless ($tempkey) { next; }
1.221     www      3269: 	$r->print("\n<tr><td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
1.222     www      3270: 	my $action=&rulescache($tempkey.'_action');
                   3271: 	$r->print('<select name="'.$tempkey.'_action">');
                   3272: 	if (&isdateparm($defkeytype{$tempkey})) {
                   3273: 	    for (my $i=0;$i<=$#dateoptions;$i++) {
                   3274: 		if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   3275: 		$r->print("\n<option value='$dateoptions[$i]'".
                   3276: 			  ($dateoptions[$i] eq $action?' selected="selected"':'').
                   3277: 			  ">$datedisplay[$i]</option>");
                   3278: 	    }
                   3279: 	} else {
                   3280: 	    for (my $i=0;$i<=$#standardoptions;$i++) {
                   3281: 		if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   3282: 		$r->print("\n<option value='$standardoptions[$i]'".
                   3283: 			  ($standardoptions[$i] eq $action?' selected="selected"':'').
                   3284: 			  ">$standarddisplay[$i]</option>");
                   3285: 	    }
                   3286: 	}
                   3287: 	$r->print('</select>');
1.227     www      3288: 	unless (&isdateparm($defkeytype{$tempkey})) {
                   3289: 	    $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   3290: 		      '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
                   3291: 	}
1.222     www      3292: 	$r->print("\n</td><td>\n");
                   3293: 
1.221     www      3294:         if (&isdateparm($defkeytype{$tempkey})) {
1.227     www      3295: 	    my $days=&rulescache($tempkey.'_days');
1.222     www      3296: 	    my $hours=&rulescache($tempkey.'_hours');
                   3297: 	    my $min=&rulescache($tempkey.'_min');
                   3298: 	    my $sec=&rulescache($tempkey.'_sec');
1.221     www      3299: 	    $r->print(<<ENDINPUTDATE);
1.227     www      3300: <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
1.222     www      3301: <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   3302: <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   3303: <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.221     www      3304: ENDINPUTDATE
                   3305: 	} elsif ($defkeytype{$tempkey} eq 'string_yesno') {
1.222     www      3306:             my $yeschecked='';
                   3307:             my $nochecked='';
                   3308:             if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked='checked="checked"'; }
                   3309:             if (&rulescache($tempkey.'_value') eq 'no') { $nochecked='checked="checked"'; }
                   3310: 
1.221     www      3311: 	    $r->print(<<ENDYESNO);
1.224     www      3312: <label><input type="radio" name="$tempkey\_value" value="yes" $yeschecked /> $lt{'yes'}</label><br />
                   3313: <label><input type="radio" name="$tempkey\_value" value="no" $nochecked /> $lt{'no'}</label>
1.221     www      3314: ENDYESNO
                   3315:         } else {
1.224     www      3316: 	    $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
1.221     www      3317: 	}
                   3318:         $r->print('</td></tr>');
                   3319:     }
1.224     www      3320:     $r->print("</table>\n<input type='submit' name='storerules' value='".
1.280     albertel 3321: 	      &mt('Store Rules')."' /></form>\n".
                   3322: 	      &Apache::loncommon::end_page());
1.220     www      3323:     return;
                   3324: }
1.193     albertel 3325: 
1.290     www      3326: sub components {
1.291   ! www      3327:     my ($key,$uname,$udom,$exeuser,$exedomain)=@_;
1.290     www      3328:     my $typeflag=0;
                   3329:     if ($key=~/\.type$/) {
                   3330: 	$key=~s/\.type$//;
                   3331:         $typeflag=1;
                   3332:     }
1.291   ! www      3333:     my $issection;
1.290     www      3334:     my ($middle,$part,$name)=($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
                   3335:     my $section=&mt('All Students');
                   3336:     if ($middle=~/^\[(.*)\]/) {
1.291   ! www      3337: 	$issection=$1;
        !          3338: 	$section=&mt('Group/Section').': '.$issection;
1.290     www      3339: 	$middle=~s/^\[(.*)\]//;
                   3340:     }
                   3341:     $middle=~s/\.+$//;
                   3342:     $middle=~s/^\.+//;
1.291   ! www      3343:     if ($uname) {
        !          3344: 	$section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
        !          3345: 	$issection='';
        !          3346:     }
1.290     www      3347:     my $realm='<font color="red">'.&mt('All Resources').'</font>';
                   3348:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
                   3349: 	$realm='<font color="green">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><font color="#aaaaaa" size="-2">('.$1.')</font></font>';
                   3350:     } elsif ($middle) {
                   3351: 	my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   3352: 	$realm='<font color="orange">'.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).' <br /><font color="#aaaaaa" size="-2">('.$url.' in '.$map.' id: '.$id.')</font></font>';
                   3353:     }
1.291   ! www      3354:     my $what=$part.'.'.$name;
        !          3355:     return ($realm,$section,$name,$part,$typeflag,
        !          3356: 	    $what,$middle,$uname,$udom,$issection);
1.290     www      3357: }
                   3358: 
1.285     albertel 3359: sub parm_change_log {
1.284     www      3360:     my ($r)=@_;
                   3361:     &startpage($r);
1.286     www      3362:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',
                   3363: 				      $env{'course.'.$env{'request.course.id'}.'.domain'},
                   3364: 				      $env{'course.'.$env{'request.course.id'}.'.num'});
                   3365:     my %exetime=();
1.287     albertel 3366:     foreach my $key (keys(%parmlog)) {
1.286     www      3367: 	if ($key=~/^(.+)\_exe\_time$/) {
                   3368: 	    $exetime{$1}=$parmlog{$key};
                   3369: 	}
1.291   ! www      3370:     }    
        !          3371:     my $courseopt=&Apache::lonnet::get_courseresdata($env{'course.'.$env{'request.course.id'}.'.num'},
        !          3372: 						     $env{'course.'.$env{'request.course.id'}.'.domain'});
1.286     www      3373:     $r->print('<table border="2">');
1.291   ! www      3374:     foreach my $id (sort { $exetime{$b}<=>$exetime{$a} } (keys(%exetime))) {
1.290     www      3375:         my @changes=split(/\,/,$parmlog{$id.'_logentry'});
                   3376: 	my $count=$#changes+1;
1.288     albertel 3377: 	my $time =
                   3378: 	    &Apache::lonlocal::locallocaltime($parmlog{$id.'_exe_time'});
1.289     www      3379: 	my $plainname = 
1.288     albertel 3380: 	    &Apache::loncommon::plainname($parmlog{$id.'_exe_uname'},
                   3381: 					  $parmlog{$id.'_exe_udom'});
                   3382: 	my $about_me_link = 
1.289     www      3383: 	    &Apache::loncommon::aboutmewrapper($plainname,
1.288     albertel 3384: 					       $parmlog{$id.'_exe_uname'},
                   3385: 					       $parmlog{$id.'_exe_udom'});
                   3386: 
                   3387: 	my $send_msg_link;
                   3388: 	if ((($parmlog{$id.'_exe_uname'} ne $env{'user.name'}) 
                   3389: 	     || ($parmlog{$id.'_exe_udom'} ne $env{'user.domain'}))) {
                   3390: 	    my $send_msg_link ='<br />'.
                   3391: 		&Apache::loncommon::messagewrapper(&mt('Send message'),
                   3392: 						   $parmlog{$id.'_exe_uname'},
                   3393: 						   $parmlog{$id.'_exe_udom'});
                   3394: 	}
1.290     www      3395: 	$r->print('<tr><td rowspan="'.$count.'">'.$time.'</td>
                   3396:                        <td rowspan="'.$count.'">'.$about_me_link.
                   3397: 		  '<br /><tt>'.$parmlog{$id.'_exe_uname'}.
                   3398: 			          ':'.$parmlog{$id.'_exe_udom'}.'</tt>'.
                   3399: 		  $send_msg_link.'</td>');
                   3400: 	my $makenewrow=0;
                   3401: 	my %istype=();
                   3402: 	foreach my $changed (sort @changes) {
                   3403:             my ($key,$value)=split(/\=\>/,&Apache::lonnet::unescape($changed));
1.291   ! www      3404:             my ($realm,$section,$parmname,$part,$typeflag,$what,$middle,$uname,$udom,$issection)=
1.290     www      3405: 		&components($key,$parmlog{$id.'_uname'},$parmlog{$id.'_udom'});
                   3406: 	    if ($typeflag) { $istype{$parmname}=$value; }
                   3407: 	    if ($makenewrow) { $r->print('<tr>'); } else { $makenewrow=1; }
                   3408: 	    $r->print('<td>'.$realm.'</td><td>'.$section.'</td><td>'.
                   3409: 		      &mt('Part: [_1]',$part).'</td><td>');
1.291   ! www      3410: 	    my $stillactive=0;
1.290     www      3411: 	    if ($parmlog{$id.'_deleteflag'}) {
                   3412: 		$r->print(&mt('Deleted'));
1.288     albertel 3413: 	    } else {
1.290     www      3414: 		if ($typeflag) {
                   3415: 		    $r->print(&mt('Type: [_1]',$value));
                   3416: 		} else {
1.291   ! www      3417: 		    my ($level,@all)=&parmval_by_symb($what,$middle,&Apache::lonnet::metadata($middle,$what),
        !          3418: 						      $uname,$udom,$issection,$issection,$courseopt);
        !          3419: 		    if (&isdateparm($istype{$parmname})) {
        !          3420: 			$r->print(&Apache::lonlocal::locallocaltime($value));
        !          3421: 		    } else {
        !          3422: 			$r->print($value);
        !          3423: 		    }
        !          3424: 		    if ($value ne $all[$level]) {
        !          3425: 			$r->print('<br /><font color="red">'.&mt('Not active anymore').'</font>');
        !          3426: 		    } else {
        !          3427: 			$stillactive=1;
        !          3428: 		    }
1.290     www      3429: 		}
1.288     albertel 3430: 	    }
1.291   ! www      3431: 	    $r->print('</td>');
        !          3432: 	    if ($stillactive) {
        !          3433: 		$r->print('<td>Notify Link</td>');
        !          3434: 	    } else {
        !          3435: 		$r->print('<td>&nbsp;</td>');
        !          3436: 	    }
        !          3437: 	    $r->print('</tr>');
1.288     albertel 3438: 	}
1.286     www      3439:     }
                   3440:     $r->print('</table>');
1.284     www      3441:     $r->print(&Apache::loncommon::end_page());
                   3442: }
                   3443: 
1.178     raeburn  3444: ##################################################
                   3445: ##################################################
1.30      www      3446: 
1.59      matthew  3447: =pod
                   3448: 
1.83      bowersj2 3449: =item * handler
1.59      matthew  3450: 
                   3451: Main handler.  Calls &assessparms and &crsenv subroutines.
                   3452: 
                   3453: =cut
                   3454: ##################################################
                   3455: ##################################################
1.220     www      3456: #    use Data::Dumper;
                   3457: 
1.259     banghart 3458: 
1.30      www      3459: sub handler {
1.43      albertel 3460:     my $r=shift;
1.30      www      3461: 
1.43      albertel 3462:     if ($r->header_only) {
1.126     www      3463: 	&Apache::loncommon::content_type($r,'text/html');
1.43      albertel 3464: 	$r->send_http_header;
                   3465: 	return OK;
                   3466:     }
1.193     albertel 3467:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.205     www      3468: 					    ['action','state',
                   3469:                                              'pres_marker',
                   3470:                                              'pres_value',
1.206     www      3471:                                              'pres_type',
1.243     banghart 3472:                                              'udom','uname','symb','serial']);
1.131     www      3473: 
1.83      bowersj2 3474: 
1.193     albertel 3475:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 3476:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
                   3477: 					    text=>"Parameter Manager",
1.204     www      3478: 					    faq=>10,
1.194     albertel 3479: 					    bug=>'Instructor Interface'});
1.203     www      3480: 
1.30      www      3481: # ----------------------------------------------------- Needs to be in a course
1.194     albertel 3482:     my $parm_permission =
                   3483: 	(&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||
1.190     albertel 3484: 	 &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
1.193     albertel 3485: 				  $env{'request.course.sec'}));
1.194     albertel 3486:     if ($env{'request.course.id'} &&  $parm_permission) {
1.193     albertel 3487: 
                   3488:         # Start Page
1.126     www      3489:         &Apache::loncommon::content_type($r,'text/html');
1.106     www      3490:         $r->send_http_header;
1.30      www      3491: 
1.203     www      3492: 
                   3493:         # id numbers can change on re-ordering of folders
                   3494: 
                   3495:         &resetsymbcache();
                   3496: 
1.193     albertel 3497:         #
                   3498:         # Main switch on form.action and form.state, as appropriate
                   3499:         #
                   3500:         # Check first if coming from someone else headed directly for
                   3501:         #  the table mode
                   3502:         if ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   3503: 	     && (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   3504: 	    &assessparms($r);
                   3505: 
                   3506:         } elsif (! exists($env{'form.action'})) {
                   3507:             $r->print(&header());
1.194     albertel 3508:             $r->print(&Apache::lonhtmlcommon::breadcrumbs(undef,
                   3509: 							 'Parameter Manager'));
1.193     albertel 3510:             &print_main_menu($r,$parm_permission);
                   3511:         } elsif ($env{'form.action'} eq 'crsenv' && $parm_permission) {
1.194     albertel 3512:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=crsenv',
                   3513: 						    text=>"Course Environment"});
1.193     albertel 3514:             &crsenv($r); 
                   3515:         } elsif ($env{'form.action'} eq 'setoverview' && $parm_permission) {
1.194     albertel 3516:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
                   3517: 						    text=>"Overview Mode"});
1.121     www      3518: 	    &overview($r);
1.259     banghart 3519:         } elsif ($env{'form.action'} eq 'setrestrictmeta' && $parm_permission) {
                   3520:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
                   3521: 						    text=>"Restrict Metadata"});
                   3522: 	    &setrestrictmeta($r);
1.208     www      3523:         } elsif ($env{'form.action'} eq 'newoverview' && $parm_permission) {
                   3524:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
                   3525: 						    text=>"Overview Mode"});
                   3526: 	    &newoverview($r);
1.220     www      3527:         }  elsif ($env{'form.action'} eq 'setdefaults' && $parm_permission) {
                   3528:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
                   3529: 						    text=>"Set Defaults"});
                   3530: 	    &defaultsetter($r);
                   3531: 	} elsif ($env{'form.action'} eq 'settable' && $parm_permission) {
1.194     albertel 3532:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.204     www      3533: 						    text=>"Table Mode",
                   3534: 						    help => 'Course_Setting_Parameters'});
1.121     www      3535: 	    &assessparms($r);
1.284     www      3536:         } elsif ($env{'form.action'} eq 'parameterchangelog' && $parm_permission) {
                   3537:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
                   3538: 						    text=>"Parameter Change Log and Course Blog Posting"});
1.285     albertel 3539: 	    &parm_change_log($r);
1.284     www      3540: 	}       
1.43      albertel 3541:     } else {
1.1       www      3542: # ----------------------------- Not in a course, or not allowed to modify parms
1.190     albertel 3543: 	$env{'user.error.msg'}=
1.43      albertel 3544: 	    "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   3545: 	return HTTP_NOT_ACCEPTABLE;
                   3546:     }
                   3547:     return OK;
1.1       www      3548: }
                   3549: 
                   3550: 1;
                   3551: __END__
                   3552: 
1.59      matthew  3553: =pod
1.38      harris41 3554: 
                   3555: =back
                   3556: 
                   3557: =cut
1.1       www      3558: 
                   3559: 
                   3560: 

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