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

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

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