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

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

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