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

Diff for /loncom/interface/lonparmset.pm between versions 1.3 and 1.34

version 1.3, 2000/11/21 22:57:53 version 1.34, 2001/09/01 14:13:47
Line 9 Line 9
 #  #
 # 10/11,10/12,10/16 Gerd Kortemeyer)  # 10/11,10/12,10/16 Gerd Kortemeyer)
 #  #
 # 11/20,11/21 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,08/09,09/01 Gerd Kortemeyer
   
 package Apache::lonparmset;  package Apache::lonparmset;
   
Line 18  use Apache::lonnet; Line 21  use Apache::lonnet;
 use Apache::Constants qw(:common :http REDIRECT);  use Apache::Constants qw(:common :http REDIRECT);
 use GDBM_File;  use GDBM_File;
   
   
 my %courseopt;  my %courseopt;
 my %useropt;  my %useropt;
 my %bighash;  my %bighash;
 my %parmhash;  my %parmhash;
   
   my @outpar;
   
 my @ids;  my @ids;
 my %symbp;  my %symbp;
   my %mapp;
 my %typep;  my %typep;
   my %keyp;
   my %defp;
   
   my %allkeys;
   my %allmaps;
   
 my $uname;  my $uname;
 my $udom;  my $udom;
Line 38  my $fcat; Line 50  my $fcat;
 # -------------------------------------------- Figure out a cascading parameter  # -------------------------------------------- Figure out a cascading parameter
   
 sub parmval {  sub parmval {
     my ($what,$id)=@_;      my ($what,$id,$def)=@_;
       my $result='';
       @outpar=();
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
   
        my $symbparm=$symbp{$id}.'.'.$what;         my $symbparm=$symbp{$id}.'.'.$what;
        my $reslevel=         my $mapparm=$mapp{$id}.'___(all).'.$what;
     $ENV{'request.course.id'}.'.'.$symbparm;  
        my $seclevel=         my $seclevel=
             $ENV{'request.course.id'}.'.'.              $ENV{'request.course.id'}.'.['.
  $ENV{'request.course.sec'}.'.'.$what;   $csec.'].'.$what;
          my $seclevelr=
               $ENV{'request.course.id'}.'.['.
    $csec.'].'.$symbparm;
          my $seclevelm=
               $ENV{'request.course.id'}.'.['.
    $csec.'].'.$mapparm;
   
        my $courselevel=         my $courselevel=
             $ENV{'request.course.id'}.'.'.$what;              $ENV{'request.course.id'}.'.'.$what;
          my $courselevelr=
               $ENV{'request.course.id'}.'.'.$symbparm;
          my $courselevelm=
               $ENV{'request.course.id'}.'.'.$mapparm;
   
 # ----------------------------------------------------------- first, check user  # -------------------------------------------------------- first, check default
   
       if ($uname) {         if ($def) { $outpar[11]=$def;
        if ($useropt{$reslevel}) { return $useropt{$reslevel}; }                     $result=11; }
        if ($useropt{$seclevel}) { return $useropt{$seclevel}; }  
        if ($useropt{$courselevel}) { return $useropt{$courselevel}; }  # ----------------------------------------------------- second, check map parms
   
          my $thisparm=$parmhash{$symbparm};
          if ($thisparm) { $outpar[10]=$thisparm;  
                           $result=10; }
   
   # --------------------------------------------------------- third, check course
   
          if ($courseopt{$courselevel}) { $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{$seclevel}) { $outpar[6]=$courseopt{$seclevel};  
                                       $result=6; }
   
           if ($courseopt{$seclevelm}) { $outpar[5]=$courseopt{$seclevelm};  
                                        $result=5; }  
    
           if ($courseopt{$seclevelr}) { $outpar[4]=$courseopt{$seclevelr};  
                                        $result=4; }
     
       }        }
   
 # -------------------------------------------------------- second, check course  # ---------------------------------------------------------- fourth, check user
         
         if ($uname) { 
   
        if ($courseopt{$reslevel}) { return $courseopt{$reslevel}; }         if ($useropt{$courselevel}) { $outpar[3]=$useropt{$courselevel};  
        if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }                                         $result=3; }
        if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }  
   
 # ------------------------------------------------------ third, check map parms         if ($useropt{$courselevelm}) { $outpar[2]=$useropt{$courselevelm}; 
                                         $result=2; }
   
        my $thisparm=$parmhash{$symbparm};         if ($useropt{$courselevelr}) { $outpar[1]=$useropt{$courselevelr}; 
        if ($thisparm) { return $thisparm; }                                        $result=1; }
        
 # --------------------------------------------- last, look in resource metadata  
   
         my $filename='/home/httpd/res/'.$bighash{'src_'.$id}.'.meta';        }
         if (-e $filename) {       
             my @content;      return $result;
             {  
              my $fh=Apache::File->new($filename);  
              @content=<$fh>;  
             }  
             if (join('',@content)=~  
                  /\<$what[^\>]*\>([^\<]*)\<\/$what\>/) {  
         return $1;  
      }  
         }  
     return '';  
 }  
   
 # ---------------------------------------------------------------- Sort routine  
   
 sub bycat {  
     if ($fcat eq '') {  
         $a<=>$b;  
     } else {  
         &parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b);  
     }  
 }  }
   
 # ================================================================ Main Handler  # ------------------------------------------------------------ Output for value
   
 sub handler {  sub valout {
    my $r=shift;      my ($value,$type)=@_;
       return
    ($value?(($type=~/^date/)?localtime($value):$value):'&nbsp;&nbsp;');
   }
   
    if ($r->header_only) {  # -------------------------------------------------------- Produces link anchor
       $r->content_type('text/html');  
       $r->send_http_header;  
       return OK;  
    }  
   
 # ----------------------------------------------------- Needs to be in a course  sub plink {
       my ($type,$dis,$value,$marker,$return,$call)=@_;
       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."'".');">'.
         &valout($value,$type).'</a><a name="'.$marker.'"></a>';
   }
   
    if (($ENV{'request.course.fn'}) &&   sub assessparms {
        (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {  
         my $r=shift;
 # -------------------------------------------------------- Variable declaration  # -------------------------------------------------------- Variable declaration
   
       %courseopt=();        %courseopt=();
Line 120  sub handler { Line 167  sub handler {
       %symbp=();        %symbp=();
       %typep=();        %typep=();
   
       $uname=$ENV{'form.uname'};        my $message='';
   
         $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'};
         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=''; }        unless ($udom) { $uname=''; }
       $uhome='';        $uhome='';
       my $message='';  
       if ($uname) {        if ($uname) {
   $uhome=&Apache::lonnet::homeserver($uname,$udom);    $uhome=&Apache::lonnet::homeserver($uname,$udom);
       }        
       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 {
             $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>';
            }
           }
       }        }
   
       $csec=$ENV{'form.csec'};  
       unless ($csec) { $csec=''; }        unless ($csec) { $csec=''; }
   
       $fcat=$ENV{'form.fcat'};        $fcat=$ENV{'form.fcat'};
       unless ($fcat) { $fcat=''; }        unless ($fcat) { $fcat=''; }
   
Line 145  sub handler { Line 241  sub handler {
           (tie(%parmhash,'GDBM_File',            (tie(%parmhash,'GDBM_File',
            $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {             $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
   
   # --------------------------------------------------------- Get all assessments
    undef %allkeys;
           undef %allmaps;
           undef %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});
                      $allmaps{$mapid}=$mapp{$id};
                      $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/\_([^\_]+)$/\.$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; }
          $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='';
              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::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
   #
   # 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::critical('put:'.$udom.':'.$uname.':resourcedata:'.
                $storecontent,$uhome);
              }
   
            if ($reply=~/^error\:(.*)/) {
        $message.="<font color=red>Write Error: $1</font>";
    }
   # ---------------------------------------------------------------- Done storing
      }
 # -------------------------------------------------------------- Get coursedata  # -------------------------------------------------------------- Get coursedata
         my $reply=&Apache::lonnet::reply('dump:'.          my $reply=&Apache::lonnet::reply('dump:'.
               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.                $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
Line 153  sub handler { Line 381  sub handler {
         if ($reply!~/^error\:/) {          if ($reply!~/^error\:/) {
            map {             map {
              my ($name,$value)=split(/\=/,$_);               my ($name,$value)=split(/\=/,$_);
              $courseopt{unescape($name)}=unescape($value);                 $courseopt{&Apache::lonnet::unescape($name)}=
                           &Apache::lonnet::unescape($value);  
            } split(/\&/,$reply);             } split(/\&/,$reply);
         }          }
 # --------------------------------------------------- Get userdata (if present)  # --------------------------------------------------- Get userdata (if present)
Line 163  sub handler { Line 392  sub handler {
            if ($reply!~/^error\:/) {             if ($reply!~/^error\:/) {
               map {                map {
                 my ($name,$value)=split(/\=/,$_);                  my ($name,$value)=split(/\=/,$_);
                 $useropt{unescape($name)}=unescape($value);                    $useropt{&Apache::lonnet::unescape($name)}=
                            &Apache::lonnet::unescape($value);
               } split(/\&/,$reply);                } split(/\&/,$reply);
            }             }
         }          }
 # --------------------------------------------------------- Get all assessments  
         map {  
     if ($_=~/^src\_(\d+)\.(\d+)$/) {  
        my $mapid=$1;  
                my $resid=$2;  
                my $id=$mapid.'.'.$resid;  
                if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {  
    $ids[$#ids+1]=$id;  
                    $typep{$id}=$1;  
                    $symbp{$id}=  
     &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).  
  '___'.$resid.'___'.  
     &Apache::lonnet::declutter($bighash{$_});  
        }  
             }  
         } keys %bighash;  
 # ------------------------------------------------------------------- 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(   $r->print(<<ENDHEAD);
   '<html><body bgcolor="#FFFFFF"><h1>Set Assessment Parameters</h1>');  <html>
  $r->print("<h2>Course: $ENV{'course.'.  <head>
                    $ENV{'request.course.id'}.'.description'}</h2>");  <title>LON-CAPA Course Parameters</title>
  if ($csec) {  <script>
             $r->print("<h3>Section/Group: $csec</h3>");  
  }      function pclose() {
  if ($uname) {          parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
             $r->print("<h3>For User $uname at Domain $udom");                   "height=350,width=350,scrollbars=no,menubar=no");
  }          parmwin.close();
  if ($uhome eq 'no_host') {      }
             $r->print($message);  
          }      function pjump(type,dis,value,marker,ret,call) {
           document.parmform.pres_marker.value='';
           parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
                    +"&value="+escape(value)+"&marker="+escape(marker)
                    +"&return="+escape(ret)
                    +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
                    "height=350,width=350,scrollbars=no,menubar=no");
   
       }
   
       function psub() {
           pclose();
           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();
           } else {
               document.parmform.pres_value.value='';
               document.parmform.pres_marker.value='';
           }
       }
   
   </script>
   </head>
   <body bgcolor="#FFFFFF" onUnload="pclose()">
   <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>
   <input type="submit" name="crsenv" value="Set Course Environment">
   </form>
   <form method="post" action="/adm/parmset" name="parmform">
   <h3>Course Assessments</h3>
   <b>
   Section/Group: 
   <input type="text" value="$csec" size="6" name="csec">
   <br>
   For User 
   <input type="text" value="$uname" size="12" name="uname">
   or ID
   <input type="text" value="$id" size="12" name="id"> 
   at Domain 
   <input type="text" value="$udom" size="6" name="udom">
   </b>
   <input type="hidden" value='' name="pres_value">
   <input type="hidden" value='' name="pres_type">
   <input type="hidden" value='' name="pres_marker"> 
   ENDHEAD
       if ($ENV{'form.url'}) {
    $r->print('<input type="hidden" value="'.$ENV{'form.url'}.
         '" 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>');
           map {
       $r->print('<option value="'.$_.'"');
               if ($fcat eq $_) { $r->print(' selected'); }
               $r->print('>'.$allkeys{$_}.'</option>');
           } reverse sort keys %allkeys;
          $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>');
           } reverse sort keys %allkeys;
           $r->print(
   '</select></td></tr></table><br><input name=dis type="submit" value="Display">'
                    );
         if (($pscat) || ($pschp) || ($pssymb)) {
   # ----------------------------------------------------------------- Start Table
    my $catmarker='parameter_'.$pscat;
           $catmarker=~s/\./\_/g;
           my $coursespan=$csec?8:5;
           my $csuname=$ENV{'user.name'};
           my $csudom=$ENV{'user.domain'};
    $r->print(<<ENDTABLEHEAD);
   <p><table border=2>
   <tr><td colspan=5></td>
   <th colspan=$coursespan>Any User</th>
   ENDTABLEHEAD
       if ($uname) {
    $r->print("<th colspan=3 rowspan=2>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>
   ENDTABLETWO
       if ($csec) {
    $r->print("<th colspan=3>in Section/Group $csec</th>");
       }
       $r->print(<<ENDTABLEHEADFOUR);
   </tr><tr><th>Assessment URL and Title</th><th>Type</th>
   <th>Enclosing Map</th><th>Part No.</th><th>Parameter Name</th>
   <th>default</th><th>from Enclosing Map</th>
   <th>general</th><th>for Enclosing Map</th><th>for Resource</th>
   ENDTABLEHEADFOUR
       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>');
       }
    $r->print('</tr>');
            my $defbgone='';
            my $defbgtwo='';
   map {    map {
      $r->print($_.'<br>');             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
        if ($defbgone eq '"E0E099"') {
    $defbgone='"E0E0DD"';
                } else {
                    $defbgone='"E0E099"';
        }
        if ($defbgtwo eq '"FFFF99"') {
    $defbgtwo='"FFFFDD"';
                } else {
                    $defbgtwo='"FFFF99"';
        }
       @outpar=();
               my $thistitle='';
               my %name=   ();
        undef %name;
               my %part=   ();
       my %display=();
       my %type=   ();
               my %default=();
               my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
   
               map {
        if (($_ eq $catmarker) || ($pscat eq 'all')) {
    $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
                   $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
                   $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
                   unless ($display{$_}) { $display{$_}=''; }
                   $display{$_}.=' ('.$name{$_}.')';
                   $default{$_}=&Apache::lonnet::metadata($uri,$_);
                   $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
                   $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
        }
               } split(/\,/,$keyp{$rid});
   
       my $totalparms=scalar keys %name;
     if ($totalparms>0) {
               my $firstrow=1;
               $r->print('<tr><td bgcolor='.$defbgone.
                   ' rowspan='.$totalparms.'><tt><font size=-1>'.
                   join(' / ',split(/\//,$uri)).
                   '</font></tt><p><b>'.
                         $bighash{'title_'.$rid});
               if ($thistitle) {
    $r->print(' ('.$thistitle.')');
               }
               $r->print('</b></td>');
               $r->print('<td bgcolor='.$defbgtwo.
                       ' rowspan='.$totalparms.'>'.$typep{$rid}.'</td>');
               $r->print('<td bgcolor='.$defbgone.
                       ' rowspan='.$totalparms.'><tt><font size=-1>'.
         join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>');
               map {
          my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_});
                  unless ($firstrow) { 
                     $r->print('<tr>'); 
                  } else {
      $firstrow=0;
                  }
                  $r->print("<td bgcolor=".$defbgtwo.
                     ">$part{$_}</td><td bgcolor=".$defbgone.
                     ">$display{$_}</td>");
                  my $thismarker=$_;
                  $thismarker=~s/^parameter\_//; 
                  my $mprefix=$rid.'&'.$thismarker.'&';
   
                  $r->print('<td bgcolor='.
                   (($result==11)?'"#AAFFAA"':'#FFDDDD').'>'.
                &valout($outpar[11],$type{$_}).'</td>');
                  $r->print('<td bgcolor='.
                   (($result==10)?'"#AAFFAA"':'#FFDDDD').'>'.
                &valout($outpar[10],$type{$_}).'</td>');
   
                  $r->print('<td bgcolor='.
                   (($result==9)?'"#AAFFAA"':$defbgone).'>'.
                &plink($type{$_},$display{$_},$outpar[9],$mprefix.'9',
                       'parmform.pres','psub').'</td>');
                  $r->print('<td bgcolor='.
                   (($result==8)?'"#AAFFAA"':$defbgone).'>'.
                &plink($type{$_},$display{$_},$outpar[8],$mprefix.'8',
                       'parmform.pres','psub').'</td>');
                  $r->print('<td bgcolor='.
                   (($result==7)?'"#AAFFAA"':$defbgone).'>'.
                &plink($type{$_},$display{$_},$outpar[7],$mprefix.'7',
                       'parmform.pres','psub').'</td>');
   
                  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>');
                  my $sessionval=&Apache::lonnet::EXT('resource.'.$part{$_}.
         '.'.$name{$_},$mapp{$rid}.'___'.$inmapid.'___'.$uri);
                  if (($type{$_}=~/^date/) && ($sessionval))
                       { $sessionval=localtime($sessionval); }
                  $r->print(
    '<td bgcolor=#999999><font color=#FFFFFF>'.$sessionval.'&nbsp;'.
           '</font></td>');
                  $r->print("</tr>");
      } sort keys %name;
    }
   # -------------------------------------------------- End entry for one resource
    }
  } @ids;   } @ids;
          $r->print('</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'}=
         "/adm/flip: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;
Line 222  __END__ Line 849  __END__
   
   
   
   
   
   
   
Removed from v.1.3  
changed lines
  Added in v.1.34

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.