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

Diff for /loncom/interface/lonparmset.pm between versions 1.4 and 1.38

version 1.4, 2000/11/22 12:16:03 version 1.38, 2001/12/17 14:21:49
Line 5 Line 5
 #  #
 # (TeX Content Handler  # (TeX Content Handler
 #  #
   # YEAR=2000
 # 05/29/00,05/30,10/11 Gerd Kortemeyer)  # 05/29/00,05/30,10/11 Gerd Kortemeyer)
 #  #
 # 10/11,10/12,10/16 Gerd Kortemeyer)  # 10/11,10/12,10/16 Gerd Kortemeyer)
 #  #
 # 11/20,11/21,11/22 Gerd Kortemeyer  # 11/20,11/21,11/22,11/23,11/24,11/25,11/27,11/28,
   # 12/08,12/12,
   # YEAR=2001
   # 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,09/21 Gerd Kortemeyer
   # 12/17 Scott Harrison
   #
   ###
   
 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::lonmeta;  
   
   
 my %courseopt;  my %courseopt;
Line 25  my %useropt; Line 33  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 40  my $fcat; Line 56  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 122  sub handler { Line 173  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='';
         } elsif ($ENV{'form.symb'}) {
     $pssymb=$ENV{'form.symb'};
     $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 147  sub handler { Line 251  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;
           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/\_/\./;
                             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;
             }
          }
                      }
                      $mapp{$id}=
          &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});
                      $allmaps{$mapid}=$mapp{$id};
                      $symbp{$id}=$mapp{$id}.
    '___'.$resid.'___'.
       &Apache::lonnet::declutter($srcf);
          }
               }
           }
   # ---------------------------------------------------------- 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'}.':'.
               $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',                $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
               $ENV{'course.'.$ENV{'request.course.id'}.'.home'});                $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
         if ($reply!~/^error\:/) {          if ($reply!~/^error\:/) {
            map {             foreach (split(/\&/,$reply)) {
              my ($name,$value)=split(/\=/,$_);               my ($name,$value)=split(/\=/,$_);
              $courseopt{unescape($name)}=unescape($value);                 $courseopt{&Apache::lonnet::unescape($name)}=
            } split(/\&/,$reply);                          &Apache::lonnet::unescape($value);  
              }
         }          }
 # --------------------------------------------------- Get userdata (if present)  # --------------------------------------------------- Get userdata (if present)
         if ($uname) {          if ($uname) {
            my $reply=             my $reply=
        &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);         &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
            if ($reply!~/^error\:/) {             if ($reply!~/^error\:/) {
               map {                foreach (split(/\&/,$reply)) {
                 my ($name,$value)=split(/\=/,$_);                  my ($name,$value)=split(/\=/,$_);
                 $useropt{unescape($name)}=unescape($value);                    $useropt{&Apache::lonnet::unescape($name)}=
               } split(/\&/,$reply);                           &Apache::lonnet::unescape($value);
                 }
            }             }
         }          }
 # --------------------------------------------------------- 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) {
  $r->print('<table border=2>');          document.parmform.pres_marker.value='';
   map {          parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
     $r->print('<tr>');                   +"&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">');
       }
       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><tr><td>Sort list by</td><td>');
    $r->print('<select name="fcat">');
           $r->print('<option value="">Enclosing Map</option>');
           foreach (reverse sort keys %allkeys) {
       $r->print('<option value="'.$_.'"');
               if ($fcat eq $_) { $r->print(' selected'); }
               $r->print('>'.$allkeys{$_}.'</option>');
           }
          $r->print(
       '</select></tr><tr><td>Select Enclosing Map</td><td><select name=pschp>');
           $r->print('<option value=all>All Maps</option>');
           foreach (keys %allmaps) {
       $r->print('<option value="'.$_.'"');
               if (($pssymb=~/^$allmaps{$_}/) || 
                   ($pschp eq $_)) { $r->print(' selected'); }
               $r->print('>'.$allmaps{$_}.'</option>');
           }
           $r->print(
    '</select></td></tr><tr><td>Select Parameter</td><td><select name=pscat>');
           $r->print('<option value=all>All Parameters</option>');
           foreach (reverse sort keys %allkeys) {
       $r->print('<option value="'.$_.'"');
               if ($pscat eq $_) { $r->print(' selected'); }
               $r->print('>'.$allkeys{$_}.'</option>');
           }
           $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='';
     foreach (@ids) {
              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
             my %metadata=&Apache::lonmeta::unpackagemeta(       if ($defbgone eq '"E0E099"') {
   &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$_}.'.meta'),1);   $defbgone='"E0E0DD"';
             map {               } else {
                 if ($_=~/^parameter\_(\d+)\_(\w+)\_\_dis\_\_(.+)$/) {                   $defbgone='"E0E099"';
     my $part=$1;       }
                     my $name=$2;       if ($defbgtwo eq '"FFFF99"') {
                     my $display=$3;   $defbgtwo='"FFFFDD"';
                     my $type=$metadata{$_};               } else {
                 }                   $defbgtwo='"FFFF99"';
             } keys %metadata;       }
       @outpar=();
               my $thistitle='';
               my %name=   ();
        undef %name;
               my %part=   ();
       my %display=();
       my %type=   ();
               my %default=();
               my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
   
               foreach (split(/\,/,$keyp{$rid})) {
        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');
        }
               }
   
       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>');
               foreach (sort keys %name) {
          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>");
      }
    }
 # -------------------------------------------------- End entry for one resource  # -------------------------------------------------- End entry for one resource
             $r->print('</tr>');   }
  } @ids;   }
          $r->print('</table></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
       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\///;
                   $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>';
       }
           }
       }
   # -------------------------------------------------------- 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>)'
    ); 
   
          foreach (split(/\&/,$rep)) {
              my ($name,$value)=split(/\=/,$_);
              $name=&Apache::lonnet::unescape($name);
              $values{$name}=&Apache::lonnet::unescape($value);
              unless ($descriptions{$name}) {
          $descriptions{$name}=$name;
              }
          }
          foreach (sort keys %descriptions) {
              $output.='<tr><td>'.$descriptions{$_}.'</td><td><input name="'.
                          $_.'_value" size=40 value="'.
                         $values{$_}.
                        '"></td><td><input type=checkbox name="'.$_.
                        '_setparmval"></td></tr>';
          }
          $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;
      }
      &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'}))) {
   
          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 237  sub handler { Line 858  sub handler {
 __END__  __END__
   
   
   =head1 NAME
   
   Apache::lonparmset - Handler to set parameters for assessments
   
   =head1 SYNOPSIS
   
   Invoked by /etc/httpd/conf/srm.conf:
   
    <Location /adm/parmset>
    PerlAccessHandler       Apache::lonacc
    SetHandler perl-script
    PerlHandler Apache::lonparmset
    ErrorDocument     403 /adm/login
    ErrorDocument     406 /adm/roles
    ErrorDocument  500 /adm/errorhandler
    </Location>
   
   =head1 INTRODUCTION
   
   This module sets assessment parameters.
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head1 HANDLER SUBROUTINE
   
   This routine is called by Apache and mod_perl.
   
   =over 4
   
   =item *
   
   need to be in course
   
   =item *
   
   bring up assessment screen or course environment
   
   =back
   
   =head1 OTHER SUBROUTINES
   
   =over 4
   
   =item *
   
   parmval() : figure out a cascading parameter
   
   =item *
   
   valout() : output for value
   
   =item *
   
   plink() : produces link anchor
   
   =item *
   
   assessparms() : show assess data and parameters
   
   =item *
   
   crsenv() : for the course environment
   
   =back
   
   =cut
   
   
   
Removed from v.1.4  
changed lines
  Added in v.1.38

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.