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

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

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