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

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

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