[BACK]Return to lonparmset.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonparmset.pm between versions 1.20 and 1.62

version 1.20, 2000/12/12 21:33:50 version 1.62, 2002/08/17 20:04:18
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # Handler to set parameters for assessments  # Handler to set parameters for assessments
 #  #
 # (Handler to resolve ambiguous file locations  # $Id$
 #  #
 # (TeX Content Handler  # Copyright Michigan State University Board of Trustees
 #  #
 # 05/29/00,05/30,10/11 Gerd Kortemeyer)  # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
 #  #
 # 10/11,10/12,10/16 Gerd Kortemeyer)  # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
 #  #
 # 11/20,11/21,11/22,11/23,11/24,11/25,11/27,11/28,  # LON-CAPA is distributed in the hope that it will be useful,
 # 12/08,12/12 Gerd Kortemeyer  # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
   ###################################################################
   ###################################################################
   
   =pod
   
   =head1 NAME
   
   lonparmset - Handler to set parameters for assessments and course
   
   =head1 SYNOPSIS
   
   lonparmset provides an interface to setting course parameters. 
   
   =head1 DESCRIPTION
   
   This module sets coursewide and assessment parameters.
   
   =head1 INTERNAL SUBROUTINES
   
   =over 4
   
   =cut
   
   ###################################################################
   ###################################################################
   
 package Apache::lonparmset;  package Apache::lonparmset;
   
 use strict;  use strict;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::Constants qw(:common :http REDIRECT);  use Apache::Constants qw(:common :http REDIRECT);
   use Apache::loncommon;
 use GDBM_File;  use GDBM_File;
   use Apache::lonhomework;
   use Apache::lonxml;
   
   
 my %courseopt;  my %courseopt;
 my %useropt;  my %useropt;
 my %bighash;  
 my %parmhash;  my %parmhash;
   
 my @outpar;  
   
 my @ids;  my @ids;
 my %symbp;  my %symbp;
 my %mapp;  my %mapp;
 my %typep;  my %typep;
 my %keyp;  my %keyp;
 my %defp;  
   
 my %allkeys;  
   
 my $uname;  my $uname;
 my $udom;  my $udom;
 my $uhome;  my $uhome;
   
 my $csec;  my $csec;
   my $coursename;
   
   ##################################################
   ##################################################
   
   =pod
   
 my $fcat;  =item parmval
   
 # -------------------------------------------- Figure out a cascading parameter  Figure out a cascading parameter.
   
   Inputs:  $what $id $def
   
   Returns: I am not entirely sure.
   
   =cut
   
   ##################################################
   ##################################################
 sub parmval {  sub parmval {
     my ($what,$id,$def)=@_;      my ($what,$id,$def)=@_;
     my $result='';      my $result='';
     @outpar=();      my @outpar=();
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
   
        my $symbparm=$symbp{$id}.'.'.$what;      my $symbparm=$symbp{$id}.'.'.$what;
        my $mapparm=$mapp{$id}.'___(all).'.$what;      my $mapparm=$mapp{$id}.'___(all).'.$what;
   
        my $seclevel=      my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$what;
             $ENV{'request.course.id'}.'.['.      my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
  $csec.'].'.$what;      my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
        my $seclevelr=  
             $ENV{'request.course.id'}.'.['.      my $courselevel=$ENV{'request.course.id'}.'.'.$what;
  $csec.'].'.$symbparm;      my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
        my $seclevelm=      my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
             $ENV{'request.course.id'}.'.['.  
  $csec.'].'.$mapparm;  
   
        my $courselevel=  
             $ENV{'request.course.id'}.'.'.$what;  
        my $courselevelr=  
             $ENV{'request.course.id'}.'.'.$symbparm;  
        my $courselevelm=  
             $ENV{'request.course.id'}.'.'.$mapparm;  
   
 # -------------------------------------------------------- first, check default  # -------------------------------------------------------- first, check default
   
        if ($def) { $outpar[11]=$def;      if ($def) { $outpar[11]=$def; $result=11; }
                    $result=11; }  
   
 # ----------------------------------------------------- second, check map parms  # ----------------------------------------------------- second, check map parms
   
        my $thisparm=$parmhash{$symbparm};      my $thisparm=$parmhash{$symbparm};
        if ($thisparm) { $outpar[10]=$thisparm;        if ($thisparm) { $outpar[10]=$thisparm; $result=10; }
                         $result=10; }  
   
 # --------------------------------------------------------- third, check course  # --------------------------------------------------------- third, check course
   
        if ($courseopt{$courselevel}) { $outpar[9]=$courseopt{$courselevel};        if ($courseopt{$courselevel}) {
                                        $result=9; }   $outpar[9]=$courseopt{$courselevel};
    $result=9;
        if ($courseopt{$courselevelm}) { $outpar[8]=$courseopt{$courselevelm};       }
                                         $result=8; }  
   
        if ($courseopt{$courselevelr}) { $outpar[7]=$courseopt{$courselevelr};   
                                         $result=7; }  
   
        if ($csec) {      if ($courseopt{$courselevelm}) {
    $outpar[8]=$courseopt{$courselevelm};
    $result=8;
       }
   
         if ($courseopt{$seclevel}) { $outpar[6]=$courseopt{$seclevel};        if ($courseopt{$courselevelr}) {
                                     $result=6; }   $outpar[7]=$courseopt{$courselevelr};
    $result=7;
       }
   
         if ($courseopt{$seclevelm}) { $outpar[5]=$courseopt{$seclevelm};        if ($csec) {
                                      $result=5; }            if ($courseopt{$seclevel}) {
        $outpar[6]=$courseopt{$seclevel};
         if ($courseopt{$seclevelr}) { $outpar[4]=$courseopt{$seclevelr};        $result=6;
                                      $result=4; }   }
             if ($courseopt{$seclevelm}) {
       }      $outpar[5]=$courseopt{$seclevelm};
       $result=5;
    }
   
           if ($courseopt{$seclevelr}) {
       $outpar[4]=$courseopt{$seclevelr};
       $result=4;
    }
       }
   
 # ---------------------------------------------------------- fourth, check user  # ---------------------------------------------------------- fourth, check user
         
       if ($uname) {   
   
        if ($useropt{$courselevel}) { $outpar[3]=$useropt{$courselevel};    
                                      $result=3; }  
   
        if ($useropt{$courselevelm}) { $outpar[2]=$useropt{$courselevelm};       if ($uname) {
                                       $result=2; }   if ($useropt{$courselevel}) {
       $outpar[3]=$useropt{$courselevel};
        if ($useropt{$courselevelr}) { $outpar[1]=$useropt{$courselevelr};       $result=3;
                                       $result=1; }   }
   
       }   if ($useropt{$courselevelm}) {
            $outpar[2]=$useropt{$courselevelm};
     return $result;      $result=2;
 }   }
   
 # ------------------------------------------------------------ Output for value   if ($useropt{$courselevelr}) {
       $outpar[1]=$useropt{$courselevelr};
       $result=1;
    }
       }
   
 sub valout {      return ($result,@outpar);
     my ($value,$type)=@_;  
     return  
  ($value?(($type=~/^date/)?localtime($value):$value):'  ');  
 }  }
   
 # -------------------------------------------------------- Produces link anchor  ##################################################
   ##################################################
   
 sub plink {  =pod
     my ($type,$dis,$value,$marker,$return,$call)=@_;  
     return '<a href="javascript:pjump('."'".$type."','".$dis."','".$value."','"  
       .$marker."','".$return."','".$call."'".');">'.  
       &valout($value,$type).'</a>';  
 }  
   
 # ================================================================ Main Handler  =item valout
   
 sub handler {  Format a value for output.
    my $r=shift;  
   
    if ($r->header_only) {  Inputs:  $value, $type
       $r->content_type('text/html');  
       $r->send_http_header;  
       return OK;  
    }  
   
 # ----------------------------------------------------- Needs to be in a course  Returns: $value, formatted for output.  If $type indicates it is a date,
   localtime($value) is returned.
   
    if (($ENV{'request.course.fn'}) &&   =cut
        (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {  
 # -------------------------------------------------------- Variable declaration  
   
       %courseopt=();  ##################################################
       %useropt=();  ##################################################
       %bighash=();  sub valout {
       my ($value,$type)=@_;
       @ids=();      my $result = '';
       %symbp=();      # Values of zero are valid.
       %typep=();      if (! $value && $value ne '0') {
           $result = '&nbsp;&nbsp;';
       my $message='';      } else {
           if ($type=~/^date/) {
       $csec=$ENV{'form.csec'};              $result = localtime($value);
       $udom=$ENV{'form.udom'};  
       unless ($udom) { $udom=$r->dir_config('lonDefDomain'); }  
   
       my $id=$ENV{'form.id'};  
       if (($id) && ($udom)) {  
           $uname=(&Apache::lonnet::idget($udom,$id))[1];  
           if ($uname) {  
       $id='';  
           } else {  
               $message=  
      "<font color=red>Unknown ID '$id' at domain '$udom'</font>";  
           }  
       } else {  
           $uname=$ENV{'form.uname'};  
       }  
       unless ($udom) { $uname=''; }  
       $uhome='';  
       if ($uname) {  
   $uhome=&Apache::lonnet::homeserver($uname,$udom);  
         
         if ($uhome eq 'no_host') {   
           $message=  
      "<font color=red>Unknown user '$uname' at domain '$udom'</font>";  
           $uname='';   
         } else {          } else {
           $csec=&Apache::lonnet::usection(              $result = $value;
        $udom,$uname,$ENV{'request.course.id'});  
           if ($csec eq '-1') {  
              $message="<font color=red>".  
               "User '$uname' at domain '$udom' not in this course</font>";  
               $uname='';  
               $csec=$ENV{'form.csec'};  
  } else {  
               my %name=&Apache::lonnet::userenvironment($udom,$uname,  
  ('firstname','middlename','lastname','generation','id'));  
               $message="\n<p>\nFull Name: ".  
                           $name{'firstname'}.' '.$name{'middlename'}  
                  .$name{'lastname'}.' '.$name{'generation'}.  
                        "<br>\nID: ".$name{'id'}.'<p>';  
          }  
         }          }
       }      }
       return $result;
   }
   
       unless ($csec) { $csec=''; }  ##################################################
   ##################################################
   
       $fcat=$ENV{'form.fcat'};  =pod
       unless ($fcat) { $fcat=''; }  
   
 # ------------------------------------------------------------------- Tie hashs  =item plink
       if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',  
                        &GDBM_READER,0640)) &&  
           (tie(%parmhash,'GDBM_File',  
            $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {  
   
 # --------------------------------------------------------- Get all assessments  Produces a link anchor.
  %allkeys=();  
         %defp=();  
         map {  
     if ($_=~/^src\_(\d+)\.(\d+)$/) {  
        my $mapid=$1;  
                my $resid=$2;  
                my $id=$mapid.'.'.$resid;  
                my $srcf=$bighash{$_};  
                if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {  
    $ids[$#ids+1]=$id;  
                    $typep{$id}=$1;  
                    $keyp{$id}='';  
                    map {  
                        if ($_=~/^parameter\_(.*)/) {  
   my $key=$_;  
                           my $allkey=$1;  
                           $allkey=~s/\_/\./;  
                           my $display=  
       &Apache::lonnet::metadata($srcf,$key.'.display');  
                           unless ($display) {  
                               $display=  
          &Apache::lonnet::metadata($srcf,$key.'.name');  
                           }  
                           $allkeys{$allkey}=$display;  
                           if ($allkey eq $fcat) {  
                              $defp{$id}=  
                               &Apache::lonnet::metadata($srcf,$key);  
   }  
                           if ($keyp{$id}) {  
       $keyp{$id}.=','.$key;  
                           } else {  
                               $keyp{$id}=$key;  
           }  
        }  
                    } split(/\,/,  
                       &Apache::lonnet::metadata($srcf,'keys'));  
                    $mapp{$id}=  
        &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});  
                    $symbp{$id}=$mapp{$id}.  
  '___'.$resid.'___'.  
     &Apache::lonnet::declutter($srcf);  
        }  
             }  
         } keys %bighash;  
 # ---------------------------------------------------------- Anything to store?  
         if ($ENV{'form.pres_marker'}) {  
        my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'});  
        $spnam=~s/\_/\./;  
 # ---------------------------------------------------------- Construct prefixes  
   
        my $symbparm=$symbp{$sresid}.'.'.$spnam;  Inputs: $type,$dis,$value,$marker,$return,$call
        my $mapparm=$mapp{$sresid}.'___(all).'.$spnam;  
   
        my $seclevel=  Returns: scalar with html code for a link which will envoke the 
             $ENV{'request.course.id'}.'.['.  javascript function 'pjump'.
  $csec.'].'.$spnam;  
        my $seclevelr=  
             $ENV{'request.course.id'}.'.['.  
  $csec.'].'.$symbparm;  
        my $seclevelm=  
             $ENV{'request.course.id'}.'.['.  
  $csec.'].'.$mapparm;  
   
        my $courselevel=  
             $ENV{'request.course.id'}.'.'.$spnam;  
        my $courselevelr=  
             $ENV{'request.course.id'}.'.'.$symbparm;  
        my $courselevelm=  
             $ENV{'request.course.id'}.'.'.$mapparm;  
   
        my $storeunder='';  
        if (($snum==9) || ($snum==3)) { $storeunder=$courselevel; }  
        if (($snum==8) || ($snum==2)) { $storeunder=$courselevelm; }  
        if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; }  
        if ($snum==6) { $storeunder=$seclevel; }  
        if ($snum==5) { $storeunder=$seclevelm; }  
        if ($snum==4) { $storeunder=$seclevelr; }  
        $storeunder=&Apache::lonnet::escape($storeunder);  
    
        my $storecontent=  
     $storeunder.'='.&Apache::lonnet::escape($ENV{'form.pres_value'}).'&'.  
     $storeunder.'.type='.&Apache::lonnet::escape($ENV{'form.pres_type'});  
   
        my $reply='';  =cut
            if ($snum>3) {  
 # ---------------------------------------------------------------- Store Course  
             $reply=&Apache::lonnet::critical('put:'.  
              $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.  
              $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata:'.  
              $storecontent,  
              $ENV{'course.'.$ENV{'request.course.id'}.'.home'});  
            } else {  
 # ------------------------------------------------------------------ Store User  
             $reply=  
             &Apache::lonnet::critical('put:'.$udom.':'.$uname.':resourcedata:'.  
              $storecontent,$uhome);  
            }  
   
          if ($reply=~/^error\:(.*)/) {  ##################################################
      $message.="<font color=red>Write Error: $1</font>";  ##################################################
  }  sub plink {
 # ---------------------------------------------------------------- Done storing      my ($type,$dis,$value,$marker,$return,$call)=@_;
    }      my $winvalue=$value;
 # -------------------------------------------------------------- Get coursedata      unless ($winvalue) {
         my $reply=&Apache::lonnet::reply('dump:'.   if ($type=~/^date/) {
               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.              $winvalue=$ENV{'form.recent_'.$type};
               $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',          } else {
               $ENV{'course.'.$ENV{'request.course.id'}.'.home'});              $winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]};
         if ($reply!~/^error\:/) {  
            map {  
              my ($name,$value)=split(/\=/,$_);  
              $courseopt{&Apache::lonnet::unescape($name)}=  
                         &Apache::lonnet::unescape($value);    
            } split(/\&/,$reply);  
         }  
 # --------------------------------------------------- Get userdata (if present)  
         if ($uname) {  
            my $reply=  
        &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);  
            if ($reply!~/^error\:/) {  
               map {  
                 my ($name,$value)=split(/\=/,$_);  
                 $useropt{&Apache::lonnet::unescape($name)}=  
                          &Apache::lonnet::unescape($value);  
               } split(/\&/,$reply);  
            }  
         }          }
       }
       return 
    '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
       .$marker."','".$return."','".$call."'".');">'.
    &valout($value,$type).'</a><a name="'.$marker.'"></a>';
   }
   
 # ------------------------------------------------------------------- Sort this  
   
         @ids=sort  {    sub startpage {
            if ($fcat eq '') {      my ($r,$id,$udom,$csec,$uname)=@_;
               $a<=>$b;      $r->content_type('text/html');
            } else {      $r->send_http_header;
               $outpar[&parmval($fcat,$a,$defp{$a})]<=>      $r->print(<<ENDHEAD);
               $outpar[&parmval($fcat,$b,$defp{$b})];  
            }   
         } @ids;  
 # ------------------------------------------------------------------ Start page  
          $r->content_type('text/html');  
          $r->send_http_header;  
  $r->print(<<ENDHEAD);  
 <html>  <html>
 <head>  <head>
 <title>LON-CAPA Assessment Parameters</title>  <title>LON-CAPA Course Parameters</title>
 <script>  <script>
   
     function pclose() {      function pclose() {
Line 391  sub handler { Line 274  sub handler {
     function psub() {      function psub() {
         pclose();          pclose();
         if (document.parmform.pres_marker.value!='') {          if (document.parmform.pres_marker.value!='') {
               document.parmform.action+='#'+document.parmform.pres_marker.value;
               var typedef=new Array();
               typedef=document.parmform.pres_type.value.split('_');
              if (document.parmform.pres_type.value!='') {
               if (typedef[0]=='date') {
                   eval('document.parmform.recent_'+
                        document.parmform.pres_type.value+
        '.value=document.parmform.pres_value.value;');
               } else {
                   eval('document.parmform.recent_'+typedef[0]+
        '.value=document.parmform.pres_value.value;');
               }
      }
             document.parmform.submit();              document.parmform.submit();
         } else {          } else {
             document.parmform.pres_value.value='';              document.parmform.pres_value.value='';
Line 398  sub handler { Line 294  sub handler {
         }          }
     }      }
   
       function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
           var options = "width=" + w + ",height=" + h + ",";
           options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
           options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
           var newWin = window.open(url, wdwName, options);
           newWin.focus();
       }
 </script>  </script>
 </head>  </head>
 <body bgcolor="#FFFFFF" onUnload="pclose()">  <body bgcolor="#FFFFFF" onUnload="pclose()">
 <h1>Set Assessment Parameters</h1>  <h1>Set Course Parameters for Course:
   $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h1>
   <form method="post" action="/adm/parmset" name="envform">
   <h3>Course Environment</h3>
   <input type="submit" name="crsenv" value="Set Course Environment">
   </form>
 <form method="post" action="/adm/parmset" name="parmform">  <form method="post" action="/adm/parmset" name="parmform">
 <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2>  <h3>Course Assessments</h3>
 <b>  <b>
 Section/Group:   Section/Group:
 <input type="text" value="$csec" size="6" name="csec">  <input type="text" value="$csec" size="6" name="csec">
 <br>  <br>
 For User   For User 
Line 415  or ID Line 323  or ID
 at Domain   at Domain 
 <input type="text" value="$udom" size="6" name="udom">  <input type="text" value="$udom" size="6" name="udom">
 </b>  </b>
 <input type="submit" value="Display">  
 <input type="hidden" value='' name="pres_value">  <input type="hidden" value='' name="pres_value">
 <input type="hidden" value='' name="pres_type">  <input type="hidden" value='' name="pres_type">
 <input type="hidden" value='' name="pres_marker">  <input type="hidden" value='' name="pres_marker">
 ENDHEAD  ENDHEAD
   
         $r->print('<h2>'.$message.'</h2><p>Sort list by ');  }
  $r->print('<select name="fcat" onChange="this.form.submit();">');  
   sub print_row {
       my ($r,$which,$part,$name,$rid,$default,$type,$display,$defbgone,
    $defbgtwo,$parmlev)=@_;
       my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
     $rid,$$default{$which});
       my $parm=$$display{$which};
   
       if ($parmlev eq 'full' || $parmlev eq 'brief') {
           $r->print('<td bgcolor='.$defbgtwo.' align="center">'
                     .$$part{$which}.'</td>');
       } else {    
           $parm=~s|\[.*\]\s||g;
       }
   
       $r->print('<td bgcolor='.$defbgone.'>'.$parm.'</td>');
      
       my $thismarker=$which;
       $thismarker=~s/^parameter\_//;
       my $mprefix=$rid.'&'.$thismarker.'&';
   
       if ($parmlev eq 'general') {
   
           if ($uname) {
               &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
           } elsif ($csec) {
               &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display); 
           } else {
               &print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); 
           }
       } elsif ($parmlev eq 'map') {
   
           if ($uname) {
               &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
           } elsif ($csec) {
               &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
           } else {
               &print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
           }
       } else {
   
           &print_td($r,11,'#FFDDDD',$result,\@outpar,$mprefix,$_,$type,$display);
   
           if ($parmlev eq 'brief') {
   
              &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
   
              if ($csec) {
                  &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
              }
              if ($uname) {
                  &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
              }
           } else {
   
              &print_td($r,10,'#FFDDDD',$result,\@outpar,$mprefix,$_,$type,$display);
              &print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
              &print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
              &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
   
              if ($csec) {
                  &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
                  &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
                  &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
              }
              if ($uname) {
                  &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
                  &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
                  &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
              }
           } # end of $brief if/else
       } # end of $parmlev if/else
   
       if ($parmlev eq 'full' || $parmlev eq 'brief') {
           $r->print('<td bgcolor=#CCCCFF align="center">'.
                     &valout($outpar[$result],$$type{$which}).'</td>');
       }
       my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
                                           '.'.$$name{$which},$symbp{$rid});
       $r->print('<td bgcolor=#999999 align="center"><font color=#FFFFFF>'.
                     &valout($sessionval,$$type{$which}).'&nbsp;'.
                     '</font></td>');
       $r->print('</tr>');
       $r->print("\n");
   }
   
   sub print_td {
       my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$type,$display)=@_;
       $r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg).
                 ' align="center">'.
                 &plink($$type{$value},$$display{$value},$$outpar[$which],
                        $mprefix."$which",'parmform.pres','psub').'</td>'."\n");
   }
   
   sub get_env_multiple {
       my ($name) = @_;
       my @values;
       if (defined($ENV{$name})) {
           # exists is it an array
           if (ref($ENV{$name})) {
               @values=@{ $ENV{$name} };
           } else {
               $values[0]=$ENV{$name};
           }
       }
       return(@values);
   }
   
   ##################################################
   ##################################################
   
   =pod
   
   =item assessparms
   
   Show assessment data and parameters.  This is a large routine that should
   be simplified and shortened... someday.
   
   Inputs: $r
   
   Returns: nothing
   
   =cut
   
   ##################################################
   ##################################################
   sub assessparms {
   
       my $r=shift;
   # -------------------------------------------------------- Variable declaration
       my %allkeys;
       my %allmaps;
       my %alllevs;
   
       $alllevs{'Resource Level'}='full';
   #    $alllevs{'Resource Level [BRIEF]'}='brief';
       $alllevs{'Map Level'}='map';
       $alllevs{'Course Level'}='general';
   
       my %allparms;
       my %allparts;
   
       my %defp;
       %courseopt=();
       %useropt=();
       my %bighash=();
   
       @ids=();
       %symbp=();
       %typep=();
   
       my $message='';
   
       $csec=$ENV{'form.csec'};
       $udom=$ENV{'form.udom'};
       unless ($udom) { $udom=$r->dir_config('lonDefDomain'); }
   
       my @pscat=&get_env_multiple('form.pscat');
       my $pschp=$ENV{'form.pschp'};
       my @psprt=&get_env_multiple('form.psprt');
       my $showoptions=$ENV{'form.showoptions'};
   
       my $pssymb='';
       my $parmlev='';
       my $prevvisit=$ENV{'form.prevvisit'};
   
   #    unless ($parmlev==$ENV{'form.parmlev'}) {
   #        $parmlev = 'full';
   #    }
    
       unless ($ENV{'form.parmlev'}) {
           $parmlev = 'map';
       } else {
           $parmlev = $ENV{'form.parmlev'};
       }
   
   # ----------------------------------------------- Was this started from grades?
   
       if (($ENV{'form.command'} eq 'set') && ($ENV{'form.url'})
    && (!$ENV{'form.dis'})) {
    my $url=$ENV{'form.url'};
    $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
    $pssymb=&Apache::lonnet::symbread($url);
    @pscat='all';
    $pschp='';
           $parmlev = 'full';
       } elsif ($ENV{'form.symb'}) {
    $pssymb=$ENV{'form.symb'};
    @pscat='all';
    $pschp='';
           $parmlev = 'full';
       } else {
    $ENV{'form.url'}='';
       }
   
       my $id=$ENV{'form.id'};
       if (($id) && ($udom)) {
    $uname=(&Apache::lonnet::idget($udom,$id))[1];
    if ($uname) {
       $id='';
    } else {
       $message=
    "<font color=red>Unknown ID '$id' at domain '$udom'</font>";
    }
       } else {
    $uname=$ENV{'form.uname'};
       }
       unless ($udom) { $uname=''; }
       $uhome='';
       if ($uname) {
    $uhome=&Apache::lonnet::homeserver($uname,$udom);
           if ($uhome eq 'no_host') {
       $message=
    "<font color=red>Unknown user '$uname' at domain '$udom'</font>";
       $uname='';
           } else {
       $csec=&Apache::lonnet::usection($udom,$uname,
       $ENV{'request.course.id'});
       if ($csec eq '-1') {
    $message="<font color=red>".
       "User '$uname' at domain '$udom' not ".
                       "in this course</font>";
    $uname='';
    $csec=$ENV{'form.csec'};
       } else {
    my %name=&Apache::lonnet::userenvironment($udom,$uname,
         ('firstname','middlename','lastname','generation','id'));
    $message="\n<p>\nFull Name: ".
       $name{'firstname'}.' '.$name{'middlename'}.' '
    .$name{'lastname'}.' '.$name{'generation'}.
       "<br>\nID: ".$name{'id'}.'<p>';
       }
           }
       }
   
       unless ($csec) { $csec=''; }
   
       my $fcat=$ENV{'form.fcat'};
       unless ($fcat) { $fcat=''; }
   
   # ------------------------------------------------------------------- Tie hashs
       if (!(tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
         &GDBM_READER(),0640))) {
    $r->print("Unable to access course data. (File $ENV{'request.course.fn'}.db not tieable)");
    return ;
       }
       if (!(tie(%parmhash,'GDBM_File',
         $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640))) {
    $r->print("Unable to access parameter data. (File $ENV{'request.course.fn'}_parms.db not tieable)");
    return ;
       }
   # --------------------------------------------------------- Get all assessments
       foreach (keys %bighash) {
    if ($_=~/^src\_(\d+)\.(\d+)$/) {
       my $mapid=$1;
       my $resid=$2;
       my $id=$mapid.'.'.$resid;
       my $srcf=$bighash{$_};
       if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
    $ids[$#ids+1]=$id;
    $typep{$id}=$1;
    $keyp{$id}='';
    foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
     if ($_=~/^parameter\_(.*)/) {
                       my $key=$_;
                       my $allkey=$1;
                       $allkey=~s/\_/\./g;
                       my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
                       my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
                       my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
                       my $parmdis = $display;
                       $parmdis =~ s|(\[Part.*$)||g;
                       my $partkey = $part;
                       $partkey =~ tr|_|.|;
                       $allparms{$name} = $parmdis;
                       $allparts{$part} = "[Part $part]";
                       $allkeys{$allkey}=$display;
                       if ($allkey eq $fcat) {
           $defp{$id}= &Apache::lonnet::metadata($srcf,$key);
       }
       if ($keyp{$id}) {
           $keyp{$id}.=','.$key;
       } else {
           $keyp{$id}=$key;
       }
     }
    }
    $mapp{$id}=
       &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});
                   $mapp{$mapid}=$mapp{$id};
    $allmaps{$mapid}=$mapp{$id};
    $symbp{$id}=$mapp{$id}.
    '___'.$resid.'___'.
       &Apache::lonnet::declutter($srcf);
                   $symbp{$mapid}=$mapp{$id}.'___(all)';
       }
    }
       }
       $mapp{'0.0'} = '';
       $symbp{'0.0'} = '';
   # ---------------------------------------------------------- Anything to store?
       if ($ENV{'form.pres_marker'}) {
    my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'});
    $spnam=~s/\_([^\_]+)$/\.$1/;
   # ---------------------------------------------------------- Construct prefixes
   
    my $symbparm=$symbp{$sresid}.'.'.$spnam;
    my $mapparm=$mapp{$sresid}.'___(all).'.$spnam;
   
    my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$spnam;
    my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
    my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
   
    my $courselevel=$ENV{'request.course.id'}.'.'.$spnam;
    my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
    my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
   
    my $storeunder='';
    if (($snum==9) || ($snum==3)) { $storeunder=$courselevel; }
    if (($snum==8) || ($snum==2)) { $storeunder=$courselevelm; }
    if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; }
    if ($snum==6) { $storeunder=$seclevel; }
    if ($snum==5) { $storeunder=$seclevelm; }
    if ($snum==4) { $storeunder=$seclevelr; }
   
           my %storecontent = ($storeunder        => $ENV{'form.pres_value'},
                               $storeunder.'type' => $ENV{'form.pres_type'});
    my $reply='';
    if ($snum>3) {
   # ---------------------------------------------------------------- Store Course
   #
   # Expire sheets
       &Apache::lonnet::expirespread('','','studentcalc');
       if (($snum==7) || ($snum==4)) {
    &Apache::lonnet::expirespread('','','assesscalc',$symbp{$sresid});
       } elsif (($snum==8) || ($snum==5)) {
    &Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid});
       } else {
    &Apache::lonnet::expirespread('','','assesscalc');
       }
   # Store parameter
               $reply=&Apache::lonnet::cput
                   ('resourcedata',\%storecontent,
                    $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
                    $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
    } else {
   # ------------------------------------------------------------------ Store User
   #
   # Expire sheets
       &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
       if ($snum==1) {
    &Apache::lonnet::expirespread
       ($uname,$udom,'assesscalc',$symbp{$sresid});
       } elsif ($snum==2) {
    &Apache::lonnet::expirespread
       ($uname,$udom,'assesscalc',$mapp{$sresid});
       } else {
    &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
       }
   # Store parameter
       $reply=&Apache::lonnet::cput
                   ('resourcedata',\%storecontent,$udom,$uname);
    }
   
    if ($reply=~/^error\:(.*)/) {
       $message.="<font color=red>Write Error: $1</font>";
    }
   # ---------------------------------------------------------------- Done storing
       }
   # -------------------------------------------------------------- Get coursedata
       %courseopt = &Apache::lonnet::dump
           ('resourcedata',
            $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
            $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
   # --------------------------------------------------- Get userdata (if present)
       if ($uname) {
           %useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname);
       }
   
   # ------------------------------------------------------------------- Sort this
   
       @ids=sort  {
    if ($fcat eq '') {
       $a<=>$b;
    } else {
       my ($result,@outpar)=&parmval($fcat,$a,$defp{$a});
       my $aparm=$outpar[$result];
       ($result,@outpar)=&parmval($fcat,$b,$defp{$b});
       my $bparm=$outpar[$result];
       1*$aparm<=>1*$bparm;
    }
       } @ids;
   #----------------------------------------------- if all selected, fill in array
       if ($pscat[0] eq "all" || !@pscat) {@pscat = (keys %allparms);}
       if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
   # ------------------------------------------------------------------ Start page
       &startpage($r,$id,$udom,$csec,$uname);
   #    if ($ENV{'form.url'}) {
   # $r->print('<input type="hidden" value="'.$ENV{'form.url'}.
   #  '" name="url"><input type="hidden" name="command" value="set">');
   #    }
       $r->print('<input type="hidden" value="true" name="prevvisit">');
   
       foreach ('tolerance','date_default','date_start','date_end',
        'date_interval','int','float','string') {
    $r->print('<input type="hidden" value="'.
     $ENV{'form.recent_'.$_}.'" name="recent_'.$_.'">');
       }
   
       $r->print('<h2>'.$message.'</h2><table>');
                           
       $r->print('<tr><td><hr /></td></tr>');
   
       my $submitmessage;
       if (($prevvisit) || ($pschp) || ($pssymb)) {
           $submitmessage = "Update Display";
       } else {
           $submitmessage = "Display";
       }
       if (!$pssymb) {
           $r->print('<tr><td>Select Parameter Level</td><td>');
           $r->print('<select name="parmlev">');
           foreach (reverse sort keys %alllevs) {
               $r->print('<option value="'.$alllevs{$_}.'"');
               if ($parmlev eq $alllevs{$_}) {
                  $r->print(' selected'); 
               }
               $r->print('>'.$_.'</option>');
           }
           $r->print("</select></td>\n");
       
           $r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>');
   
           $r->print('</tr><tr><td><hr /></td>');
   
           $r->print('<tr><td>Select Enclosing Map</td>');
           $r->print('<td colspan="2"><select name="pschp">');
           $r->print('<option value="all">All Maps</option>');
           foreach (sort {$allmaps{$a} cmp $allmaps{$b}} keys %allmaps) {
               $r->print('<option value="'.$_.'"');
               if (($pschp eq $_)) { $r->print(' selected'); }
               $r->print('>/res/'.$allmaps{$_}.'</option>');
           }
           $r->print("</select></td></tr>\n");
       } else {
           my ($map,$id,$resource)=split(/___/,$pssymb);
           $r->print("<tr><td>Specific Resource</td><td>$resource</td>");
           $r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>');
           $r->print('</tr>');
           $r->print('<input type="hidden" value="'.$pssymb.'" name="symb">');
       }
   
       $r->print('<tr><td colspan="3"><hr /><input type="checkbox"');
       if ($showoptions eq 'show') {$r->print(" checked ");}
       $r->print(' name="showoptions" value="show" onclick="form.submit();">Show More Options<hr /></td></tr>');
   #    $r->print("<tr><td>Show: $showoptions</td></tr>");
   #    $r->print("<tr><td>pscat: @pscat</td></tr>");
   #    $r->print("<tr><td>psprt: @psprt</td></tr>");
   #    $r->print("<tr><td>fcat:  $fcat</td></tr>");
   
       if ($showoptions eq 'show') {
           my $tempkey;
   
           $r->print('<tr><td colspan="3" align="center">Select Parameters to View</td></tr>');
   
           $r->print('<tr><td colspan="2"><table>');
           $r->print('<tr><td><input type="checkbox" name="pscat" value="all"');
           $r->print(' checked') unless (@pscat);
           $r->print('>All Parameters</td>');
   
           my $cnt=0;
   
           foreach $tempkey (sort { $allparms{$a} cmp $allparms{$b} }
                         keys %allparms ) {
               ++$cnt;
               $r->print('</tr><tr>') unless ($cnt%2);
               $r->print('<td><input type="checkbox" name="pscat" ');
               $r->print('value="'.$tempkey.'"');
               if ($pscat[0] eq "all" || grep $_ eq $tempkey, @pscat) {
                   $r->print(' checked');
               }
               $r->print('>'.$allparms{$tempkey}.'</td>');
           }
           $r->print('</tr></table>');
   
   #        $r->print('<tr><td>Select Parts</td><td>');
           $r->print('<td><select multiple name="psprt" size="5">');
           $r->print('<option value="all"');
           $r->print(' selected') unless (@psprt);
           $r->print('>All Parts</option>');
           foreach $tempkey (sort keys %allparts) {
               unless ($tempkey =~ /\./) {
                   $r->print('<option value="'.$tempkey.'"');
                   if ($psprt[0] eq "all" ||  grep $_ == $tempkey, @psprt) {
                       $r->print(' selected');
                   }
                   $r->print('>'.$allparts{$tempkey}.'</option>');
               }
           }
           $r->print('</select></td></tr><tr><td colspan="3"><hr /></td></tr>');
   
           $r->print('<tr><td>Sort list by</td><td>');
           $r->print('<select name="fcat">');
         $r->print('<option value="">Enclosing Map</option>');          $r->print('<option value="">Enclosing Map</option>');
         map {          foreach (sort keys %allkeys) {
     $r->print('<option value="'.$_.'"');              $r->print('<option value="'.$_.'"');
             if ($fcat eq $_) { $r->print(' selected'); }              if ($fcat eq $_) { $r->print(' selected'); }
             $r->print('>'.$allkeys{$_}.'</option>');              $r->print('>'.$allkeys{$_}.'</option>');
         } keys %allkeys;          }
         $r->print('</select>');          $r->print('</select></td>');
 # ----------------------------------------------------------------- Start Table  
         my $coursespan=$csec?8:5;          $r->print('</tr><tr><td colspan="3"><hr /></td></tr>');
  $r->print(<<ENDTABLEHEAD);  
 <p><table border=2>      } else { # hide options - include any necessary extras here
 <tr><td colspan=5></td>  
 <th colspan=$coursespan>Any User</th>          $r->print('<input type="hidden" name="fcat" value="'.$fcat.'">'."\n");
 ENDTABLEHEAD  
     if ($uname) {          unless (@pscat) {
  $r->print("<th colspan=3 rowspan=2>User $uname at Domain $udom</th>");            foreach (keys %allparms ) {
               $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
             }
           } else {
             foreach (@pscat) {
               $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
             }
           }
   
           unless (@psprt) {
             foreach (keys %allparts ) {
               $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
             }
           } else {
             foreach (@psprt) {
               $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
             }
           }
   
     }      }
     $r->print(<<ENDTABLETWO);      $r->print('</table>');
 <th rowspan=3>Parameter in Effect</th></tr><tr><td colspan=5></td>  
 <th colspan=2>Resource Level</th>      my @temp_psprt;
       foreach my $t (@psprt) {
    push(@temp_psprt, grep {eval (/^$t\./ || ($_ == $t))} (keys %allparts));
       }
   
       @psprt = @temp_psprt;
   
       my @temp_pscat;
       map {
           my $cat = $_;
           push(@temp_pscat, map { $_.'.'.$cat } @psprt);
       } @pscat;
   
       @pscat = @temp_pscat;
   
       if (($prevvisit) || ($pschp) || ($pssymb)) {
   # ----------------------------------------------------------------- Start Table
           my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
           my $csuname=$ENV{'user.name'};
           my $csudom=$ENV{'user.domain'};
   
   
           if ($parmlev eq 'full' || $parmlev eq 'brief') {
   
              my $coursespan=$csec?8:5;
              $r->print('<p><table border=2>');
              $r->print('<tr><td colspan=5></td>');
              $r->print('<th colspan='.($coursespan).'>Any User</th>');
              if ($uname) {
                  $r->print("<th colspan=3 rowspan=2>");
                  $r->print("User $uname at Domain $udom</th>");
              }
              $r->print(<<ENDTABLETWO);
   <th rowspan=3>Parameter in Effect</th>
   <th rowspan=3>Current Session Value<br>($csuname at $csudom)</th>
   </tr><tr><td colspan=5></td><th colspan=2>Resource Level</th>
 <th colspan=3>in Course</th>  <th colspan=3>in Course</th>
 ENDTABLETWO  ENDTABLETWO
     if ($csec) {             if ($csec) {
  $r->print("<th colspan=3>in Section/Group $csec</th>");                  $r->print("<th colspan=3>in Section/Group $csec</th>");
     }             }
     $r->print(<<ENDTABLEHEADFOUR);             $r->print(<<ENDTABLEHEADFOUR);
 </tr><tr><th>Assessment URL and Title</th><th>Type</th>  </tr><tr><th>Assessment URL and Title</th><th>Type</th>
 <th>Enclosing Map</th><th>Part No.</th><th>Parameter Name</th>  <th>Enclosing Map</th><th>Part No.</th><th>Parameter Name</th>
 <th>default</th><th>from Enclosing Map</th>  <th>default</th><th>from Enclosing Map</th>
 <th>general</th><th>for Enclosing Map</th><th>for Resource</th>  <th>general</th><th>for Enclosing Map</th><th>for Resource</th>
 ENDTABLEHEADFOUR  ENDTABLEHEADFOUR
     if ($csec) {  
   $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');             if ($csec) {
     }                 $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
     if ($uname) {             }
   $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');  
     }             if ($uname) {
  $r->print('</tr><tr>');                 $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
          my $defbgone='';             }
          my $defbgtwo='';  
   map {             $r->print('</tr>');
   
              my $defbgone='';
              my $defbgtwo='';
   
              foreach (@ids) {
   
                   my $rid=$_;
                   my ($inmapid)=($rid=~/\.(\d+)$/);
   
                   if (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid}) ||
                       ($pssymb eq $symbp{$rid})) {
 # ------------------------------------------------------ Entry for one resource  # ------------------------------------------------------ Entry for one resource
      if ($defbgone eq '"E0E099"') {                      if ($defbgone eq '"E0E099"') {
  $defbgone='"E0E0DD"';                          $defbgone='"E0E0DD"';
              } else {                      } else {
                  $defbgone='"E0E099"';                          $defbgone='"E0E099"';
      }                      }
      if ($defbgtwo eq '"FFFF99"') {                      if ($defbgtwo eq '"FFFF99"') {
  $defbgtwo='"FFFFDD"';                          $defbgtwo='"FFFFDD"';
              } else {                      } else {
                  $defbgtwo='"FFFF99"';                          $defbgtwo='"FFFF99"';
      }                      }
     @outpar=();                      my $thistitle='';
             my $rid=$_;                      my %name=   ();
             my $thistitle='';                      undef %name;
             my %name=   ();                      my %part=   ();
             my %part=   ();                      my %display=();
     my %display=();                      my %type=   ();
     my %type=   ();                      my %default=();
             my %default=();                      my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
             my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});  
                       foreach (split(/\,/,$keyp{$rid})) {
             map {                          my $tempkeyp = $_;
  $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');                          if (grep $_ eq $tempkeyp, @catmarker) {
                 $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');                            $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
                 $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');                            $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
                 unless ($display{$_}) { $display{$_}=''; }                            $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
                 $display{$_}.=' ('.$name{$_}.')';                            unless ($display{$_}) { $display{$_}=''; }
                 $default{$_}=&Apache::lonnet::metadata($uri,$_);                            $display{$_}.=' ('.$name{$_}.')';
                 $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');                            $default{$_}=&Apache::lonnet::metadata($uri,$_);
                 $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');                            $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
             } split(/\,/,$keyp{$rid});                            $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
                           }
     my $totalparms=scalar keys %name;                      }
             $r->print('<td bgcolor='.$defbgone.                      my $totalparms=scalar keys %name;
                 ' rowspan='.$totalparms.'><tt><font size=-1>'.                      if ($totalparms>0) {
                 join(' / ',split(/\//,$uri)).                          my $firstrow=1;
                 '</font></tt><p><b>'.  
                       $bighash{'title_'.$rid});                          $r->print('<tr><td bgcolor='.$defbgone.
             if ($thistitle) {                               ' rowspan='.$totalparms.
  $r->print(' ('.$thistitle.')');                               '><tt><font size=-1>'.
             }                               join(' / ',split(/\//,$uri)).
             $r->print('</b></td>');                               '</font></tt><p><b>'.
             $r->print('<td bgcolor='.$defbgtwo.                               "<a href=\"javascript:openWindow('/res/".$uri.
                     ' rowspan='.$totalparms.'>'.$typep{$rid}.'</td>');                               "', 'metadatafile', '450', '500', 'no', 'yes')\";".
             $r->print('<td bgcolor='.$defbgone.                               " TARGET=_self>$bighash{'title_'.$rid}");
                     ' rowspan='.$totalparms.'><tt><font size=-1>'.  
       join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>');                          if ($thistitle) {
             map {                              $r->print(' ('.$thistitle.')');
        my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_});                          }
                           $r->print('</a></b></td>');
                $r->print("<td bgcolor=".$defbgtwo.                          $r->print('<td bgcolor='.$defbgtwo.
                   ">$part{$_}</td><td bgcolor=".$defbgone.                                        ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   ">$display{$_}</td>");                                        '</td>');
                my $thismarker=$_;  
                $thismarker=~s/^parameter\_//;                           $r->print('<td bgcolor='.$defbgone.
                my $mprefix=$rid.'&'.$thismarker.'&';                                        ' rowspan='.$totalparms.
                                         '><tt><font size=-1>');
                $r->print('<td bgcolor='.  
                 (($result==11)?'"#AAFFAA"':'#FFDDDD').'>'.                          $r->print(' / res / ');
              &valout($outpar[11],$type{$_}).'</td>');                          $r->print(join(' / ', split(/\//,$mapp{$rid})));
                $r->print('<td bgcolor='.  
                 (($result==10)?'"#AAFFAA"':'#FFDDDD').'>'.                          $r->print('</font></tt></td>');
              &valout($outpar[10],$type{$_}).'</td>');  
                           foreach (sort keys %name) {
                $r->print('<td bgcolor='.                              unless ($firstrow) {
                 (($result==9)?'"#AAFFAA"':$defbgone).'>'.                                  $r->print('<tr>');
              &plink($type{$_},$display{$_},$outpar[9],$mprefix.'9',                              } else {
                     'parmform.pres','psub').'</td>');                                  undef $firstrow;
                $r->print('<td bgcolor='.                              }
                 (($result==8)?'"#AAFFAA"':$defbgone).'>'.  
              &plink($type{$_},$display{$_},$outpar[8],$mprefix.'8',                              &print_row($r,$_,\%part,\%name,$rid,\%default,
                     'parmform.pres','psub').'</td>');                                         \%type,\%display,$defbgone,$defbgtwo,
                $r->print('<td bgcolor='.                                         $parmlev);
                 (($result==7)?'"#AAFFAA"':$defbgone).'>'.                          }
              &plink($type{$_},$display{$_},$outpar[7],$mprefix.'7',                      }
                     'parmform.pres','psub').'</td>');                  }
               } # end foreach ids
                if ($csec) {  
                  $r->print('<td bgcolor='.  
                    (($result==6)?'"#AAFFAA"':$defbgtwo).'>'.  
              &plink($type{$_},$display{$_},$outpar[6],$mprefix.'6',  
                     'parmform.pres','psub').'</td>');  
                  $r->print('<td bgcolor='.  
                    (($result==5)?'"#AAFFAA"':$defbgtwo).'>'.  
              &plink($type{$_},$display{$_},$outpar[5],$mprefix.'5',  
                     'parmform.pres','psub').'</td>');  
                  $r->print('<td bgcolor='.  
                     (($result==4)?'"#AAFFAA"':$defbgtwo).'>'.  
              &plink($type{$_},$display{$_},$outpar[4],$mprefix.'4',  
                     'parmform.pres','psub').'</td>');  
                }  
   
                if ($uname) {  
                  $r->print('<td bgcolor='.  
                     (($result==3)?'"#AAFFAA"':$defbgone).'>'.  
              &plink($type{$_},$display{$_},$outpar[3],$mprefix.'3',  
                     'parmform.pres','psub').'</td>');  
                  $r->print('<td bgcolor='.  
                     (($result==2)?'"#AAFFAA"':$defbgone).'>'.  
              &plink($type{$_},$display{$_},$outpar[2],$mprefix.'2',  
                     'parmform.pres','psub').'</td>');  
                  $r->print('<td bgcolor='.  
                    (($result==1)?'"#AAFFAA"':$defbgone).'>'.  
              &plink($type{$_},$display{$_},$outpar[1],$mprefix.'1',  
                     'parmform.pres','psub').'</td>');  
                }  
   
                $r->print(  
         '<td bgcolor=#CCCCFF>'.&valout($outpar[$result],$type{$_}).'</td>');  
                $r->print("</tr>\n<tr>");  
    } sort keys %name;  
 # -------------------------------------------------- End entry for one resource  # -------------------------------------------------- End entry for one resource
  } @ids;              $r->print('</table>');
          $r->print('</table></form></body></html>');          } # end of  brief/full
          untie(%bighash);  #--------------------------------------------------- Entry for parm level map
  untie(%parmhash);          if ($parmlev eq 'map') {
       }              my $defbgone = '"E0E099"';
    } else {              my $defbgtwo = '"FFFF99"';
   
               my %maplist;
   
               if ($pschp eq 'all') {
                   %maplist = %allmaps; 
               } else {
                   %maplist = ($pschp => $mapp{$pschp});
               }
   
   #-------------------------------------------- for each map, gather information
               my $mapid;
       foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
                   my $maptitle = $maplist{$mapid};
   
   #-----------------------  loop through ids and get all parameter types for map
   #-----------------------------------------          and associated information
                   my %name = ();
                   my %part = ();
                   my %display = ();
                   my %type = ();
                   my %default = ();
                   my $map = 0;
   
   # $r->print("Catmarker: @catmarker<br />\n");
                  
                   foreach (@ids) {
                     ($map)=(/([\d]*?)\./);
                     my $rid = $_;
           
   #                  $r->print("$mapid:$map:   $rid <br /> \n");
   
                     if ($map eq $mapid) {
                       my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
   #                    $r->print("Keys: $keyp{$rid} <br />\n");
   
   #--------------------------------------------------------------------
   # @catmarker contains list of all possible parameters including part #s
   # $fullkeyp contains the full part/id # for the extraction of proper parameters
   # $tempkeyp contains part 0 only (no ids - ie, subparts)
   # When storing information, store as part 0
   # When requesting information, request from full part
   #-------------------------------------------------------------------
                       foreach (split(/\,/,$keyp{$rid})) {
                         my $tempkeyp = $_;
                         my $fullkeyp = $tempkeyp;
                         $tempkeyp =~ s/_[\d_]+_/_0_/;
                         
                         if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                           $part{$tempkeyp}="0";
                           $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                           $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                           unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                           $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                           $display{$tempkeyp} =~ s/_[\d_]+_/_0_/;
                           $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                           $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                         }
                       } # end loop through keys
                     }
                   } # end loop through ids
                                    
   #---------------------------------------------------- print header information
                   $r->print(<<ENDMAPONE);
   <center><h4>
   <font color="red">Set Defaults for All Resources in map
   <i>$maptitle</i><br />
   Specifically for
   ENDMAPONE
                   if ($uname) {
                       my %name=&Apache::lonnet::userenvironment($udom,$uname,
                         ('firstname','middlename','lastname','generation', 'id'));
                       my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
                              .$name{'lastname'}.' '.$name{'generation'};
                       $r->print("User <i>$uname \($person\) </i> in \n");
                   } else {
                       $r->print("<i>all</i> users in \n");
                   }
               
                   if ($csec) {$r->print("Section <i>$csec</i> of \n")};
   
                   $r->print("<i>$coursename</i><br />");
                   $r->print("</font></h4>\n");
   #---------------------------------------------------------------- print table
                   $r->print('<p><table border="2">');
                   $r->print('<tr><th>Parameter Name</th>');
                   $r->print('<th>Default Value</th>');
                   $r->print('<th>Parameter in Effect</th></tr>');
   
           foreach (sort keys %name) {
                       &print_row($r,$_,\%part,\%name,$mapid,\%default,
                              \%type,\%display,$defbgone,$defbgtwo,
                              $parmlev);
   #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
                   }
                   $r->print("</table></center>");
               } # end each map
           } # end of $parmlev eq map
   #--------------------------------- Entry for parm level general (Course level)
           if ($parmlev eq 'general') {
               my $defbgone = '"E0E099"';
               my $defbgtwo = '"FFFF99"';
   
   #-------------------------------------------- for each map, gather information
               my $mapid="0.0";
   #-----------------------  loop through ids and get all parameter types for map
   #-----------------------------------------          and associated information
               my %name = ();
               my %part = ();
               my %display = ();
               my %type = ();
               my %default = ();
                  
               foreach (@ids) {
                   my $rid = $_;
           
                   my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
   
   #--------------------------------------------------------------------
   # @catmarker contains list of all possible parameters including part #s
   # $fullkeyp contains the full part/id # for the extraction of proper parameters
   # $tempkeyp contains part 0 only (no ids - ie, subparts)
   # When storing information, store as part 0
   # When requesting information, request from full part
   #-------------------------------------------------------------------
                   foreach (split(/\,/,$keyp{$rid})) {
                     my $tempkeyp = $_;
                     my $fullkeyp = $tempkeyp;
                     $tempkeyp =~ s/_[\d_]+_/_0_/;
                     if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                       $part{$tempkeyp}="0";
                       $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                       $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                       unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                       $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                       $display{$tempkeyp} =~ s/_[\d_]+_/_0_/;
                       $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                       $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                     }
                   } # end loop through keys
               } # end loop through ids
                                    
   #---------------------------------------------------- print header information
               $r->print(<<ENDMAPONE);
   <center><h4>
   <font color="red">Set Defaults for All Resources in Course
   <i>$coursename</i><br />
   ENDMAPONE
               if ($uname) {
                   my %name=&Apache::lonnet::userenvironment($udom,$uname,
                     ('firstname','middlename','lastname','generation', 'id'));
                   my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
                          .$name{'lastname'}.' '.$name{'generation'};
                   $r->print(" User <i>$uname \($person\) </i> \n");
               } else {
                   $r->print("<i>ALL</i> USERS \n");
               }
               
               if ($csec) {$r->print("Section <i>$csec</i>\n")};
               $r->print("</font></h4>\n");
   #---------------------------------------------------------------- print table
               $r->print('<p><table border="2">');
               $r->print('<tr><th>Parameter Name</th>');
               $r->print('<th>Default Value</th>');
               $r->print('<th>Parameter in Effect</th></tr>');
   
       foreach (sort keys %name) {
                   &print_row($r,$_,\%part,\%name,$mapid,\%default,
                          \%type,\%display,$defbgone,$defbgtwo,$parmlev);
   #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
               }
               $r->print("</table></center>");
           } # end of $parmlev eq general
       }
       $r->print('</form></body></html>');
       untie(%bighash);
       untie(%parmhash);
   } # end sub assessparms
   
   
   ##################################################
   ##################################################
   
   =pod
   
   =item crsenv
   
   Show course data and parameters.  This is a large routine that should
   be simplified and shortened... someday.
   
   Inputs: $r
   
   Returns: nothing
   
   =cut
   
   ##################################################
   ##################################################
   sub crsenv {
       my $r=shift;
       my $setoutput='';
       my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
       my $crs = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
   # -------------------------------------------------- Go through list of changes
       foreach (keys %ENV) {
    if ($_=~/^form\.(.+)\_setparmval$/) {
               my $name=$1;
               my $value=$ENV{'form.'.$name.'_value'};
               if ($name eq 'newp') {
                   $name=$ENV{'form.newp_name'};
               }
               if ($name eq 'url') {
    $value=~s/^\/res\///;
                   my $bkuptime=time;
                   my @tmp = &Apache::lonnet::get
                       ('environment',['url'],$dom,$crs);
                   $setoutput.='Backing up previous URL: '.
                       &Apache::lonnet::put
                           ('environment',
                            {'top level map backup '.$bkuptime => $tmp[1] },
                            $dom,$crs).
                       '<br>';
               }
               if ($name) {
                   $setoutput.='Setting <tt>'.$name.'</tt> to <tt>'.
                       $value.'</tt>: '.
                       &Apache::lonnet::put
                               ('environment',{$name=>$value},$dom,$crs).
                       '<br>';
       }
           }
       }
   # -------------------------------------------------------- Get parameters again
   
       my %values=&Apache::lonnet::dump('environment',$dom,$crs);
       my $output='';
       if (! exists($values{'con_lost'})) {
           my %descriptions=
       ('url'            => '<b>Top Level Map</b> '.
                                    '<a href="javascript:openbrowser'.
                                    "('envform','url','sequence')\">".
                                    'Browse</a><br><font color=red> '.
                                    'Modification may make assessment data '.
                                    'inaccessible</font>',
                'description'    => '<b>Course Description</b>',
                'courseid'       => '<b>Course ID or number</b><br>'.
                                    '(internal, optional)',
                'default_xml_style' => '<b>Default XML Style File</b> '.
                       '<a href="javascript:openbrowser'.
                       "('envform','default_xml_style'".
                       ",'sty')\">Browse</a><br>",
                'question.email' => '<b>Feedback Addresses for Content '.
                                    'Questions</b><br>(<tt>user:domain,'.
                                    'user:domain,...</tt>)',
                'comment.email'  => '<b>Feedback Addresses for Comments</b><br>'.
                                    '(<tt>user:domain,user:domain,...</tt>)',
                'policy.email'   => '<b>Feedback Addresses for Course Policy</b>'.
                                    '<br>(<tt>user:domain,user:domain,...</tt>)',
                'hideemptyrows'  => '<b>Hide Empty Rows in Spreadsheets</b><br>'.
                                    '("<tt>yes</tt>" for default hiding)',
                'pageseparators'  => '<b>Visibly Separate Items on Pages</b><br>'.
                                    '("<tt>yes</tt>" for visible separation)',
                'pch.roles.denied'=> '<b>Disallow Resource Discussion for '.
                                     'Roles</b><br>"<tt>st</tt>": '.
                                     'student, "<tt>ta</tt>": '.
                                     'TA, "<tt>in</tt>": '.
                                     'instructor;<br><tt>role,role,...</tt>) '.
          Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
                'pch.users.denied' => 
                             '<b>Disallow Resource Discussion for Users</b><br>'.
                                    '(<tt>user:domain,user:domain,...</tt>)',
                'spreadsheet_default_classcalc' 
                    => '<b>Default Course Spreadsheet</b> '.
                       '<a href="javascript:openbrowser'.
                       "('envform','spreadsheet_default_classcalc'".
                       ",'spreadsheet')\">Browse</a><br>",
                'spreadsheet_default_studentcalc' 
                    => '<b>Default Student Spreadsheet</b> '.
                       '<a href="javascript:openbrowser'.
                       "('envform','spreadsheet_default_calc'".
                       ",'spreadsheet')\">Browse</a><br>",
                'spreadsheet_default_assesscalc' 
                    => '<b>Default Assessment Spreadsheet</b> '.
                       '<a href="javascript:openbrowser'.
                       "('envform','spreadsheet_default_assesscalc'".
                       ",'spreadsheet')\">Browse</a><br>",
                );
    foreach (keys(%values)) {
       unless ($descriptions{$_}) {
    $descriptions{$_}=$_;
       }
    }
    foreach (sort keys %descriptions) {
               # onchange is javascript to automatically check the 'Set' button.
               my $onchange = 'onchange="javascript:window.document.forms'.
                   '[\'envform\'].elements[\''.$_.'_setparmval\']'.
                   '.checked=true;"';
       $output.='<tr><td>'.$descriptions{$_}.'</td>'.
                   '<td><input name="'.$_.'_value" size=40 '.
                   'value="'.$values{$_}.'" '.$onchange.' /></td>'.
                   '<td><input type=checkbox name="'.$_.'_setparmval"></td>'.
                   '</tr>'."\n";
    }
           my $onchange = 'onchange="javascript:window.document.forms'.
               '[\'envform\'].elements[\'newp_setparmval\']'.
               '.checked=true;"';
    $output.='<tr><td><i>Create New Environment Variable</i><br />'.
       '<input type="text" size=40 name="newp_name" '.
                   $onchange.' /></td><td>'.
               '<input type="text" size=40 name="newp_value" '.
                   $onchange.' /></td><td>'.
       '<input type="checkbox" name="newp_setparmval" /></td></tr>';
       }
       $r->print(<<ENDENV);
   <html>
   <script type="text/javascript" language="Javascript" >
       var editbrowser;
       function openbrowser(formname,elementname,only,omit) {
           var url = '/res/?';
           if (editbrowser == null) {
               url += 'launch=1&';
           }
           url += 'catalogmode=interactive&';
           url += 'mode=parmset&';
           url += 'form=' + formname + '&';
           if (only != null) {
               url += 'only=' + only + '&';
           } 
           if (omit != null) {
               url += 'omit=' + omit + '&';
           }
           url += 'element=' + elementname + '';
           var title = 'Browser';
           var options = 'scrollbars=1,resizable=1,menubar=0';
           options += ',width=700,height=600';
           editbrowser = open(url,title,options,'1');
           editbrowser.focus();
       }
   </script>
   <head>
   <title>LON-CAPA Course Environment</title>
   </head>
   <body bgcolor="#FFFFFF">
   <h1>Set Course Parameters</h1>
   <form method="post" action="/adm/parmset" name="envform">
   <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2>
   <h3>Course Environment</h3>
   $setoutput
   <p>
   <table border=2>
   <tr><th>Parameter</th><th>Value</th><th>Set?</th></tr>
   $output
   </table>
   <input type="submit" name="crsenv" value="Set Course Environment">
   </form>
   </body>
   </html>    
   ENDENV
   }
   
   ##################################################
   ##################################################
   
   =pod
   
   =item handler
   
   Main handler.  Calls &assessparms and &crsenv subroutines.
   
   =cut
   
   ##################################################
   ##################################################
   sub handler {
       my $r=shift;
   
       if ($r->header_only) {
    $r->content_type('text/html');
    $r->send_http_header;
    return OK;
       }
       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
   # ----------------------------------------------------- Needs to be in a course
   
       if (($ENV{'request.course.id'}) && 
    (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
    
           $coursename=$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
   
    unless (($ENV{'form.crsenv'}) || (!$ENV{'request.course.fn'})) {
   # --------------------------------------------------------- Bring up assessment
       &assessparms($r);
   # ---------------------------------------------- This is for course environment
    } else {
       &crsenv($r);
    }
       } else {
 # ----------------------------- Not in a course, or not allowed to modify parms  # ----------------------------- Not in a course, or not allowed to modify parms
       $ENV{'user.error.msg'}=   $ENV{'user.error.msg'}=
         "/adm/parmset:opa:0:0:Cannot modify assessment parameters";      "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
       return HTTP_NOT_ACCEPTABLE;    return HTTP_NOT_ACCEPTABLE;
    }      }
    return OK;      return OK;
 }  }
   
 1;  1;
 __END__  __END__
   
   =pod
   
   =back
   
   =cut
   
   
   
Removed from v.1.20  
changed lines
  Added in v.1.62

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