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

Diff for /loncom/interface/lonparmset.pm between versions 1.16 and 1.32

version 1.16, 2000/11/28 02:53:40 version 1.32, 2001/08/08 21:00:49
Line 9 Line 9
 #  #
 # 10/11,10/12,10/16 Gerd Kortemeyer)  # 10/11,10/12,10/16 Gerd Kortemeyer)
 #  #
 # 11/20,11/21,11/22,11/23,11/24,11/25,11/27 Gerd Kortemeyer  # 11/20,11/21,11/22,11/23,11/24,11/25,11/27,11/28,
   # 12/08,12/12,
   # 16/01/01,02/08,03/20,03/23,03/24,03/26,05/09,
   # 07/05,07/06,08/08 Gerd Kortemeyer
   
 package Apache::lonparmset;  package Apache::lonparmset;
   
Line 31  my %symbp; Line 34  my %symbp;
 my %mapp;  my %mapp;
 my %typep;  my %typep;
 my %keyp;  my %keyp;
   my %defp;
   
 my %allkeys;  my %allkeys;
   my %allmaps;
   
 my $uname;  my $uname;
 my $udom;  my $udom;
Line 123  sub parmval { Line 128  sub parmval {
     return $result;      return $result;
 }  }
   
 # ---------------------------------------------------------------- Sort routine  
   
 sub bycat {  
     if ($fcat eq '') {  
         $a<=>$b;  
     } else {  
         &parmval($fcat,$a)<=>&parmval($fcat,$b);  
     }  
 }  
   
 # ------------------------------------------------------------ Output for value  # ------------------------------------------------------------ Output for value
   
 sub valout {  sub valout {
Line 145  sub valout { Line 140  sub valout {
   
 sub plink {  sub plink {
     my ($type,$dis,$value,$marker,$return,$call)=@_;      my ($type,$dis,$value,$marker,$return,$call)=@_;
     return '<a href="javascript:pjump('."'".$type."','".$dis."','".$value."','"      my $winvalue=$value;
       unless ($winvalue) {
    if ($type=~/^date/) {
               $winvalue=$ENV{'form.recent_'.$type};
           } else {
               $winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]};
           }
       }
       return 
         '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
       .$marker."','".$return."','".$call."'".');">'.        .$marker."','".$return."','".$call."'".');">'.
       &valout($value,$type).'</a>';        &valout($value,$type).'</a><a name="'.$marker.'"></a>';
 }  }
   
 # ================================================================ Main Handler  sub assessparms {
   
 sub handler {  
    my $r=shift;  
   
    if ($r->header_only) {  
       $r->content_type('text/html');  
       $r->send_http_header;  
       return OK;  
    }  
   
 # ----------------------------------------------------- Needs to be in a course  
   
    if (($ENV{'request.course.fn'}) &&         my $r=shift;
        (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {  
 # -------------------------------------------------------- Variable declaration  # -------------------------------------------------------- Variable declaration
   
       %courseopt=();        %courseopt=();
Line 179  sub handler { Line 171  sub handler {
   
       $csec=$ENV{'form.csec'};        $csec=$ENV{'form.csec'};
       $udom=$ENV{'form.udom'};        $udom=$ENV{'form.udom'};
         unless ($udom) { $udom=$r->dir_config('lonDefDomain'); }
   
         my $pscat=$ENV{'form.pscat'};
         my $pschp=$ENV{'form.pschp'};
         my $pssymb='';
   
   # ----------------------------------------------- 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='';
         } else {
             $ENV{'form.url'}='';
         }
    
       my $id=$ENV{'form.id'};        my $id=$ENV{'form.id'};
       if (($id) && ($udom)) {        if (($id) && ($udom)) {
           $uname=(&Apache::lonnet::idget($udom,$id))[1];            $uname=(&Apache::lonnet::idget($udom,$id))[1];
Line 186  sub handler { Line 197  sub handler {
       $id='';        $id='';
           } else {            } else {
               $message=                $message=
      "<h3><font color=red>Unknown ID '$id' at domain '$udom'</font></h3>";       "<font color=red>Unknown ID '$id' at domain '$udom'</font>";
           }            }
       } else {        } else {
           $uname=$ENV{'form.uname'};            $uname=$ENV{'form.uname'};
Line 198  sub handler { Line 209  sub handler {
               
         if ($uhome eq 'no_host') {           if ($uhome eq 'no_host') { 
           $message=            $message=
      "<h3><font color=red>Unknown user '$uname' at domain '$udom'</font></h3>";       "<font color=red>Unknown user '$uname' at domain '$udom'</font>";
           $uname='';             $uname=''; 
         } else {          } else {
           $csec=&Apache::lonnet::usection(            $csec=&Apache::lonnet::usection(
        $udom,$uname,$ENV{'request.course.id'});         $udom,$uname,$ENV{'request.course.id'});
           if ($csec eq '-1') {            if ($csec eq '-1') {
              $message="<h3><font color=red>".               $message="<font color=red>".
               "User '$uname' at domain '$udom' not in this course</font></h3>";                "User '$uname' at domain '$udom' not in this course</font>";
               $uname='';                $uname='';
               $csec=$ENV{'form.csec'};                $csec=$ENV{'form.csec'};
  } else {   } else {
Line 231  sub handler { Line 242  sub handler {
            $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {             $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
   
 # --------------------------------------------------------- Get all assessments  # --------------------------------------------------------- Get all assessments
  %allkeys=();   undef %allkeys;
           undef %allmaps;
           undef %defp;
         map {          map {
     if ($_=~/^src\_(\d+)\.(\d+)$/) {      if ($_=~/^src\_(\d+)\.(\d+)$/) {
        my $mapid=$1;         my $mapid=$1;
Line 247  sub handler { Line 259  sub handler {
                        if ($_=~/^parameter\_(.*)/) {                         if ($_=~/^parameter\_(.*)/) {
   my $key=$_;    my $key=$_;
                           my $allkey=$1;                            my $allkey=$1;
                             $allkey=~s/\_/\./;
                           my $display=                            my $display=
       &Apache::lonnet::metadata($srcf,$key.'.display');        &Apache::lonnet::metadata($srcf,$key.'.display');
                           unless ($display) {                            unless ($display) {
Line 254  sub handler { Line 267  sub handler {
          &Apache::lonnet::metadata($srcf,$key.'.name');           &Apache::lonnet::metadata($srcf,$key.'.name');
                           }                            }
                           $allkeys{$allkey}=$display;                            $allkeys{$allkey}=$display;
                             if ($allkey eq $fcat) {
                                $defp{$id}=
                                 &Apache::lonnet::metadata($srcf,$key);
     }
                           if ($keyp{$id}) {                            if ($keyp{$id}) {
       $keyp{$id}.=','.$key;        $keyp{$id}.=','.$key;
                           } else {                            } else {
Line 264  sub handler { Line 281  sub handler {
                       &Apache::lonnet::metadata($srcf,'keys'));                        &Apache::lonnet::metadata($srcf,'keys'));
                    $mapp{$id}=                     $mapp{$id}=
        &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});         &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});
                      $allmaps{$mapid}=$mapp{$id};
                    $symbp{$id}=$mapp{$id}.                     $symbp{$id}=$mapp{$id}.
  '___'.$resid.'___'.   '___'.$resid.'___'.
     &Apache::lonnet::declutter($srcf);      &Apache::lonnet::declutter($srcf);
Line 273  sub handler { Line 291  sub handler {
 # ---------------------------------------------------------- Anything to store?  # ---------------------------------------------------------- Anything to store?
         if ($ENV{'form.pres_marker'}) {          if ($ENV{'form.pres_marker'}) {
        my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'});         my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'});
        $spnam=~s/\_/\./;         $spnam=~s/\_([^\_]+)$/\.$1/;
 # ---------------------------------------------------------- Construct prefixes  # ---------------------------------------------------------- Construct prefixes
   
        my $symbparm=$symbp{$sresid}.'.'.$spnam;         my $symbparm=$symbp{$sresid}.'.'.$spnam;
Line 312  sub handler { Line 330  sub handler {
        my $reply='';         my $reply='';
            if ($snum>3) {             if ($snum>3) {
 # ---------------------------------------------------------------- Store Course  # ---------------------------------------------------------------- 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::critical('put:'.              $reply=&Apache::lonnet::critical('put:'.
              $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
              $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata:'.               $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata:'.
Line 319  sub handler { Line 349  sub handler {
              $ENV{'course.'.$ENV{'request.course.id'}.'.home'});               $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
            } else {             } else {
 # ------------------------------------------------------------------ Store User  # ------------------------------------------------------------------ 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=              $reply=
             &Apache::lonnet::critical('put:'.$udom.':'.$uname.':resourcedata:'.              &Apache::lonnet::critical('put:'.$udom.':'.$uname.':resourcedata:'.
              $storecontent,$uhome);               $storecontent,$uhome);
            }             }
   
          if ($reply=~/^error\:(.*)/) {           if ($reply=~/^error\:(.*)/) {
      $message.="<h3><font color=red>Write Error: $1</font></h3>";       $message.="<font color=red>Write Error: $1</font>";
  }   }
 # ---------------------------------------------------------------- Done storing  # ---------------------------------------------------------------- Done storing
    }     }
Line 355  sub handler { Line 399  sub handler {
         }          }
   
 # ------------------------------------------------------------------- Sort this  # ------------------------------------------------------------------- Sort this
          @ids=sort bycat @ids;  
           @ids=sort  {  
              if ($fcat eq '') {
                 $a<=>$b;
              } else {
                 1*$outpar[&parmval($fcat,$a,$defp{$a})]<=>
                 1*$outpar[&parmval($fcat,$b,$defp{$b})];
              } 
          } @ids;
   
 # ------------------------------------------------------------------ Start page  # ------------------------------------------------------------------ Start page
          $r->content_type('text/html');           $r->content_type('text/html');
          $r->send_http_header;           $r->send_http_header;
  $r->print(<<ENDHEAD);   $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 383  sub handler { Line 436  sub handler {
   
     function psub() {      function psub() {
         pclose();          pclose();
         if ((document.parmform.pres_value.value!='') &&           if (document.parmform.pres_marker.value!='') {
             (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 395  sub handler { Line 460  sub handler {
 </script>  </script>
 </head>  </head>
 <body bgcolor="#FFFFFF" onUnload="pclose()">  <body bgcolor="#FFFFFF" onUnload="pclose()">
 <h1>Set Assessment Parameters</h1>  <h1>Set Course Parameters</h1>
 <form method="post" action="/adm/parmset" name="parmform">  <form method="post" action="/adm/parmset" name="envform">
 <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2>  <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2>
   <h3>Course Environment</h3>
   <input type="submit" name="crsenv" value="Set Course Environment">
   </form>
   <form method="post" action="/adm/parmset" name="parmform">
   <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">
Line 409  or ID Line 479  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
       if ($ENV{'form.url'}) {
         $r->print($message.'<p>Sort list by ');   $r->print('<input type="hidden" value="'.$ENV{'form.url'}.
  $r->print('<select name="fcat" onChange="this.form.submit();">');        '" name="url"><input type="hidden" name="command" value="set">');
       }
       map {
         $r->print('<input type="hidden" value="'.
             $ENV{'form.recent_'.$_}.'" name="recent_'.$_.'">');
       } ('tolerance','date_default','date_start','date_end','date_interval',
          'int','float','string');
   
           $r->print('<h2>'.$message.'</h2><table><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 {          map {
     $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;          } keys %allkeys;
         $r->print('</select>');         $r->print(
       '</select></tr><tr><td>Select Enclosing Map</td><td><select name=pschp>');
           $r->print('<option value=all>All Maps</option>');
           map {
       $r->print('<option value="'.$_.'"');
               if (($pssymb=~/^$allmaps{$_}/) || 
                   ($pschp eq $_)) { $r->print(' selected'); }
               $r->print('>'.$allmaps{$_}.'</option>');
           } keys %allmaps;
           $r->print(
    '</select></td></tr><tr><td>Select Parameter</td><td><select name=pscat>');
           $r->print('<option value=all>All Parameters</option>');
           map {
       $r->print('<option value="'.$_.'"');
               if ($pscat eq $_) { $r->print(' selected'); }
               $r->print('>'.$allkeys{$_}.'</option>');
           } keys %allkeys;
           $r->print(
   '</select></td></tr></table><br><input name=dis type="submit" value="Display">'
                    );
         if (($pscat) || ($pschp) || ($pssymb)) {
 # ----------------------------------------------------------------- Start Table  # ----------------------------------------------------------------- Start Table
    my $catmarker='parameter_'.$pscat;
           $catmarker=~s/\./\_/g;
         my $coursespan=$csec?8:5;          my $coursespan=$csec?8:5;
  $r->print(<<ENDTABLEHEAD);   $r->print(<<ENDTABLEHEAD);
 <p><table border=2>  <p><table border=2>
Line 455  ENDTABLEHEADFOUR Line 555  ENDTABLEHEADFOUR
   $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');    $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
     }      }
  $r->print('</tr><tr>');   $r->print('</tr><tr>');
            my $defbgone='';
            my $defbgtwo='';
   map {    map {
              my $rid=$_;
              my ($inmapid)=($rid=~/\.(\d+)$/);
              if (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid}) ||
                  ($pssymb eq $mapp{$rid}.'___'.$inmapid.'___'.
                   &Apache::lonnet::declutter($bighash{'src_'.$rid}))) {
 # ------------------------------------------------------ Entry for one resource  # ------------------------------------------------------ Entry for one resource
        if ($defbgone eq '"E0E099"') {
    $defbgone='"E0E0DD"';
                } else {
                    $defbgone='"E0E099"';
        }
        if ($defbgtwo eq '"FFFF99"') {
    $defbgtwo='"FFFFDD"';
                } else {
                    $defbgtwo='"FFFF99"';
        }
     @outpar=();      @outpar=();
             my $rid=$_;  
             my $thistitle='';              my $thistitle='';
             my %name=   ();              my %name=   ();
             my %part=   ();              my %part=   ();
Line 473  ENDTABLEHEADFOUR Line 589  ENDTABLEHEADFOUR
                 $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');                  $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
                 unless ($display{$_}) { $display{$_}=''; }                  unless ($display{$_}) { $display{$_}=''; }
                 $display{$_}.=' ('.$name{$_}.')';                  $display{$_}.=' ('.$name{$_}.')';
                 $default{$_}=&Apache::lonnet::metadata($uri,$_.'.default');                  $default{$_}=&Apache::lonnet::metadata($uri,$_);
                 $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');                  $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
                 $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');                  $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
             } split(/\,/,$keyp{$rid});              } split(/\,/,$keyp{$rid});
   
     my $totalparms=scalar keys %name;      my $totalparms=scalar keys %name;
             $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.      my $isdef=1;
       unless ($totalparms) { $totalparms=1; $isdef=0; }
       if ($pscat ne 'all') { $totalparms=1; }
               $r->print('<td bgcolor='.$defbgone.
                   ' rowspan='.$totalparms.'><tt><font size=-1>'.
                 join(' / ',split(/\//,$uri)).                  join(' / ',split(/\//,$uri)).
                 '</font></tt><p><b>'.                  '</font></tt><p><b>'.
                       $bighash{'title_'.$rid});                        $bighash{'title_'.$rid});
Line 487  ENDTABLEHEADFOUR Line 607  ENDTABLEHEADFOUR
  $r->print(' ('.$thistitle.')');   $r->print(' ('.$thistitle.')');
             }              }
             $r->print('</b></td>');              $r->print('</b></td>');
             $r->print('<td rowspan='.$totalparms.'>'.$typep{$rid}.'</td>');              $r->print('<td bgcolor='.$defbgtwo.
             $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.                      ' rowspan='.$totalparms.'>'.$typep{$rid}.'</td>');
               $r->print('<td bgcolor='.$defbgone.
                       ' rowspan='.$totalparms.'><tt><font size=-1>'.
       join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>');        join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>');
     if ($isdef) {
             map {              map {
        if (($_ eq $catmarker) || ($pscat eq 'all')) {
        my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_});         my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_});
   
                $r->print("<td>$part{$_}</td><td>$display{$_}</td>");                 $r->print("<td bgcolor=".$defbgtwo.
                     ">$part{$_}</td><td bgcolor=".$defbgone.
                     ">$display{$_}</td>");
                my $thismarker=$_;                 my $thismarker=$_;
                $thismarker=~s/^parameter\_//;                  $thismarker=~s/^parameter\_//; 
                my $mprefix=$rid.'&'.$thismarker.'&';                 my $mprefix=$rid.'&'.$thismarker.'&';
   
                $r->print('<td'.(($result==11)?' bgcolor="#AAFFAA"':'').'>'.                 $r->print('<td bgcolor='.
                   (($result==11)?'"#AAFFAA"':'#FFDDDD').'>'.
              &valout($outpar[11],$type{$_}).'</td>');               &valout($outpar[11],$type{$_}).'</td>');
                $r->print('<td'.(($result==10)?' bgcolor="#AAFFAA"':'').'>'.                 $r->print('<td bgcolor='.
                   (($result==10)?'"#AAFFAA"':'#FFDDDD').'>'.
              &valout($outpar[10],$type{$_}).'</td>');               &valout($outpar[10],$type{$_}).'</td>');
   
                $r->print('<td'.(($result==9)?' bgcolor="#AAFFAA"':'').'>'.                 $r->print('<td bgcolor='.
                   (($result==9)?'"#AAFFAA"':$defbgone).'>'.
              &plink($type{$_},$display{$_},$outpar[9],$mprefix.'9',               &plink($type{$_},$display{$_},$outpar[9],$mprefix.'9',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                $r->print('<td'.(($result==8)?' bgcolor="#AAFFAA"':'').'>'.                 $r->print('<td bgcolor='.
                   (($result==8)?'"#AAFFAA"':$defbgone).'>'.
              &plink($type{$_},$display{$_},$outpar[8],$mprefix.'8',               &plink($type{$_},$display{$_},$outpar[8],$mprefix.'8',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                $r->print('<td'.(($result==7)?' bgcolor="#AAFFAA"':'').'>'.                 $r->print('<td bgcolor='.
                   (($result==7)?'"#AAFFAA"':$defbgone).'>'.
              &plink($type{$_},$display{$_},$outpar[7],$mprefix.'7',               &plink($type{$_},$display{$_},$outpar[7],$mprefix.'7',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
   
                if ($csec) {                 if ($csec) {
                  $r->print('<td'.(($result==6)?' bgcolor="#AAFFAA"':'').'>'.                   $r->print('<td bgcolor='.
                      (($result==6)?'"#AAFFAA"':$defbgtwo).'>'.
              &plink($type{$_},$display{$_},$outpar[6],$mprefix.'6',               &plink($type{$_},$display{$_},$outpar[6],$mprefix.'6',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                  $r->print('<td'.(($result==5)?' bgcolor="#AAFFAA"':'').'>'.                   $r->print('<td bgcolor='.
                      (($result==5)?'"#AAFFAA"':$defbgtwo).'>'.
              &plink($type{$_},$display{$_},$outpar[5],$mprefix.'5',               &plink($type{$_},$display{$_},$outpar[5],$mprefix.'5',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                  $r->print('<td'.(($result==4)?' bgcolor="#AAFFAA"':'').'>'.                   $r->print('<td bgcolor='.
                       (($result==4)?'"#AAFFAA"':$defbgtwo).'>'.
              &plink($type{$_},$display{$_},$outpar[4],$mprefix.'4',               &plink($type{$_},$display{$_},$outpar[4],$mprefix.'4',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                }                 }
   
                if ($uname) {                 if ($uname) {
                  $r->print('<td'.(($result==3)?' bgcolor="#AAFFAA"':'').'>'.                   $r->print('<td bgcolor='.
                       (($result==3)?'"#AAFFAA"':$defbgone).'>'.
              &plink($type{$_},$display{$_},$outpar[3],$mprefix.'3',               &plink($type{$_},$display{$_},$outpar[3],$mprefix.'3',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                  $r->print('<td'.(($result==2)?' bgcolor="#AAFFAA"':'').'>'.                   $r->print('<td bgcolor='.
                       (($result==2)?'"#AAFFAA"':$defbgone).'>'.
              &plink($type{$_},$display{$_},$outpar[2],$mprefix.'2',               &plink($type{$_},$display{$_},$outpar[2],$mprefix.'2',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                  $r->print('<td'.(($result==1)?' bgcolor="#AAFFAA"':'').'>'.                   $r->print('<td bgcolor='.
                      (($result==1)?'"#AAFFAA"':$defbgone).'>'.
              &plink($type{$_},$display{$_},$outpar[1],$mprefix.'1',               &plink($type{$_},$display{$_},$outpar[1],$mprefix.'1',
                     'parmform.pres','psub').'</td>');                      'parmform.pres','psub').'</td>');
                }                 }
                  $r->print(
                $r->print('<td>'.&valout($outpar[$result],$type{$_}).'</td>');          '<td bgcolor=#CCCCFF>'.&valout($outpar[$result],$type{$_}).'</td>');
                $r->print("</tr>\n<tr>");                 $r->print("</tr>\n<tr>");
      }
    } sort keys %name;     } sort keys %name;
    } else {
        $r->print("</tr>\n<tr>");
           }
 # -------------------------------------------------- End entry for one resource  # -------------------------------------------------- End entry for one resource
    }
  } @ids;   } @ids;
          $r->print('</table></form></body></html>');           $r->print('</table>');
         }
    $r->print('</form></body></html>');
          untie(%bighash);           untie(%bighash);
  untie(%parmhash);   untie(%parmhash);
       }        }
   }
   
   sub crsenv {
       my $r=shift;
       my $setoutput='';
   # -------------------------------------------------- Go through list of changes
       map {
    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\///;
                   $setoutput.='Backing up previous URL: '.
                            &Apache::lonnet::reply('put:'.
                            $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
                            ':'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
                            ':environment:'.
                            &Apache::lonnet::escape('top level map backup '.
                                                                       time).'='.
                    &Apache::lonnet::reply('get:'.
                            $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
                            ':'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
                            ':environment:url',
            $ENV{'course.'.$ENV{'request.course.id'}.'.home'}),
                            $ENV{'course.'.$ENV{'request.course.id'}.'.home'}).
                           '<br>';
   
               }
               if ($name) {
           $setoutput.='Setting <tt>'.$name.'</tt> to <tt>'.
                           $value.'</tt>: '.
                   &Apache::lonnet::reply('put:'.
                            $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
                            ':'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
                            ':environment:'.
                               &Apache::lonnet::escape($name).'='.
       &Apache::lonnet::escape($value),
                            $ENV{'course.'.$ENV{'request.course.id'}.'.home'}).
                           '<br>';
       }
           }
       } keys %ENV;
   # -------------------------------------------------------- Get parameters again
       my $rep=&Apache::lonnet::reply
                    ('dump:'.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
                            ':'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
                            ':environment',
                            $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
       my $output='';
       if ($rep ne 'con_lost') {
    my %values;
           my %descriptions=
    ('url'            => '<b>Top Level Map</b><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)',
     '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>)'
    ); 
   
          map {
              my ($name,$value)=split(/\=/,$_);
              $name=&Apache::lonnet::unescape($name);
              $values{$name}=&Apache::lonnet::unescape($value);
              unless ($descriptions{$name}) {
          $descriptions{$name}=$name;
              }
          } split(/\&/,$rep);
          map {
              $output.='<tr><td>'.$descriptions{$_}.'</td><td><input name="'.
                          $_.'_value" size=40 value="'.
                         $values{$_}.
                        '"></td><td><input type=checkbox name="'.$_.
                        '_setparmval"></td></tr>';
          } keys %descriptions;
          $output.='<tr><td><i>Create New Environment Variable</i><br>'.
                   '<input type="text" size=40 name="newp_name"></td><td>'.
                   '<input type="text" size=40 name="newp_value"></td><td>'.
                   '<input type="checkbox" name="newp_setparmval"></td></tr>'; 
       }    
       $r->print(<<ENDENV);
   <html>
   <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
   }
   
   # ================================================================ Main Handler
   
   sub handler {
      my $r=shift;
   
      if ($r->header_only) {
         $r->content_type('text/html');
         $r->send_http_header;
         return OK;
      }
   
   # ----------------------------------------------------- Needs to be in a course
   
      if (($ENV{'request.course.id'}) && 
          (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
   
          unless (($ENV{'form.crsenv'}) || (!$ENV{'request.course.fn'})) {
   # --------------------------------------------------------- Bring up assessment
     &assessparms($r);
   # ---------------------------------------------- This is for course environment
          } else {
     &crsenv($r);
          }
    } else {     } 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'}=
Removed from v.1.16  
changed lines
  Added in v.1.32

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.